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