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 = substr(q$Revision: 1.33 $, 10);
  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 $found = manifind();
  89     my $file;
  90     my(@missfile,@missentry);
  91     if ($arg & 1){
  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 $skipwarn = $arg & 4;
 104         foreach $file (sort keys %$found){
 105             if (&$matches($file)){
 106                 warn "Skipping $file\n" if $skipwarn;
 107                 next;
 108             }
 109             warn "Debug: manicheck checking from disk $file\n" if $Debug;
 110             unless ( exists $read->{$file} ) {
 111                 warn "Not in $MANIFEST: $file\n" unless $Quiet;
 112                 push @missentry, $file;
 113             }
 114         }
 115     }
 116     (\@missfile,\@missentry);
 117 }
 118
 119 sub maniread {
 120     my ($mfile) = @_;
 121     $mfile ||= $MANIFEST;
 122     my $read = {};
 123     local *M;
 124     unless (open M, $mfile){
 125         warn "$mfile: $!";
 126         return $read;
 127     }
 128     while (<M>){
 129         chomp;
 130         next if /^#/;
 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";
 155     local *M;
 156     return $matches unless -f $mfile;
 157     open M, $mfile or return $matches;
 158     while (<M>){
 159         chomp;
 160         next if /^#/;
 161         next if /^\s*$/;
 162         push @skip, $_;
 163     }
 164     close M;
 165     my $opts = $Is_VMS ? 'oi ' : 'o ';
 166     my $sub = "\$matches = "
 167         . "sub { my(\$arg)=\@_; return 1 if "
 168         . join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
 169         . " }";
 170     eval $sub;
 171     print "Debug: $sub\n" if $Debug;
 172     $matches;
 173 }
 174
 175 sub manicopy {
 176     my($read,$target,$how)=@_;
 177     croak "manicopy() called without target argument" unless defined $target;
 178     $how ||= 'cp';
 179     require File::Path;
 180     require File::Basename;
 181     my(%dirs,$file);
 182     $target = VMS::Filespec::unixify($target) if $Is_VMS;
 183     umask 0 unless $Is_VMS;
 184     File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
 185     foreach $file (keys %$read){
 186         $file = VMS::Filespec::unixify($file) if $Is_VMS;
 187         if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
 188             my $dir = File::Basename::dirname($file);
 189             $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 190             File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
 191         }
 192         cp_if_diff($file, "$target/$file", $how);
 193     }
 194 }
 195
 196 sub cp_if_diff {
 197     my($from, $to, $how)=@_;
 198     -f $from or carp "$0: $from not found";
 199     my($diff) = 0;
 200     local(*F,*T);
 201     open(F,$from) or croak "Can't read $from: $!\n";
 202     if (open(T,$to)) {
 203         while (<F>) { $diff++,last if $_ ne <T>; }
 204         $diff++ unless eof(T);
 205         close T;
 206     }
 207     else { $diff++; }
 208     close F;
 209     if ($diff) {
 210         if (-e $to) {
 211             unlink($to) or confess "unlink $to: $!";
 212         }
 213       STRICT_SWITCH: {
 214             best($from,$to), last STRICT_SWITCH if $how eq 'best';
 215             cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
 216             ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
 217             croak("ExtUtils::Manifest::cp_if_diff " .
 218                   "called with illegal how argument [$how]. " .
 219                   "Legal values are 'best', 'cp', and 'ln'.");
 220         }
 221     }
 222 }
 223
 224 sub cp {
 225     my ($srcFile, $dstFile) = @_;
 226     my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
 227     copy($srcFile,$dstFile);
 228     utime $access, $mod + ($Is_VMS ? 1 : 0), $dstFile;
 229     # chmod a+rX-w,go-w
 230     chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
 231 }
 232
 233 sub ln {
 234     my ($srcFile, $dstFile) = @_;
 235     return &cp if $Is_VMS;
 236     link($srcFile, $dstFile);
 237     local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
 238     my $mode= 0444 | (stat)[2] & 0700;
 239     chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
 240 }
 241
 242 sub best {
 243     my ($srcFile, $dstFile) = @_;
 244     if (-l $srcFile) {
 245         cp($srcFile, $dstFile);
 246     } else {
 247         ln($srcFile, $dstFile) or cp($srcFile, $dstFile);
 248     }
 249 }
 250
 251 1;
 252
 253 __END__
 254
 255 =head1 NAME
 256
 257 ExtUtils::Manifest - utilities to write and check a MANIFEST file
 258
 259 =head1 SYNOPSIS
 260
 261 C<require ExtUtils::Manifest;>
 262
 263 C<ExtUtils::Manifest::mkmanifest;>
 264
 265 C<ExtUtils::Manifest::manicheck;>
 266
 267 C<ExtUtils::Manifest::filecheck;>
 268
 269 C<ExtUtils::Manifest::fullcheck;>
 270
 271 C<ExtUtils::Manifest::skipcheck;>
 272
 273 C<ExtUtild::Manifest::manifind();>
 274
 275 C<ExtUtils::Manifest::maniread($file);>
 276
 277 C<ExtUtils::Manifest::manicopy($read,$target,$how);>
 278
 279 =head1 DESCRIPTION
 280
 281 Mkmanifest() writes all files in and below the current directory to a
 282 file named in the global variable $ExtUtils::Manifest::MANIFEST (which
 283 defaults to C<MANIFEST>) in the current directory. It works similar to
 284
 285     find . -print
 286
 287 but in doing so checks each line in an existing C<MANIFEST> file and
 288 includes any comments that are found in the existing C<MANIFEST> file
 289 in the new one. Anything between white space and an end of line within
 290 a C<MANIFEST> file is considered to be a comment. Filenames and
 291 comments are seperated by one or more TAB characters in the
 292 output. All files that match any regular expression in a file
 293 C<MANIFEST.SKIP> (if such a file exists) are ignored.
 294
 295 Manicheck() checks if all the files within a C<MANIFEST> in the
 296 current directory really do exist. It only reports discrepancies and
 297 exits silently if MANIFEST and the tree below the current directory
 298 are in sync.
 299
 300 Filecheck() finds files below the current directory that are not
 301 mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
 302 will be consulted. Any file matching a regular expression in such a
 303 file will not be reported as missing in the C<MANIFEST> file.
 304
 305 Fullcheck() does both a manicheck() and a filecheck().
 306
 307 Skipcheck() lists all the files that are skipped due to your
 308 C<MANIFEST.SKIP> file.
 309
 310 Manifind() retruns a hash reference. The keys of the hash are the
 311 files found below the current directory.
 312
 313 Maniread($file) reads a named C<MANIFEST> file (defaults to
 314 C<MANIFEST> in the current directory) and returns a HASH reference
 315 with files being the keys and comments being the values of the HASH.
 316 Blank lines and lines which start with C<#> in the C<MANIFEST> file
 317 are discarded.
 318
 319 I<Manicopy($read,$target,$how)> copies the files that are the keys in
 320 the HASH I<%$read> to the named target directory. The HASH reference
 321 I<$read> is typically returned by the maniread() function. This
 322 function is useful for producing a directory tree identical to the
 323 intended distribution tree. The third parameter $how can be used to
 324 specify a different methods of "copying". Valid values are C<cp>,
 325 which actually copies the files, C<ln> which creates hard links, and
 326 C<best> which mostly links the files but copies any symbolic link to
 327 make a tree without any symbolic link. Best is the default.
 328
 329 =head1 MANIFEST.SKIP
 330
 331 The file MANIFEST.SKIP may contain regular expressions of files that
 332 should be ignored by mkmanifest() and filecheck(). The regular
 333 expressions should appear one on each line. Blank lines and lines
 334 which start with C<#> are skipped.  Use C<\#> if you need a regular
 335 expression to start with a sharp character. A typical example:
 336
 337     \bRCS\b
 338     ^MANIFEST\.
 339     ^Makefile$
 340     ~$
 341     \.html$
 342     \.old$
 343     ^blib/
 344     ^MakeMaker-\d
 345
 346 =head1 EXPORT_OK
 347
 348 C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
 349 C<&maniread>, and C<&manicopy> are exportable.
 350
 351 =head1 GLOBAL VARIABLES
 352
 353 C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
 354 results in both a different C<MANIFEST> and a different
 355 C<MANIFEST.SKIP> file. This is useful if you want to maintain
 356 different distributions for different audiences (say a user version
 357 and a developer version including RCS).
 358
 359 C<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
 360 all functions act silently.
 361
 362 =head1 DIAGNOSTICS
 363
 364 All diagnostic output is sent to C<STDERR>.
 365
 366 =over
 367
 368 =item C<Not in MANIFEST:> I<file>
 369
 370 is reported if a file is found, that is missing in the C<MANIFEST>
 371 file which is excluded by a regular expression in the file
 372 C<MANIFEST.SKIP>.
 373
 374 =item C<No such file:> I<file>
 375
 376 is reported if a file mentioned in a C<MANIFEST> file does not
 377 exist.
 378
 379 =item C<MANIFEST:> I<$!>
 380
 381 is reported if C<MANIFEST> could not be opened.
 382
 383 =item C<Added to MANIFEST:> I<file>
 384
 385 is reported by mkmanifest() if $Verbose is set and a file is added
 386 to MANIFEST. $Verbose is set to 1 by default.
 387
 388 =back
 389
 390 =head1 SEE ALSO
 391
 392 L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
 393
 394 =head1 AUTHOR
 395
 396 Andreas Koenig <F<koenig@franz.ww.TU-Berlin.DE>>
 397
 398 =cut