lib/ExtUtils/Manifest.pm

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