Make the gengentooisms script dies if the timestamp cannot be fetched

[perl/modules/CPANPLUS-Dist-Gentoo.git] / samples / gengentooisms

diff --git a/samples/gengentooisms b/samples/gengentooisms
index 03253e053397a87edec037b6624ca2fb9cda5bb8..0c39c00ddce471865d57e1c9a1874a4bec0d0d51 100755 (executable)
--- a/samples/gengentooisms
+++ b/samples/gengentooisms
@@ -43,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;
@@ -143,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";
     }
    }
 
@@ -162,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) }
@@ -175,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);
@@ -187,10 +178,11 @@ 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) };
@@ -198,8 +190,8 @@ sub parse_portage_tree {
 
     unless (defined $latest_dist) {
      print "no\n";
-     p(2, 'is similiar to a module indexed in another distribution of the CPAN... ');
      (my $mod_name = $pkg_name) =~ s/-/::/g;
+     p(2, "is $mod_name indexed in another CPAN distribution... ");
      $latest_dist = do {
       local $@;
       eval {
@@ -221,7 +213,7 @@ sub parse_portage_tree {
     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 {
@@ -230,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";
@@ -250,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";
@@ -287,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] };
@@ -304,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 {
@@ -383,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 $_;
  }
 }