home *** CD-ROM | disk | FTP | other *** search
/ OpenStep 4.2 / Openstep-4.2-Intel-User.iso / usr / lib / perl5 / ExtUtils / Manifest.pm < prev    next >
Text File  |  1997-03-29  |  7KB  |  265 lines
  1. package ExtUtils::Manifest;
  2.  
  3. =head1 NAME
  4.  
  5. ExtUtils::Manifest - utilities to write and check a MANIFEST file
  6.  
  7. =head1 SYNOPSIS
  8.  
  9. C<require ExtUtils::Manifest;>
  10.  
  11. C<ExtUtils::Manifest::mkmanifest;>
  12.  
  13. C<ExtUtils::Manifest::manicheck;>
  14.  
  15. C<ExtUtils::Manifest::filecheck;>
  16.  
  17. C<ExtUtils::Manifest::fullcheck;>
  18.  
  19. C<ExtUtils::Manifest::maniread($file);>
  20.  
  21. C<ExtUtils::Manifest::manicopy($read,$target);>
  22.  
  23. =head1 DESCRIPTION
  24.  
  25. Mkmanifest() writes all files in and below the current directory to a
  26. file named C<MANIFEST> in the current directory. It works similar to
  27.  
  28.     find . -print
  29.  
  30. but in doing so checks each line in an existing C<MANIFEST> file and
  31. includes any comments that are found in the existing C<MANIFEST> file
  32. in the new one. Anything between white space and an end of line within
  33. a C<MANIFEST> file is considered to be a comment. Filenames and
  34. comments are seperated by one or more TAB characters in the
  35. output. All files that match any regular expression in a file
  36. C<MANIFEST.SKIP> (if such a file exists) are ignored.
  37.  
  38. Manicheck() checks if all the files within a C<MANIFEST> in the current
  39. directory really do exist.
  40.  
  41. Filecheck() finds files below the current directory that are not
  42. mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
  43. will be consulted. Any file matching a regular expression in such a
  44. file will not be reported as missing in the C<MANIFEST> file.
  45.  
  46. Fullcheck() does both a manicheck() and a filecheck().
  47.  
  48. Maniread($file) reads a named C<MANIFEST> file (defaults to
  49. C<MANIFEST> in the current directory) and returns a HASH reference
  50. with files being the keys and comments being the values of the HASH.
  51.  
  52. I<Manicopy($read,$target)> copies the files that are the keys in the
  53. HASH I<%$read> to the named target directory. The HASH reference
  54. I<$read> is typically returned by the maniread() function. This
  55. function is useful for producing a directory tree identical to the
  56. intended distribution tree.
  57.  
  58. =head1 MANIFEST.SKIP
  59.  
  60. The file MANIFEST.SKIP may contain regular expressions of files that
  61. should be ignored by mkmanifest() and filecheck(). The regular
  62. expressions should appear one on each line. A typical example:
  63.  
  64.     \bRCS\b
  65.     ^MANIFEST\.
  66.     ^Makefile$
  67.     ~$
  68.     \.html$
  69.     \.old$
  70.     ^blib/
  71.     ^MakeMaker-\d
  72.  
  73. =head1 EXPORT_OK
  74.  
  75. C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
  76. C<&maniread>, and C<&manicopy> are exportable.
  77.  
  78. =head1 DIAGNOSTICS
  79.  
  80. All diagnostic output is sent to C<STDERR>.
  81.  
  82. =over
  83.     
  84. =item C<Not in MANIFEST:> I<file>
  85. is reported if a file is found, that is missing in the C<MANIFEST>
  86. file which is excluded by a regular expression in the file
  87. C<MANIFEST.SKIP>.
  88.  
  89. =item C<No such file:> I<file>
  90. is reported if a file mentioned in a C<MANIFEST> file does not
  91. exist.
  92.  
  93. =item C<MANIFEST:> I<$!>
  94. is reported if C<MANIFEST> could not be opened.
  95.  
  96. =item C<Added to MANIFEST:> I<file>
  97. is reported by mkmanifest() if $Verbose is set and a file is added
  98. to MANIFEST. $Verbose is set to 1 by default.
  99.  
  100. =back
  101.  
  102. =head1 AUTHOR
  103.  
  104. Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
  105.  
  106. =cut
  107.  
  108. require Exporter;
  109. @ISA=('Exporter');
  110. @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
  111.           'maniread', 'manicopy');
  112.  
  113. use File::Find;
  114. use Carp;
  115.  
  116. $Debug = 0;
  117. $Verbose = 1;
  118.  
  119. ($Version) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
  120. $Version = $Version; #avoid warning
  121.  
  122. $Quiet = 0;
  123.  
  124. sub mkmanifest {
  125.     my $manimiss = 0;
  126.     my $read = maniread() or $manimiss++;
  127.     $read = {} if $manimiss;
  128.     my $matches = _maniskip();
  129.     my $found = manifind();
  130.     my($key,$val,$file,%all);
  131.     my %all = (%$found, %$read);
  132.     local *M;
  133.     rename "MANIFEST", "MANIFEST.bak" unless $manimiss;
  134.     open M, ">MANIFEST" or die "Could not open MANIFEST: $!";
  135.     foreach $file (sort keys %all) {
  136.     next if &$matches($file);
  137.     if ($Verbose){
  138.         warn "Added to MANIFEST: $file\n" unless exists $read->{$file};
  139.     }
  140.     my $tabs = (5 - (length($file)+1)/8);
  141.     $tabs = 1 if $tabs < 1;
  142.     $tabs = 0 unless $all{$file};
  143.     print M $file, "\t" x $tabs, $all{$file}, "\n";
  144.     }
  145.     close M;
  146. }
  147.  
  148. sub manifind {
  149.     local $found = {};
  150.     find(sub {return if -d $_;
  151.           (my $name = $File::Find::name) =~ s|./||;
  152.           warn "Debug: diskfile $name\n" if $Debug;
  153.           $found->{$name} = "";}, ".");
  154.     $found;
  155. }
  156.  
  157. sub fullcheck {
  158.     _manicheck(3);
  159. }
  160.  
  161. sub manicheck {
  162.     return @{(_manicheck(1))[0]};
  163. }
  164.  
  165. sub filecheck {
  166.     return @{(_manicheck(2))[1]};
  167. }
  168.  
  169. sub _manicheck {
  170.     my($arg) = @_;
  171.     my $read = maniread();
  172.     my $file;
  173.     my(@missfile,@missentry);
  174.     if ($arg & 1){
  175.     my $found = manifind();
  176.     foreach $file (sort keys %$read){
  177.         warn "Debug: manicheck checking from MANIFEST $file\n" if $Debug;
  178.         unless ( exists $found->{$file} ) {
  179.           warn "No such file: $file\n" unless $Quiet;
  180.           push @missfile, $file;
  181.         }
  182.     }
  183.     }
  184.     if ($arg & 2){
  185.     $read ||= {};
  186.     my $matches = _maniskip();
  187.     my $found = manifind();
  188.     foreach $file (sort keys %$found){
  189.         next if &$matches($file);
  190.         warn "Debug: manicheck checking from disk $file\n" if $Debug;
  191.         unless ( exists $read->{$file} ) {
  192.           warn "Not in MANIFEST: $file\n" unless $Quiet;
  193.           push @missentry, $file;
  194.         }
  195.     }
  196.     }
  197.     (\@missfile,\@missentry);
  198. }
  199.  
  200. sub maniread {
  201.     my ($mfile) = @_;
  202.     $mfile = "MANIFEST" unless defined $mfile;
  203.     my $read = {};
  204.     local *M;
  205.     unless (open M, $mfile){
  206.     warn "$mfile: $!";
  207.     return $read;
  208.     }
  209.     while (<M>){
  210.     chomp;
  211.     /^(\S+)\s*(.*)/ and $read->{$1}=$2;
  212.     }
  213.     close M;
  214.     $read;
  215. }
  216.  
  217. # returns an anonymous sub that decides if an argument matches
  218. sub _maniskip {
  219.     my ($mfile) = @_;
  220.     my $matches = sub {0};
  221.     my @skip ;
  222.     my $mfile = "MANIFEST.SKIP" unless defined $mfile;
  223.     local *M;
  224.     return $matches unless -f $mfile;
  225.     open M, $mfile or return $matches;
  226.     while (<M>){
  227.     chomp;
  228.     next if /^\s*$/;
  229.     push @skip, $_;
  230.     }
  231.     close M;
  232.     my $sub = "\$matches = "
  233.     . "sub { my(\$arg)=\@_; return 1 if "
  234.     . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/o "} @skip), 0)
  235.     . " }";
  236.     eval $sub;
  237.     print "Debug: $sub\n" if $Debug;
  238.     $matches;
  239. }
  240.  
  241. sub manicopy {
  242.     my($read,$target)=@_;
  243.     croak "manicopy() called without target argument" unless defined $target;
  244.     require File::Path;
  245.     require File::Basename;
  246.     my(%dirs,$file);
  247.     foreach $file (keys %$read){
  248.     my $dir = File::Basename::dirname($file);
  249.     File::Path::mkpath("$target/$dir");
  250.     cp_if_diff($file, "$target/$file");
  251.     }
  252. }
  253.  
  254. sub cp_if_diff {
  255.     my($from,$to)=@_;
  256.     -f $from || carp "$0: $from not found";
  257.     system "cmp", "-s", $from, $to;
  258.     if ($?) {
  259.     unlink($to);   # In case we don't have write permissions.
  260.     (system 'cp', $from, $to) == 0 or confess "system 'cp': $!";
  261.     }
  262. }
  263.  
  264. 1;
  265.