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