summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm87
1 files changed, 45 insertions, 42 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm
index 1f75535fa65..8f8ad7bd4c7 100644
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm
+++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Source.pm
@@ -1,4 +1,5 @@
package CPANPLUS::Internals::Source;
+use deprecate;
use strict;
@@ -18,6 +19,9 @@ use Params::Check qw[check];
use Module::Load::Conditional qw[can_load];
use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
+use vars qw[$VERSION];
+$VERSION = "0.9135";
+
$Params::Check::VERBOSE = 1;
### list of methods the parent class must implement
@@ -551,13 +555,12 @@ sub __create_author_tree {
my ($tot,$prce,$prc,$idx);
- $args->{verbose}
- and local $|=1,
- $tot = scalar(split /\n/, $cont),
- ($prce, $prc, $idx) = (int $tot / 25, 0, 0);
-
- $args->{verbose}
- and print "\t0%";
+ if ( $args->{verbose} and local $|=1 ) {
+ no warnings;
+ $tot = scalar(split /\n/, $cont);
+ ($prce, $prc, $idx) = (int $tot / 25, 0, 0);
+ print "\t0%";
+ }
for ( split /\n/, $cont ) {
my($id, $name, $email) = m/^alias \s+
@@ -630,7 +633,7 @@ sub _create_mod_tree {
my $self = shift;
my %hash = @_;
my $conf = $self->configure_object;
-
+ my $base = $conf->_get_mirror('base');
my $tmpl = {
path => { default => $conf->get_conf('base') },
@@ -647,6 +650,8 @@ sub _create_mod_tree {
my $dslip_tree = $self->__create_dslip_tree( %$args );
+ my $author_tree = $self->author_tree;
+
### extract the file ###
my $ae = Archive::Extract->new( archive => $file ) or return;
my $out = STRIP_GZ_SUFFIX->($file);
@@ -664,48 +669,47 @@ sub _create_mod_tree {
my($past_header, $count, $tot, $prce, $prc, $idx);
- $args->{verbose}
- and local $|=1,
- $tot = scalar(split /\n/, $content),
- ($prce, $prc, $idx) = (int $tot / 25, 0, 0);
-
- $args->{verbose}
- and print "\t0%";
+ if ( $args->{verbose} and local $|=1 ) {
+ no warnings;
+ $tot = scalar(split /\n/, $content);
+ ($prce, $prc, $idx) = (int $tot / 25, 0, 0);
+ print "\t0%";
+ }
for ( split /\n/, $content ) {
- ### quick hack to read past the header of the file ###
- ### this is still rather evil... fix some time - Kane
- if( m|^\s*$| ) {
- unless( $count ) {
- error(loc("Could not determine line count from %1", $file));
- return;
- }
- $past_header = 1;
- }
### we're still in the header -- find the amount of lines we expect
unless( $past_header ) {
+ ### header has ended -- did we get the line count?
+ if( m|^\s*$| ) {
+ unless( $count ) {
+ error(loc("Could not determine line count from %1", $file));
+ return;
+ }
+ $past_header = 1;
+
### if the line count doesn't match what we expect, bail out
### this should address: #45644: detect broken index
- $count = $1 if /^Line-Count:\s+(\d+)/;
- if( $count ) {
- if( $lines < $count ) {
- error(loc("Expected to read at least %1 lines, but %2 ".
- "contains only %3 lines!",
- $count, $file, $lines ));
- return;
+ } else {
+ $count = $1 if /^Line-Count:\s+(\d+)/;
+ if( $count ) {
+ if( $lines < $count ) {
+ error(loc("Expected to read at least %1 lines, but %2 ".
+ "contains only %3 lines!",
+ $count, $file, $lines ));
+ return;
+ }
}
}
+
### still in the header, keep moving
next;
}
- ### skip empty lines ###
- next unless /\S/;
- chomp;
-
my @data = split /\s+/;
+ ### three fields expected on each line
+ next unless @data == 3;
### filter out the author and filename as well ###
### authors can apparently have digits in their names,
@@ -720,7 +724,7 @@ sub _create_mod_tree {
### remove file name from the path
$data[2] =~ s|/[^/]+$||;
- my $aobj = $self->author_tree($author);
+ my $aobj = $author_tree->{$author};
unless( $aobj ) {
error( loc( "No such author '%1' -- can't make module object " .
"'%2' that is supposed to belong to this author",
@@ -728,15 +732,14 @@ sub _create_mod_tree {
next;
}
+ my $dslip_mod = $dslip_tree->{ $data[0] };
+
### adding the dslip info
- ### probably can use some optimization
my $dslip;
for my $item ( qw[ statd stats statl stati statp ] ) {
### checking if there's an entry in the dslip info before
### catting it on. appeasing warnings this way
- $dslip .= $dslip_tree->{ $data[0] }->{$item}
- ? $dslip_tree->{ $data[0] }->{$item}
- : ' ';
+ $dslip .= $dslip_mod->{$item} || ' ';
}
### XXX this could be sped up if we used author names, not author
@@ -751,7 +754,7 @@ sub _create_mod_tree {
? '0.0'
: $data[1]),
path => File::Spec::Unix->catfile(
- $conf->_get_mirror('base'),
+ $base,
$data[2],
), # extended path on the cpan mirror,
# like /A/AB/ABIGAIL
@@ -759,7 +762,7 @@ sub _create_mod_tree {
author => $aobj,
package => $package, # package name, like
# 'foo-bar-baz-1.03.tar.gz'
- description => $dslip_tree->{ $data[0] }->{'description'},
+ description => $dslip_mod->{'description'},
dslip => $dslip,
mtime => '',
) or error( loc( "Could not add module '%1'", $data[0] ) );