lib/ExtUtils/Manifest.pm

   1 package ExtUtils::Manifest;
   2
   3 require Exporter;
   4 use Config;
   5 use File::Find;
   6 use File::Copy 'copy';
   7 use Carp;
   8 use strict;
   9
  10 use vars qw($VERSION @ISA @EXPORT_OK
  11             $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
  12
  13 $VERSION = '1.2801';
  14 @ISA=('Exporter');
  15 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
  16               'skipcheck', 'maniread', 'manicopy');
  17
  18 $Is_VMS = $^O eq 'VMS';
  19 if ($Is_VMS) { require File::Basename }
  20
  21 $Debug = 0;
  22 $Verbose = 1;
  23 $Quiet = 0;
  24 $MANIFEST = 'MANIFEST';
  25
  26 # Really cool fix from Ilya :)
  27 unless (defined $Config{d_link}) {
  28     *ln = \&cp;
  29 }
  30
  31 sub mkmanifest {
  32     my $manimiss = 0;
  33     my $read = maniread() or $manimiss++;
  34     $read = {} if $manimiss;
  35     local *M;
  36     rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
  37     open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
  38     my $matches = _maniskip();
  39     my $found = manifind();
  40     my($key,$val,$file,%all);
  41     %all = (%$found, %$read);
  42     $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
  43         if $manimiss; # add new MANIFEST to known file list
  44     foreach $file (sort keys %all) {
  45         next if &$matches($file);
  46         if ($Verbose){
  47             warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
  48         }
  49         my $text = $all{$file};
  50         ($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
  51         my $tabs = (5 - (length($file)+1)/8);
  52         $tabs = 1 if $tabs < 1;
  53         $tabs = 0 unless $text;
  54         print M $file, "\t" x $tabs, $text, "\n";
  55     }
  56     close M;
  57 }
  58
  59 sub manifind {
  60     local $found = {};
  61     find(sub {return if -d $_;
  62               (my $name = $File::Find::name) =~ s|./||;
  63               warn "Debug: diskfile $name\n" if $Debug;
  64               $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
  65               $found->{$name} = "";}, ".");
  66     $found;
  67 }
  68
  69 sub fullcheck {
  70     _manicheck(3);
  71 }
  72
  73 sub manicheck {
  74     return @{(_manicheck(1))[0]};
  75 }
  76
  77 sub filecheck {
  78     return @{(_manicheck(2))[1]};
  79 }
  80
  81 sub skipcheck {
  82     _manicheck(6);
  83 }
  84
  85 sub _manicheck {
  86     my($arg) = @_;
  87     my $read = maniread();
  88     my $file;
  89     my(@missfile,@missentry);
  90     if ($arg & 1){
  91         my $found = manifind();
  92         foreach $file (sort keys %$read){
  93             warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
  94             unless ( exists $found->{$file} ) {
  95                 warn "No such file: $file\n" unless $Quiet;
  96                 push @missfile, $file;
  97             }
  98         }
  99     }
 100     if ($arg & 2){
 101         $read ||= {};
 102         my $matches = _maniskip();
 103         my $found = manifind();
 104         my $skipwarn = $arg & 4;
 105         foreach $file (sort keys %$found){
 106             if (&$matches($file)){
 107                 warn "Skipping $file\n" if $skipwarn;
 108                 next;
 109             }
 110             warn "Debug: manicheck checking from disk $file\n" if $Debug;
 111             unless ( exists $read->{$file} ) {
 112                 warn "Not in $MANIFEST: $file\n" unless $Quiet;
 113                 push @missentry, $file;
 114             }
 115         }
 116     }
 117     (\@missfile,\@missentry);
 118 }
 119
 120 sub maniread {
 121     my ($mfile) = @_;
 122     $mfile = $MANIFEST unless defined $mfile;
 123     my $read = {};
 124     local *M;
 125     unless (open M, $mfile){
 126         warn "$mfile: $!";
 127         return $read;
 128     }
 129     while (<M>){
 130         chomp;
 131         if ($Is_VMS) {
 132             my($file)= /^(\S+)/;
 133             next unless $file;
 134             my($base,$dir) = File::Basename::fileparse($file);
 135             # Resolve illegal file specifications in the same way as tar
 136             $dir =~ tr/./_/;
 137             my(@pieces) = split(/\./,$base);
 138             if (@pieces > 2) { $base = shift(@pieces) . '.' . join('_',@pieces); }
 139             my $okfile = "$dir$base";
 140             warn "Debug: Illegal name $file changed to $okfile\n" if $Debug;
 141             $read->{"\L$okfile"}=$_;
 142         }
 143         else { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
 144     }
 145     close M;
 146     $read;
 147 }
 148
 149 # returns an anonymous sub that decides if an argument matches
 150 sub _maniskip {
 151     my ($mfile) = @_;
 152     my $matches = sub {0};
 153     my @skip ;
 154     $mfile = "$MANIFEST.SKIP" unless defined $mfile;
 155     local *M;
 156     return $matches unless -f $mfile;
 157     open M, $mfile or return $matches;
 158     while (<M>){
 159         chomp;
 160         next if /^\s*$/;
 161         push @skip, $_;
 162     }
 163     close M;
 164     my $opts = $Is_VMS ? 'oi ' : 'o ';
 165     my $sub = "\$matches = "
 166         . "sub { my(\$arg)=\@_; return 1 if "
 167         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
 168         . " }";
 169     eval $sub;
 170     print "Debug: $sub\n" if $Debug;
 171     $matches;
 172 }
 173
 174 sub manicopy {
 175     my($read,$target,$how)=@_;
 176     croak "manicopy() called without target argument" unless defined $target;
 177     $how = 'cp' unless defined $how && $how;
 178     require File::Path;
 179     require File::Basename;
 180     my(%dirs,$file);
 181     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 182     umask 0 unless $Is_VMS;
 183     File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
 184     foreach $file (keys %$read){
 185         $file = VMS::Filespec::unixify($file) if $Is_VMS;
 186         if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 187             my $dir = File::Basename::dirname($file);
 188             $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 189             File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
 190         }
 191         cp_if_diff($file, "$target/$file", $how);
 192     }
 193 }
 194
 195 sub cp_if_diff {
 196     my($from, $to, $how)=@_;
 197     -f $from || carp "$0: $from not found";
 198     my($diff) = 0;
 199     local(*F,*T);
 200     open(F,$from) or croak "Can't read $from: $!\n";
 201     if (open(T,$to)) {
 202         while (<F>) { $diff++,last if $_ ne <T>; }
 203         $diff++ unless eof(T);
 204         close T;
 205     }
 206     else { $diff++; }
 207     close F;
 208     if ($diff) {
 209         if (-e $to) {
 210             unlink($to) or confess "unlink $to: $!";
 211         }
 212         STRICT_SWITCH: {
 213               best($from,$to), last STRICT_SWITCH if $how eq 'best';
 214                 cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 215                 ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 216           }
 217     }
 218 }
 219
 220 sub cp {
 221     my ($srcFile, $dstFile) = @_;
 222     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
 223     copy($srcFile,$dstFile);
 224     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 225     # chmod a+rX-w,go-w
 226     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 227 }
 228
 229 sub ln {
 230     my ($srcFile, $dstFile) = @_;
 231     return &cp if $Is_VMS;
 232     link($srcFile, $dstFile);
 233     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
 234     my $mode= 0444 | (stat)[2] & 0700;
 235     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
 236 }
 237
 238 sub best {
 239     my ($srcFile, $dstFile) = @_;
 240     if (-l $srcFile) {
 241         cp($srcFile, $dstFile);
 242     } else {
 243         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
 244     }
 245 }
 246
 247 1;
 248
 249 __END__
 250
 251 =head1 NAME
 252
 253 ExtUtils::Manifest - utilities to write and check a MANIFEST file
 254
 255 =head1 SYNOPSIS
 256
 257 C<require ExtUtils::Manifest;>
 258
 259 C<ExtUtils::Manifest::mkmanifest;>
 260
 261 C<ExtUtils::Manifest::manicheck;>
 262
 263 C<ExtUtils::Manifest::filecheck;>
 264
 265 C<ExtUtils::Manifest::fullcheck;>
 266
 267 C<ExtUtils::Manifest::skipcheck;>
 268
 269 C<ExtUtild::Manifest::manifind();>
 270
 271 C<ExtUtils::Manifest::maniread($file);>
 272
 273 C<ExtUtils::Manifest::manicopy($read,$target,$how);>
 274
 275 =head1 DESCRIPTION
 276
 277 Mkmanifest() writes all files in and below the current directory to a
 278 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
 279 defaults to C<MANIFEST>) in the current directory. It works similar to
 280
 281     find . -print
 282
 283 but in doing so checks each line in an existing C<MANIFEST> file and
 284 includes any comments that are found in the existing C<MANIFEST> file
 285 in the new one. Anything between white space and an end of line within
 286 a C<MANIFEST> file is considered to be a comment. Filenames and
 287 comments are seperated by one or more TAB characters in the
 288 output. All files that match any regular expression in a file
 289 C<MANIFEST.SKIP> (if such a file exists) are ignored.
 290
 291 Manicheck() checks if all the files within a C<MANIFEST> in the
 292 current directory really do exist. It only reports discrepancies and
 293 exits silently if MANIFEST and the tree below the current directory
 294 are in sync.
 295
 296 Filecheck() finds files below the current directory that are not
 297 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
 298 will be consulted. Any file matching a regular expression in such a
 299 file will not be reported as missing in the C<MANIFEST> file.
 300
 301 Fullcheck() does both a manicheck() and a filecheck().
 302
 303 Skipcheck() lists all the files that are skipped due to your
 304 C<MANIFEST.SKIP> file.
 305
 306 Manifind() retruns a hash reference. The keys of the hash are the
 307 files found below the current directory.
 308
 309 Maniread($file) reads a named C<MANIFEST> file (defaults to
 310 C<MANIFEST> in the current directory) and returns a HASH reference
 311 with files being the keys and comments being the values of the HASH.
 312
 313 I<Manicopy($read,$target,$how)> copies the files that are the keys in
 314 the HASH I<%$read> to the named target directory. The HASH reference
 315 I<$read> is typically returned by the maniread() function. This
 316 function is useful for producing a directory tree identical to the
 317 intended distribution tree. The third parameter $how can be used to
 318 specify a different methods of "copying". Valid values are C<cp>,
 319 which actually copies the files, C<ln> which creates hard links, and
 320 C<best> which mostly links the files but copies any symbolic link to
 321 make a tree without any symbolic link. Best is the default.
 322
 323 =head1 MANIFEST.SKIP
 324
 325 The file MANIFEST.SKIP may contain regular expressions of files that
 326 should be ignored by mkmanifest() and filecheck(). The regular
 327 expressions should appear one on each line. A typical example:
 328
 329     \bRCS\b
 330     ^MANIFEST\.
 331     ^Makefile$
 332     ~$
 333     \.html$
 334     \.old$
 335     ^blib/
 336     ^MakeMaker-\d
 337
 338 =head1 EXPORT_OK
 339
 340 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 341 C<&maniread>, and C<&manicopy> are exportable.
 342
 343 =head1 GLOBAL VARIABLES
 344
 345 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 346 results in both a different C<MANIFEST> and a different
 347 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 348 different distributions for different audiences (say a user version
 349 and a developer version including RCS).
 350
 351 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 352 all functions act silently.
 353
 354 =head1 DIAGNOSTICS
 355
 356 All diagnostic output is sent to C<STDERR>.
 357
 358 =over
 359
 360 =item C<Not in MANIFEST:> I<file>
 361
 362 is reported if a file is found, that is missing in the C<MANIFEST>
 363 file which is excluded by a regular expression in the file
 364 C<MANIFEST.SKIP>.
 365
 366 =item C<No such file:> I<file>
 367
 368 is reported if a file mentioned in a C<MANIFEST> file does not
 369 exist.
 370
 371 =item C<MANIFEST:> I<$!>
 372
 373 is reported if C<MANIFEST> could not be opened.
 374
 375 =item C<Added to MANIFEST:> I<file>
 376
 377 is reported by mkmanifest() if $Verbose is set and a file is added
 378 to MANIFEST. $Verbose is set to 1 by default.
 379
 380 =back
 381
 382 =head1 SEE ALSO
 383
 384 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 385
 386 =head1 AUTHOR
 387
 388 Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
 389
 390 =cut