1   #!/usr/bin/perl -w
2   use strict;
3   $|++;
4
5   use Config;
6   use IPC::Open2;
7   use Memoize; memoize('lines_in_file');
8   use File::Basename;
9
10    ## CONFIG
11
12    my $PAT = 
      "/home/merlyn/Html/merlyn/WebTechniques/col??.listing.txt";
13
14    ## END CONFIG
15
16    my $perlpath = $Config{perlpath};
17    my $privlib = $Config{privlib};
18    my $sitelib = $Config{sitelib};
19
20    my $files_regex = qr/^(\Q$privlib\E|\Q$sitelib\E)/;
21
22    @ARGV = glob $PAT or die "no files?";
23
24    undef $/;
25
26    my $source_grand = 0;
27    my $used_grand = 0;
28
29    while (<>) {
30    for (split /^\#\#\#.*listing.*\n/im) {
31      next if /Apach[e]::/; # bleh
32      next unless my $source_count = tr/\n//;
33      open2(\*RDR, \*WTR, "$perlpath -cTMDevel::Modlist=path 2>&1")
34        or die "Cannot create pipe or fork or something: $!";
35      print WTR $_;
36      close WTR;
37      $_ = <RDR>;
38      close RDR;
39      my $used_count = 0;
40      for (split /\n/) {
41        next unless /$files_regex/;
42        $used_count += lines_in_file($_);
43      }
44      printf "%30s %6d %6d\n", basename($ARGV), $source_count, 
        $used_count;
45      $source_grand += $source_count;
46      $used_grand += $used_count;
47    }
48    }
49    printf "%30s %6d %6d\n", "grand total =>", $source_grand, 
      $used_grand;
50
51    sub lines_in_file {
52    my $filename = shift;
53    my $handle = \do { local *STDIN };
54    open $handle, "<$filename" or return 0;
55    read $handle, my $buffer, -s $handle;
56    $buffer =~ tr/\n//;
57    }