view release on metacpan or  search on metacpan

lib/App/EPAN.pm  view on Meta::CPAN

      $basedir->file(qw< modules 03modlist.data.gz >)    # default
   );
} ## end sub _do_index

sub _save2 {
   my ($self, $path, $contents) = @_;
   my ($fh, $is_gz);
   if (ref($path) eq 'GLOB') {
      $fh    = $path;
      $is_gz = 0;
   }
   else {
      $path->dir()->mkpath() unless -d $path->dir()->stringify();
      $fh    = $path->open('>');
      $is_gz = $path->stringify() =~ m{\.gz$}mxs;
   }

   if ($is_gz) {
      my $gz = Compress::Zlib::gzopen($fh, 'wb');
      $gz->gzwrite($contents);
      $gz->gzclose();
   }
   else {
      binmode $fh;
      print {$fh} $contents;
   }
   return;
} ## end sub _save2

sub _index_for {
   my ($self, $path) = @_;
   $path //= $self->target_dir;
   my @index = $self->_index_body_for($path);
   our $VERSION ||= 'whateva';
   my $header = <<"END_OF_HEADER";
File:         02packages.details.txt
URL:          http://cpan.perl.org/modules/02packages.details.txt.gz
Description:  Package names found in directory \$CPAN/authors/id/
Columns:      package name, version, path
Intended-For: Automated fetch routines, namespace documentation.
Written-By:   epan $VERSION
Line-Count:   ${ \ scalar @index }
Last-Updated: ${ \ scalar localtime() }
END_OF_HEADER
   return join "\n", $header, @index, '';
} ## end sub _index_for

sub _collect_index_for {
   my ($self, $path) = @_;
   $path //= $self->target_dir;
   $path = dir($path);
   LOGDIE "path '$path' does not exist (wrong -t option?)" unless -d $path;

   my $idpath = $path->subdir(qw< authors id >);
   my %data_for;
   for my $file (File::Find::Rule->extras({follow => 1})->file()
      ->in($idpath->stringify()))
   {
      INFO "indexing $file";
      my $index_path =
        file($file)->relative($idpath)->as_foreign('Unix')->stringify();
      my $dm = Dist::Metadata->new(file => $file);
      my $version_for = $dm->package_versions();

      $data_for{distro}{$index_path} = $version_for;
      (my $bare_index_path = $index_path) =~
        s{^(.)/(\1.)/(\2.*?)/}{$3/}mxs;
      $data_for{bare_distro}{$bare_index_path} = $version_for;

      my %_localdata_for;
      my $score = 0;
      my $previous;
      while (my ($module, $version) = each %$version_for) {
         my $print_version = $version // 'undef';
         DEBUG "data for $module: [$print_version] [$index_path]";
         $_localdata_for{$module} = {
            version => $version,
            distro  => $index_path,
            _file   => $file,
         };
         next if $score != 0;
         next unless exists($data_for{module}{$module});
         $previous = $data_for{module}{$module};
         DEBUG 'some previous version exists';
         if (! defined $version) {
            $score = -1 if defined($previous->{version});
         }
         elsif (defined $previous->{version}) {
            my $tv = version->parse($version);
            my $pv = version->parse($previous->{version});
            $score = $tv <=> $pv;
         }
         DEBUG "score: $score";
      } ## end while (my ($module, $version...))

      DEBUG "FINAL SCORE $score";

      if ($score < 0) { # didn't win against something already in
         DEBUG "marking $file as obsolete";
         $data_for{obsolete}{$file} = 1;
         next;
      }

      DEBUG "getting $file data as winner (for the moment)";
      if ($previous) {
         my $oip = $previous->{distro};
         DEBUG "marking $oip as obsolete";
         $data_for{obsolete}{$previous->{_file}} = 1;
         delete $data_for{module}{$_}
           for keys %{$data_for{distro}{$oip}};
      }
      # copy stuff over to the "official" data for modules
      $data_for{module}{$_} = $_localdata_for{$_} for keys %_localdata_for;
   } ## end for my $file (File::Find::Rule...)
   $self->last_index(\%data_for);
   return %data_for if wantarray();
   return \%data_for;
} ## end sub _collect_index_for

sub _index_body_for {
   my ($self, $path) = @_;