Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / Module / Install / Admin / Manifest.pm
CommitLineData
3fea05b9 1package Module::Install::Admin::Manifest;
2
3use strict;
4use Module::Install::Base;
5
6use vars qw{$VERSION @ISA};
7BEGIN {
8 $VERSION = '0.91';;
9 @ISA = qw{Module::Install::Base};
10}
11
12use Cwd;
13use File::Spec;
14
15# XXX I really want this method in Module::Install::Admin::Makefile
16# But you can't call across Admin modules. Audrey??
17sub dist_preop {
18 my ($self, $distdir) = @_;
19 return if $self->check_manifest;
20 print <<"END_MESSAGE";
21
22It appears that your MANIFEST does not contain the same components that
23are currently in the 'inc' directory.
24
25Please try running 'make manifest' and then run 'make dist' again.
26
27Remember to use the MANIFEST.SKIP file to control things that should not
28end up in your MANIFEST. See 'perldoc ExtUtils::Manifest' for details.
29
30END_MESSAGE
31 return if $self->prompt(
32 'Do you *really* want to continue making a distribution?', 'n'
33 ) =~ /^[Yy]/;
34
35 if ( -d $distdir ) {
36 require File::Path;
37 File::Path::rmtree($distdir);
38 }
39
40 exit(1);
41}
42
43# XXX Needs a refactoring.
44sub check_manifest {
45 my $self = shift;
46 my $prefix = $self->_top->{prefix};
47 my ($manifest, $manifest_path, $relative_path) = $self->_read_manifest or return;
48 my $manifest_skip = "$manifest_path.SKIP";
49 my @skip;
50
51 if ( -f "$manifest_path.SKIP" ) {
52 open SKIP, $manifest_skip
53 or die "Can't open $manifest_skip for input:\n$!";
54 @skip = map {chomp; $_} <SKIP>;
55 close SKIP;
56 }
57
58 my %manifest;
59 for ( my $i = 0; $i < @$manifest; $i++ ) {
60 my $path = $manifest->[$i];
61 $path =~ s/\s.*//;
62 $path =~ s/^\.[\\\/]//;
63 $path =~ s/[\\\/]/\//g;
64 next unless $path =~ m/^\Q$prefix\E\b/i;
65 $manifest{$path} = \$manifest->[$i];
66 }
67
68 ADDLOOP:
69 for my $pathname ( sort $self->_find_files($prefix) ) {
70 $pathname = "$relative_path/$pathname" if length($relative_path);
71 $pathname =~ s!//+!/!g;
72 next unless -f $pathname;
73 if ( defined $manifest{$pathname} ) {
74 delete $manifest{$pathname};
75 } else {
76 for ( @skip ) {
77 next ADDLOOP if $pathname =~ /$_/;
78 }
79 return 0;
80 }
81 }
82 if ( keys %manifest ) {
83 foreach ( keys %manifest ) {
84 print "Found extra file $_\n";
85 }
86 return 0;
87 }
88 return 1;
89}
90
91sub _read_manifest {
92 my $manifest = [];
93 my $manifest_path = '';
94 my $relative_path = '';
95 my @relative_dirs = ();
96 my $cwd = Cwd::cwd();
97 my @cwd_dirs = File::Spec->splitdir($cwd);
98 while ( @cwd_dirs ) {
99 last unless -f File::Spec->catfile(@cwd_dirs, 'Makefile.PL');
100 my $path = File::Spec->catfile(@cwd_dirs, 'MANIFEST');
101 if ( -f $path ) {
102 $manifest_path = $path;
103 last;
104 }
105 unshift @relative_dirs, pop(@cwd_dirs);
106 }
107
108 unless ( length($manifest_path) ) {
109 warn "Can't locate the MANIFEST file for '$cwd'\n";
110 return;
111 }
112
113 $relative_path = join '/', @relative_dirs if @relative_dirs;
114
115 local *MANIFEST;
116 open MANIFEST, $manifest_path
117 or die "Can't open $manifest_path for input:\n$!";
118 @$manifest = map { chomp; $_ } <MANIFEST>;
119 close MANIFEST;
120
121 return ($manifest, $manifest_path, $relative_path);
122}
123
124# XXX I copied this from M::I::A::Find because I can't call that one. Please
125# refactor/fix.
126sub _find_files {
127 my ($self, $file, $path) = @_;
128 $path = '' if not defined $path;
129 $file = "$path/$file" if length($path);
130 if ( -f $file ) {
131 return ( $file );
132 } elsif ( -d $file ) {
133 my @files = ();
134 local *DIR;
135 opendir(DIR, $file) or die "Can't opendir $file";
136 while (defined(my $new_file = readdir(DIR))) {
137 next if $new_file =~ /^(\.|\.\.)$/;
138 push @files, $self->_find_files($new_file, $file);
139 }
140 return @files;
141 }
142 return ();
143}
144
1451;
146
147__END__
148
149=pod
150
151=head1 COPYRIGHT
152
153Copyright 2003, 2004 by
154Audrey Tang E<lt>autrijus@autrijus.orgE<gt>,
155Brian Ingerson E<lt>ingy@cpan.orgE<gt>
156
157This program is free software; you can redistribute it and/or modify it
158under the same terms as Perl itself.
159
160See L<http://www.perl.com/perl/misc/Artistic.html>
161
162=cut