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