

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: Bundle.pm</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'># -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
package CPAN::Bundle;
use strict;
use CPAN::Module;
@CPAN::Bundle::ISA = qw(CPAN::Module);

use vars qw(
            $VERSION
);
$VERSION = &quot;5.5003&quot;;

sub look {
    my $self = shift;
    $CPAN::Frontend-&gt;myprint($self-&gt;as_string);
}

#-&gt; CPAN::Bundle::undelay
sub undelay {
    my $self = shift;
    delete $self-&gt;{later};
    for my $c ( $self-&gt;contains ) {
        my $obj = CPAN::Shell-&gt;expandany($c) or next;
        if ($obj-&gt;id eq $self-&gt;id){
            my $id = $obj-&gt;id;
            $CPAN::Frontend-&gt;mywarn(&quot;$id seems to contain itself, skipping\n&quot;);
            next;
        }
        $obj-&gt;undelay;
    }
}

# mark as dirty/clean
#-&gt; sub CPAN::Bundle::color_cmd_tmps ;
sub color_cmd_tmps {
    my($self) = shift;
    my($depth) = shift || 0;
    my($color) = shift || 0;
    my($ancestors) = shift || [];
    # a module needs to recurse to its cpan_file, a distribution needs
    # to recurse into its prereq_pms, a bundle needs to recurse into its modules

    return if exists $self-&gt;{incommandcolor}
        &amp;&amp; $color==1
        &amp;&amp; $self-&gt;{incommandcolor}==$color;
    if ($depth&gt;=$CPAN::MAX_RECURSION) {
        my $e = CPAN::Exception::RecursiveDependency-&gt;new($ancestors);
        if ($e-&gt;is_resolvable) {
            return $self-&gt;{incommandcolor}=2;
        } else {
            die $e;
        }
    }
    # warn &quot;color_cmd_tmps $depth $color &quot; . $self-&gt;id; # sleep 1;

    for my $c ( $self-&gt;contains ) {
        my $obj = CPAN::Shell-&gt;expandany($c) or next;
        CPAN-&gt;debug(&quot;c[$c]obj[$obj]&quot;) if $CPAN::DEBUG;
        $obj-&gt;color_cmd_tmps($depth+1,$color,[@$ancestors, $self-&gt;id]);
    }
    # never reached code?
    #if ($color==0) {
      #delete $self-&gt;{badtestcnt};
    #}
    $self-&gt;{incommandcolor} = $color;
}

#-&gt; sub CPAN::Bundle::as_string ;
sub as_string {
    my($self) = @_;
    $self-&gt;contains;
    # following line must be &quot;=&quot;, not &quot;||=&quot; because we have a moving target
    $self-&gt;{INST_VERSION} = $self-&gt;inst_version;
    return $self-&gt;SUPER::as_string;
}

#-&gt; sub CPAN::Bundle::contains ;
sub contains {
    my($self) = @_;
    my($inst_file) = $self-&gt;inst_file || &quot;&quot;;
    my($id) = $self-&gt;id;
    $self-&gt;debug(&quot;inst_file[$inst_file]id[$id]&quot;) if $CPAN::DEBUG;
    if ($inst_file &amp;&amp; CPAN::Version-&gt;vlt($self-&gt;inst_version,$self-&gt;cpan_version)) {
        undef $inst_file;
    }
    unless ($inst_file) {
        # Try to get at it in the cpan directory
        $self-&gt;debug(&quot;no inst_file&quot;) if $CPAN::DEBUG;
        my $cpan_file;
        $CPAN::Frontend-&gt;mydie(&quot;I don&#039;t know a bundle with ID $id\n&quot;) unless
              $cpan_file = $self-&gt;cpan_file;
        if ($cpan_file eq &quot;N/A&quot;) {
            $CPAN::Frontend-&gt;mydie(&quot;Bundle $id not found on disk and not on CPAN.
  Maybe stale symlink? Maybe removed during session? Giving up.\n&quot;);
        }
        my $dist = $CPAN::META-&gt;instance(&#039;CPAN::Distribution&#039;,
                                         $self-&gt;cpan_file);
        $self-&gt;debug(&quot;before get id[$dist-&gt;{ID}]&quot;) if $CPAN::DEBUG;
        $dist-&gt;get;
        $self-&gt;debug(&quot;after get id[$dist-&gt;{ID}]&quot;) if $CPAN::DEBUG;
        my($todir) = $CPAN::Config-&gt;{&#039;cpan_home&#039;};
        my(@me,$from,$to,$me);
        @me = split /::/, $self-&gt;id;
        $me[-1] .= &quot;.pm&quot;;
        $me = File::Spec-&gt;catfile(@me);
        $from = $self-&gt;find_bundle_file($dist-&gt;{build_dir},join(&#039;/&#039;,@me));
        $to = File::Spec-&gt;catfile($todir,$me);
        File::Path::mkpath(File::Basename::dirname($to));
        File::Copy::copy($from, $to)
              or Carp::confess(&quot;Couldn&#039;t copy $from to $to: $!&quot;);
        $inst_file = $to;
    }
    my @result;
    my $fh = FileHandle-&gt;new;
    local $/ = &quot;\n&quot;;
    open($fh,$inst_file) or die &quot;Could not open &#039;$inst_file&#039;: $!&quot;;
    my $in_cont = 0;
    $self-&gt;debug(&quot;inst_file[$inst_file]&quot;) if $CPAN::DEBUG;
    while (&lt;$fh&gt;) {
        $in_cont = m/^=(?!head1\s+(?i-xsm:CONTENTS))/ ? 0 :
            m/^=head1\s+(?i-xsm:CONTENTS)/ ? 1 : $in_cont;
        next unless $in_cont;
        next if /^=/;
        s/\#.*//;
        next if /^\s+$/;
        chomp;
        push @result, (split &quot; &quot;, $_, 2)[0];
    }
    close $fh;
    delete $self-&gt;{STATUS};
    $self-&gt;{CONTAINS} = \@result;
    $self-&gt;debug(&quot;CONTAINS[@result]&quot;) if $CPAN::DEBUG;
    unless (@result) {
        $CPAN::Frontend-&gt;mywarn(qq{
The bundle file &quot;$inst_file&quot; may be a broken
bundlefile. It seems not to contain any bundle definition.
Please check the file and if it is bogus, please delete it.
Sorry for the inconvenience.
});
    }
    @result;
}

#-&gt; sub CPAN::Bundle::find_bundle_file
# $where is in local format, $what is in unix format
sub find_bundle_file {
    my($self,$where,$what) = @_;
    $self-&gt;debug(&quot;where[$where]what[$what]&quot;) if $CPAN::DEBUG;
### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
###    my $bu = File::Spec-&gt;catfile($where,$what);
###    return $bu if -f $bu;
    my $manifest = File::Spec-&gt;catfile($where,&quot;MANIFEST&quot;);
    unless (-f $manifest) {
        require ExtUtils::Manifest;
        my $cwd = CPAN::anycwd();
        $self-&gt;safe_chdir($where);
        ExtUtils::Manifest::mkmanifest();
        $self-&gt;safe_chdir($cwd);
    }
    my $fh = FileHandle-&gt;new($manifest)
        or Carp::croak(&quot;Couldn&#039;t open $manifest: $!&quot;);
    local($/) = &quot;\n&quot;;
    my $bundle_filename = $what;
    $bundle_filename =~ s|Bundle.*/||;
    my $bundle_unixpath;
    while (&lt;$fh&gt;) {
        next if /^\s*\#/;
        my($file) = /(\S+)/;
        if ($file =~ m|\Q$what\E$|) {
            $bundle_unixpath = $file;
            # return File::Spec-&gt;catfile($where,$bundle_unixpath); # bad
            last;
        }
        # retry if she managed to have no Bundle directory
        $bundle_unixpath = $file if $file =~ m|\Q$bundle_filename\E$|;
    }
    return File::Spec-&gt;catfile($where, split /\//, $bundle_unixpath)
        if $bundle_unixpath;
    Carp::croak(&quot;Couldn&#039;t find a Bundle file in $where&quot;);
}

# needs to work quite differently from Module::inst_file because of
# cpan_home/Bundle/ directory and the possibility that we have
# shadowing effect. As it makes no sense to take the first in @INC for
# Bundles, we parse them all for $VERSION and take the newest.

#-&gt; sub CPAN::Bundle::inst_file ;
sub inst_file {
    my($self) = @_;
    my($inst_file);
    my(@me);
    @me = split /::/, $self-&gt;id;
    $me[-1] .= &quot;.pm&quot;;
    my($incdir,$bestv);
    foreach $incdir ($CPAN::Config-&gt;{&#039;cpan_home&#039;},@INC) {
        my $parsefile = File::Spec-&gt;catfile($incdir, @me);
        CPAN-&gt;debug(&quot;parsefile[$parsefile]&quot;) if $CPAN::DEBUG;
        next unless -f $parsefile;
        my $have = eval { MM-&gt;parse_version($parsefile); };
        if ($@) {
            $CPAN::Frontend-&gt;mywarn(&quot;Error while parsing version number in file &#039;$parsefile&#039;\n&quot;);
        }
        if (!$bestv || CPAN::Version-&gt;vgt($have,$bestv)) {
            $self-&gt;{INST_FILE} = $parsefile;
            $self-&gt;{INST_VERSION} = $bestv = $have;
        }
    }
    $self-&gt;{INST_FILE};
}

#-&gt; sub CPAN::Bundle::inst_version ;
sub inst_version {
    my($self) = @_;
    $self-&gt;inst_file; # finds INST_VERSION as side effect
    $self-&gt;{INST_VERSION};
}

#-&gt; sub CPAN::Bundle::rematein ;
sub rematein {
    my($self,$meth) = @_;
    $self-&gt;debug(&quot;self[$self] meth[$meth]&quot;) if $CPAN::DEBUG;
    my($id) = $self-&gt;id;
    Carp::croak( &quot;Can&#039;t $meth $id, don&#039;t have an associated bundle file. :-(\n&quot; )
        unless $self-&gt;inst_file || $self-&gt;cpan_file;
    my($s,%fail);
    for $s ($self-&gt;contains) {
        my($type) = $s =~ m|/| ? &#039;CPAN::Distribution&#039; :
            $s =~ m|^Bundle::| ? &#039;CPAN::Bundle&#039; : &#039;CPAN::Module&#039;;
        if ($type eq &#039;CPAN::Distribution&#039;) {
            $CPAN::Frontend-&gt;mywarn(qq{
The Bundle }.$self-&gt;id.qq{ contains
explicitly a file &#039;$s&#039;.
Going to $meth that.
});
            $CPAN::Frontend-&gt;mysleep(5);
        }
        # possibly noisy action:
        $self-&gt;debug(&quot;type[$type] s[$s]&quot;) if $CPAN::DEBUG;
        my $obj = $CPAN::META-&gt;instance($type,$s);
        $obj-&gt;{reqtype} = $self-&gt;{reqtype};
        # $obj-&gt;$meth();
        # XXX should optional be based on whether bundle was optional? -- xdg, 2012-04-01
        # A: Sure, what could demand otherwise? --andk, 2013-11-25
        CPAN::Queue-&gt;queue_item(qmod =&gt; $obj-&gt;id, reqtype =&gt; $self-&gt;{reqtype}, optional =&gt; !$self-&gt;{mandatory});
    }
}

# If a bundle contains another that contains an xs_file we have here,
# we just don&#039;t bother I suppose
#-&gt; sub CPAN::Bundle::xs_file
sub xs_file {
    return 0;
}

#-&gt; sub CPAN::Bundle::force ;
sub fforce   { shift-&gt;rematein(&#039;fforce&#039;,@_); }
#-&gt; sub CPAN::Bundle::force ;
sub force   { shift-&gt;rematein(&#039;force&#039;,@_); }
#-&gt; sub CPAN::Bundle::notest ;
sub notest  { shift-&gt;rematein(&#039;notest&#039;,@_); }
#-&gt; sub CPAN::Bundle::get ;
sub get     { shift-&gt;rematein(&#039;get&#039;,@_); }
#-&gt; sub CPAN::Bundle::make ;
sub make    { shift-&gt;rematein(&#039;make&#039;,@_); }
#-&gt; sub CPAN::Bundle::test ;
sub test    {
    my $self = shift;
    # $self-&gt;{badtestcnt} ||= 0;
    $self-&gt;rematein(&#039;test&#039;,@_);
}
#-&gt; sub CPAN::Bundle::install ;
sub install {
  my $self = shift;
  $self-&gt;rematein(&#039;install&#039;,@_);
}
#-&gt; sub CPAN::Bundle::clean ;
sub clean   { shift-&gt;rematein(&#039;clean&#039;,@_); }

#-&gt; sub CPAN::Bundle::uptodate ;
sub uptodate {
    my($self) = @_;
    return 0 unless $self-&gt;SUPER::uptodate; # we must have the current Bundle def
    my $c;
    foreach $c ($self-&gt;contains) {
        my $obj = CPAN::Shell-&gt;expandany($c);
        return 0 unless $obj-&gt;uptodate;
    }
    return 1;
}

#-&gt; sub CPAN::Bundle::readme ;
sub readme  {
    my($self) = @_;
    my($file) = $self-&gt;cpan_file or $CPAN::Frontend-&gt;myprint(qq{
No File found for bundle } . $self-&gt;id . qq{\n}), return;
    $self-&gt;debug(&quot;self[$self] file[$file]&quot;) if $CPAN::DEBUG;
    $CPAN::META-&gt;instance(&#039;CPAN::Distribution&#039;,$file)-&gt;readme;
}

1;
</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/share/perl5/vendor_perl/CPAN/Bundle.pm'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Fusr%2Fshare%2Fperl5%2Fvendor_perl%2FCPAN' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>