X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=samples%2Fgengentooisms;h=0c39c00ddce471865d57e1c9a1874a4bec0d0d51;hb=961a3a0b428269fd404fc461fb07d9b3f45dd745;hp=e5f8f1315175c63148ba8572e02b61c0d1e7fae1;hpb=81b5731129ec4df7c299707f9650bf4a693a8154;p=perl%2Fmodules%2FCPANPLUS-Dist-Gentoo.git diff --git a/samples/gengentooisms b/samples/gengentooisms index e5f8f13..0c39c00 100755 --- a/samples/gengentooisms +++ b/samples/gengentooisms @@ -5,25 +5,14 @@ use warnings; use Fatal; use File::Spec; -use File::Copy qw/copy/; -use List::Util qw/max reduce/; +use File::Copy qw; +use List::Util qw; use Storable (); use Term::ANSIColor; -use CPAN::DistnameInfo; -BEGIN { - my $old_cdi_new = \&CPAN::DistnameInfo::new; - die 'CPAN::DistnameInfo is not loaded' unless $old_cdi_new; - my $new_cdi_new = sub { - my $dist = $old_cdi_new->(@_); - $dist->{version} =~ s/-withoutworldwriteables$//; - $dist; - }; - no warnings 'redefine'; - *CPAN::DistnameInfo::new = $new_cdi_new; -} +use CPAN::DistnameInfo 0.11; -use Capture::Tiny qw/capture/; +use Capture::Tiny qw; use LWP::UserAgent; use Parse::CPAN::Packages::Fast; @@ -43,6 +32,8 @@ use constant STATE_FILE => 'gentooisms.state.sto'; my %is_on_cpan = ( 'Audio-CD-disc-cover' => 0, + 'Video-Frequencies' => 0, + 'Sphinx-Search' => 1, 'WattsUp-Daemon' => 1, ); @@ -52,15 +43,9 @@ sub p { printf $fmt, @args; } -sub timestamp { - my $tm = File::Spec->catfile(PORTAGE, 'metadata', 'timestamp.chk'); - return unless -e $tm; - open my $fh, '<', $tm; - local $/; - <$fh>; -} - -my $timestamp = timestamp(); +my $timestamp = CPANPLUS::Dist::Gentoo::Maps::get_portage_timestamp(PORTAGE); +die 'Could not read the timestamp from the portage tree ' . PORTAGE . "\n" + unless defined $timestamp; { my $ua; @@ -85,7 +70,7 @@ my (@not_on_cpan, @unfindable, @missing, %name_mismatch, %version); sub parse_portage_tree { my $pcp = Parse::CPAN::Packages::Fast->new(PACKAGES); - for my $category (qw/perl-core dev-perl/) { + for my $category (qw) { p(0, "Browsing the $category category.\n"); my $cat_dir = File::Spec->catdir(PORTAGE, $category); @@ -95,6 +80,13 @@ sub parse_portage_tree { my $pkg_name = (File::Spec->splitdir($pkg_dir))[-1]; + my $last = reduce { $a->[1] > $b->[1] ? $a : $b } + grep $_->[1] != 9999, + map [ $_, CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_) ], + glob File::Spec->catfile($pkg_dir, "$pkg_name-*"); + my ($ebuild, $atom) = @$last; + p(1, "%s/%s-%s\n", map $atom->$_, qw); + if (exists $is_on_cpan{$pkg_name} and not $is_on_cpan{$pkg_name}) { p(2, colored("$pkg_name is not a CPAN distribution (forced)", 'bright_red') . "\n"); @@ -102,12 +94,6 @@ sub parse_portage_tree { next; } - my $last = reduce { $a->[1] > $b->[1] ? $a : $b } - map [ $_, CPANPLUS::Dist::Gentoo::Atom->new_from_ebuild($_) ], - glob File::Spec->catfile($pkg_dir, "$pkg_name-*"); - my ($ebuild, $atom) = @$last; - p(1, "%s/%s-%s\n", map $atom->$_, qw/category name version/); - my $uri; if (exists $fetched_uri{$ebuild}) { $uri = $fetched_uri{$ebuild}; @@ -122,10 +108,25 @@ sub parse_portage_tree { die "system(\"@cmd\") returned $ret and/or failed with status $code"; } - while ($err =~ /SRC_URI=((['"]).*?\2|\S+)/gs) { - $uri = $1; - $uri =~ s{^(['"])(.*?)\1$}{$2}s; + my %map; + while ($err =~ /([a-zA-Z0-9_]+)=((['"]).*?\3|\S+)/gs) { + my $key = $1; + my $val = $2; + $val =~ s{^(['"])(.*?)\1$}{$2}s; + $map{$key} = $val; } + + $uri = $map{SRC_URI}; + unless (defined $uri) { + my $author = $map{MODULE_AUTHOR}; + if (defined $author) { + my ($au, $a) = $author =~ /^((.).)/; + my $dist_version = $map{MODULE_VERSION}; + $dist_version = $last->[1] unless defined $dist_version; + $uri = "mirror://cpan/$a/$au/$author/$pkg_name/$dist_version.tar.gz"; + } + } + $fetched_uri{$ebuild} = $uri; Storable::store([ $timestamp, @@ -136,16 +137,14 @@ sub parse_portage_tree { my ($fqn_dist, $path); if (defined $uri) { if ($uri =~ m{cpan.*?/id/(\S+)}) { - $fqn_dist = $1; - $path = "authors/id/$fqn_dist"; - $is_on_cpan{$pkg_name} = 1; + $fqn_dist = $1; + $path = "authors/id/$fqn_dist"; } elsif ($uri =~ m{mirror://cpan/(\S+)}) { - $path = $1; - $is_on_cpan{$pkg_name} = 1; + $path = $1; } elsif ($uri =~ m{/([^/\s]+)(?:\s|$)}) { - my $archive = $1; + my $archive = $1; my ($top_level) = $archive =~ /^([^-]+)/; - $path = "modules/by-module/$top_level/$archive"; + $path = "modules/by-module/$top_level/$archive"; } } @@ -155,11 +154,10 @@ sub parse_portage_tree { push @not_on_cpan, "$category/$pkg_name"; next; } - p(2, "fetches $path\n"); my $dist; if (defined $fqn_dist) { - p(2, 'is indexed on the CPAN... '); + p(2, "is $fqn_dist indexed on the CPAN... "); $dist = do { local $@; eval { $pcp->distribution($fqn_dist) } @@ -168,7 +166,7 @@ sub parse_portage_tree { } unless (defined $dist) { - p(2, 'can directly be found on a CPAN mirror... '); + p(2, "can $path be found on a CPAN mirror... "); if (cpan_http_test($path)) { print "yes\n"; $dist = CPAN::DistnameInfo->new($path); @@ -180,19 +178,42 @@ sub parse_portage_tree { my ($pseudo_dist, $latest_dist); unless (defined $dist) { - p(2, 'has the same name as a distribution on the CPAN... '); $path =~ m{([^/\s]+)$} or die 'Could not get the last part of the path'; my $archive = $1; $pseudo_dist = CPAN::DistnameInfo->new($archive); + + p(2, 'is ' . $pseudo_dist->dist . ' the name of a CPAN distribution... '); $latest_dist = do { local $@; eval { $pcp->latest_distribution($pseudo_dist->dist) }; }; + + unless (defined $latest_dist) { + print "no\n"; + (my $mod_name = $pkg_name) =~ s/-/::/g; + p(2, "is $mod_name indexed in another CPAN distribution... "); + $latest_dist = do { + local $@; + eval { + my $module = $pcp->package($mod_name); + defined $module ? $module->distribution : undef; + }; + }; + if (defined $latest_dist) { + # Re-forge the pseudo dist so that it will pick up the correct dist + # name when looking for a mismatch. + $pseudo_dist = CPAN::DistnameInfo->new( + $latest_dist->dist . '-' . $pseudo_dist->version + . '.' . $pseudo_dist->extension + ); + } + } + my ($latest_file, $latest_author); if (defined $latest_dist) { $latest_file = $latest_dist->filename; $latest_author = $latest_dist->cpanid; - printf "yes, %s by %s\n", + printf "yes, in %s by %s\n", $latest_file, (defined $latest_author ? $latest_author : 'unknown'); } else { @@ -201,7 +222,7 @@ sub parse_portage_tree { if (defined $latest_author) { my ($au, $a) = $latest_author =~ /^((.).)/ or die 'Author name too short'; - p(2, 'is in that author\'s CPAN directory... '); + p(2, "is $archive in that author\'s CPAN directory... "); my $alternate_path = "authors/id/$a/$au/$latest_author/$archive"; if ($alternate_path eq $path) { print "already checked\n"; @@ -221,10 +242,14 @@ sub parse_portage_tree { unless (defined $dist) { if ($latest_dist or $is_on_cpan{$pkg_name}) { $dist = $pseudo_dist; - unless ($latest_dist) { + p(2, "seems to be a CPAN distribution"); + if ($latest_dist) { + print "\n"; + } else { + # Implies $is_on_cpan{$pkg_name} + print " (forced)\n"; push @unfindable, "$category/$pkg_name"; } - p(2, "seems to come from the CPAN anyway\n"); } else { p(2, colored("$pkg_name is not a CPAN distribution", 'bright_red') . "\n"); push @not_on_cpan, "$category/$pkg_name"; @@ -258,7 +283,7 @@ my $already_parsed = 0; if (-e STATE_FILE) { my $state = Storable::retrieve(STATE_FILE); - if ($state->[0] eq $timestamp) { + if ($state->[0] == $timestamp) { printf "State retrieved from %s\n", STATE_FILE; @not_on_cpan = @{ $state->[1] }; @unfindable = @{ $state->[2] }; @@ -275,7 +300,7 @@ if (-e STATE_FILE) { unless ($already_parsed) { if (-e DATA_FILE) { my $data = Storable::retrieve(DATA_FILE); - if ($data->[0] eq $timestamp) { + if ($data->[0] == $timestamp) { printf "Data retrieved from %s\n", DATA_FILE; %fetched_uri = %{ $data->[1] }; } else { @@ -354,11 +379,15 @@ open my $dst, '>', TARGET; my $max = max map length, keys %name_mismatch; SRC: while (<$src>) { - print $dst $_; - if (/^__DATA__$/) { + if (/^sub TIMESTAMP/) { + print $dst "sub TIMESTAMP () { $timestamp }\n"; + } elsif (/^__DATA__$/) { + print $dst "__DATA__\n"; printf $dst "%s%s %s\n", $_, (' ' x ($max - length)), $name_mismatch{$_} for sort keys %name_mismatch; last SRC; + } else { + print $dst $_; } }