view release on metacpan or  search on metacpan

lib/CPAN/InGit.pm  view on Meta::CPAN

   else {
      warn "Omitting $path from TAR, not a BLOB or TREE";
   }
}


sub new_signature($self) {
   Git::Raw::Signature->now($self->git_author_name, $self->git_author_email);
}


sub lookup_versions($self, $module_name) {
   for my $up ($self->upstream_mirrors->@*) {
      ...;
   }
}


sub process_distfile($self, %opts) {
   my ($tree, $file_path, $file_data, $extract)= @opts{'tree','file_path','file_data','extract'};
   # Decompress tar in memory.  The decompression gets complicated since it can be bz2 or gz
   # so write to a temp file and then parse that with the auto-detection of "compress".
   if ($file_path =~ /\.(tar\.gz|tar\.bz2|tgz)\z/) {
      my $path_without_extension= substr($file_path, 0, $-[0]);
      my $tmp= File::Temp->new;
      $tmp->print($$file_data) or die "write: $!";
      $tmp->flush;

      # Iterate across the files in the tar archive
      my $tar= Archive::Tar->new("$tmp", 1);
      my @files= $tar->get_files;
      if (!@files) {
         croak "Failed to extract any files from archive $file_path";
      }
      # Remove prefix directory if every file in archive starts with the same directory
      (my $prefix= $files[0]->name) =~ s,/.*,,;
      $prefix .= '/';
      for (@files) {
         if (substr($_->name,0,length $prefix) ne $prefix) {
            $prefix= '';
            last;
         }
      }
      # Build by-name hash of files
      my %files= map +( substr($_->name, length $prefix) => $_ ), @files;
      my $meta;
      # Look for a META.json
      if (my $meta_json= $files{'META.json'}) {
         eval {
            my $cm= CPAN::Meta->load_json_string($meta_json->get_content);
            $meta= $cm->as_struct({ version => 2 });
         } or warn "Failed to load $file_path/${prefix}META.json: $@";
      }
      # else look for META.yml
      if (!$meta && (my $meta_yml= $files{'META.yml'})) {
         eval {
            my $cm= CPAN::Meta->load_yaml_string($meta_yml->get_content);
            $meta= $cm->as_struct({ version => 2 });
         } or warn "Failed to load $file_path/${prefix}META.yml: $@";
      }
      # TODO: add some fall-back that guesses at prereqs.
      $meta //= {};
      # If the meta didn't contain "provides", add that using Module::Metadata
      if (!$meta->{provides}) {
         my $provides= $meta->{provides}= {};
         for my $pm_fname (grep /\.pm\z/ && !m{^(t|xt|inc|script|bin)/}, keys %files) {
            eval {
               open my $pm_fh, '<', $files{$pm_fname}->get_content_by_ref or die;
               my $mm= Module::Metadata->new_from_handle($pm_fh, $pm_fname);
               for my $pkg (grep $_ ne 'main', $mm->name, $mm->packages_inside) {
                  $provides->{$pkg}{file}= $pm_fname;
                  $provides->{$pkg}{version} //= $mm->version($pkg);
               }
               1;
            } or warn "Failed to parse packages in $file_path/${prefix}$pm_fname: $@";
         }
      }
      # If caller requests 'extract', add the tar's files and symlinks to the tree
      if ($extract) {
         for (keys %files) {
            my $mode= $files{$_}->mode;
            if (S_ISREG($mode)) {
               # normalize to 644 or 755
               $mode= S_IFMT($mode) | (($mode & 1)? 0755 : 0644);
               $tree->set_path("$path_without_extension/$_", $files{$_}->get_content_by_ref, $mode);
            } elsif (S_ISLNK($mode)) {
               $tree->set_path("$path_without_extension/$_", \$files{$_}->linkname, S_IFMT($mode));
            } elsif (!S_ISDIR($mode)) {
               warn "Skipping tar entry for '$path_without_extension/$_' (mode=$mode)\n";
            }
         }
      } else {
         $tree->set_path($file_path, $file_data);
      }
      # Now serialzie the meta and write it to the tree alongside the TAR
      my $json= CPAN::Meta->new($meta)->as_string({ version => 2 });
      $tree->set_path($path_without_extension . '.json', \$json);
   }
   else {
      warn "$file_path does not appear to be a TAR file.  Skipping metadata processing.";
      $tree->set_path($file_path, $file_data);
   }
}

#=method parse_cpanfile_snapshot
#
#  $distribution_spec= $cpan_repo->parse_cpanfile_snapshot($file_contents);
#
#Given a scalar with the content of a cpanfile.snapshot from L<Carton>, this returns the data of
#that file as a hierarchial structure:
#
#  {
#    "Distribution-Name-1.002003" => {
#      "pathname" => "A/AU/AUTHOR/Distribution-Name-1.002003.tar.gz",
#      "provides" => {
#        "Distribution::Name" => '1.002003',
#        ...
#      },
#      "requirements" => {
#        "Dependency" => "2.05",
#        ...