1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2 # vim: ts=4 sts=4 sw=4:
6 @CPAN::Bundle::ISA = qw(CPAN::Module);
15 $CPAN::Frontend->myprint($self->as_string);
18 #-> CPAN::Bundle::undelay
21 delete $self->{later};
22 for my $c ( $self->contains ) {
23 my $obj = CPAN::Shell->expandany($c) or next;
29 #-> sub CPAN::Bundle::color_cmd_tmps ;
32 my($depth) = shift || 0;
33 my($color) = shift || 0;
34 my($ancestors) = shift || [];
35 # a module needs to recurse to its cpan_file, a distribution needs
36 # to recurse into its prereq_pms, a bundle needs to recurse into its modules
38 return if exists $self->{incommandcolor}
40 && $self->{incommandcolor}==$color;
41 if ($depth>=$CPAN::MAX_RECURSION) {
42 die(CPAN::Exception::RecursiveDependency->new($ancestors));
44 # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
46 for my $c ( $self->contains ) {
47 my $obj = CPAN::Shell->expandany($c) or next;
48 CPAN->debug("c[$c]obj[$obj]") if $CPAN::DEBUG;
49 $obj->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
53 #delete $self->{badtestcnt};
55 $self->{incommandcolor} = $color;
58 #-> sub CPAN::Bundle::as_string ;
62 # following line must be "=", not "||=" because we have a moving target
63 $self->{INST_VERSION} = $self->inst_version;
64 return $self->SUPER::as_string;
67 #-> sub CPAN::Bundle::contains ;
70 my($inst_file) = $self->inst_file || "";
72 $self->debug("inst_file[$inst_file]id[$id]") if $CPAN::DEBUG;
73 if ($inst_file && CPAN::Version->vlt($self->inst_version,$self->cpan_version)) {
77 # Try to get at it in the cpan directory
78 $self->debug("no inst_file") if $CPAN::DEBUG;
80 $CPAN::Frontend->mydie("I don't know a bundle with ID $id\n") unless
81 $cpan_file = $self->cpan_file;
82 if ($cpan_file eq "N/A") {
83 $CPAN::Frontend->mydie("Bundle $id not found on disk and not on CPAN.
84 Maybe stale symlink? Maybe removed during session? Giving up.\n");
86 my $dist = $CPAN::META->instance('CPAN::Distribution',
88 $self->debug("before get id[$dist->{ID}]") if $CPAN::DEBUG;
90 $self->debug("after get id[$dist->{ID}]") if $CPAN::DEBUG;
91 my($todir) = $CPAN::Config->{'cpan_home'};
92 my(@me,$from,$to,$me);
93 @me = split /::/, $self->id;
95 $me = File::Spec->catfile(@me);
96 $from = $self->find_bundle_file($dist->{build_dir},join('/',@me));
97 $to = File::Spec->catfile($todir,$me);
98 File::Path::mkpath(File::Basename::dirname($to));
99 File::Copy::copy($from, $to)
100 or Carp::confess("Couldn't copy $from to $to: $!");
104 my $fh = FileHandle->new;
106 open($fh,$inst_file) or die "Could not open '$inst_file': $!";
108 $self->debug("inst_file[$inst_file]") if $CPAN::DEBUG;
110 $in_cont = m/^=(?!head1\s+(?i-xsm:CONTENTS))/ ? 0 :
111 m/^=head1\s+(?i-xsm:CONTENTS)/ ? 1 : $in_cont;
112 next unless $in_cont;
117 push @result, (split " ", $_, 2)[0];
120 delete $self->{STATUS};
121 $self->{CONTAINS} = \@result;
122 $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
124 $CPAN::Frontend->mywarn(qq{
125 The bundle file "$inst_file" may be a broken
126 bundlefile. It seems not to contain any bundle definition.
127 Please check the file and if it is bogus, please delete it.
128 Sorry for the inconvenience.
134 #-> sub CPAN::Bundle::find_bundle_file
135 # $where is in local format, $what is in unix format
136 sub find_bundle_file {
137 my($self,$where,$what) = @_;
138 $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
139 ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
140 ### my $bu = File::Spec->catfile($where,$what);
141 ### return $bu if -f $bu;
142 my $manifest = File::Spec->catfile($where,"MANIFEST");
143 unless (-f $manifest) {
144 require ExtUtils::Manifest;
145 my $cwd = CPAN::anycwd();
146 $self->safe_chdir($where);
147 ExtUtils::Manifest::mkmanifest();
148 $self->safe_chdir($cwd);
150 my $fh = FileHandle->new($manifest)
151 or Carp::croak("Couldn't open $manifest: $!");
153 my $bundle_filename = $what;
154 $bundle_filename =~ s|Bundle.*/||;
159 if ($file =~ m|\Q$what\E$|) {
160 $bundle_unixpath = $file;
161 # return File::Spec->catfile($where,$bundle_unixpath); # bad
164 # retry if she managed to have no Bundle directory
165 $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
167 return File::Spec->catfile($where, split /\//, $bundle_unixpath)
169 Carp::croak("Couldn't find a Bundle file in $where");
172 # needs to work quite differently from Module::inst_file because of
173 # cpan_home/Bundle/ directory and the possibility that we have
174 # shadowing effect. As it makes no sense to take the first in @INC for
175 # Bundles, we parse them all for $VERSION and take the newest.
177 #-> sub CPAN::Bundle::inst_file ;
182 @me = split /::/, $self->id;
185 foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
186 my $parsefile = File::Spec->catfile($incdir, @me);
187 CPAN->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
188 next unless -f $parsefile;
189 my $have = eval { MM->parse_version($parsefile); };
191 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
193 if (!$bestv || CPAN::Version->vgt($have,$bestv)) {
194 $self->{INST_FILE} = $parsefile;
195 $self->{INST_VERSION} = $bestv = $have;
201 #-> sub CPAN::Bundle::inst_version ;
204 $self->inst_file; # finds INST_VERSION as side effect
205 $self->{INST_VERSION};
208 #-> sub CPAN::Bundle::rematein ;
210 my($self,$meth) = @_;
211 $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
213 Carp::croak( "Can't $meth $id, don't have an associated bundle file. :-(\n" )
214 unless $self->inst_file || $self->cpan_file;
216 for $s ($self->contains) {
217 my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
218 $s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
219 if ($type eq 'CPAN::Distribution') {
220 $CPAN::Frontend->mywarn(qq{
221 The Bundle }.$self->id.qq{ contains
222 explicitly a file '$s'.
225 $CPAN::Frontend->mysleep(5);
227 # possibly noisy action:
228 $self->debug("type[$type] s[$s]") if $CPAN::DEBUG;
229 my $obj = $CPAN::META->instance($type,$s);
230 $obj->{reqtype} = $self->{reqtype};
235 # If a bundle contains another that contains an xs_file we have here,
236 # we just don't bother I suppose
237 #-> sub CPAN::Bundle::xs_file
242 #-> sub CPAN::Bundle::force ;
243 sub fforce { shift->rematein('fforce',@_); }
244 #-> sub CPAN::Bundle::force ;
245 sub force { shift->rematein('force',@_); }
246 #-> sub CPAN::Bundle::notest ;
247 sub notest { shift->rematein('notest',@_); }
248 #-> sub CPAN::Bundle::get ;
249 sub get { shift->rematein('get',@_); }
250 #-> sub CPAN::Bundle::make ;
251 sub make { shift->rematein('make',@_); }
252 #-> sub CPAN::Bundle::test ;
255 # $self->{badtestcnt} ||= 0;
256 $self->rematein('test',@_);
258 #-> sub CPAN::Bundle::install ;
261 $self->rematein('install',@_);
263 #-> sub CPAN::Bundle::clean ;
264 sub clean { shift->rematein('clean',@_); }
266 #-> sub CPAN::Bundle::uptodate ;
269 return 0 unless $self->SUPER::uptodate; # we mut have the current Bundle def
271 foreach $c ($self->contains) {
272 my $obj = CPAN::Shell->expandany($c);
273 return 0 unless $obj->uptodate;
278 #-> sub CPAN::Bundle::readme ;
281 my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
282 No File found for bundle } . $self->id . qq{\n}), return;
283 $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
284 $CPAN::META->instance('CPAN::Distribution',$file)->readme;