CPAN::Faker - build a bogus CPAN instance for testing

  use CPAN::Faker;

  my $cpan = CPAN::Faker->new({
    source => './eg',
    dest   => './will-contain-fakepan',
  });

  $cpan->make_cpan;

  my $faker = CPAN::Faker->new(\%arg);

  source - the directory in which to find source files
  dest   - the directory in which to construct the CPAN instance; required
  url    - the base URL for the CPAN; a file:// URL is generated by default

  dist_class - the class used to fake dists; default: Module::Faker::Dist

  $faker->make_cpan;

  $faker->add_author($pause_id => \%info);

  mailbox - a string like: Ricardo Signes <rjbs@cpan.org>

  $faker->index_package($package_name => \%info);

  version       - the version of the package (defaults to undef)
  dist_version  - the version of the dist (defaults to undef)
  dist_filename - the file containing the package, like R/RJ/RJBS/...tar.gz
  dist_author   - the PAUSE id of the uploader of the dist

  ./authors/01mailrc.txt.gz            - the list of authors (PAUSE ids)
  ./modules/02packages.details.txt.gz  - the master index of current modules
  ./modules/03modlist.txt.gz           - the "registered" list; has no data
  ./authors/id/X/Y/XYZZY/Dist-1.tar.gz - each distribution in the archive
  ./authors/id/X/Y/XYZZY/CHECKSUMS     - a CPAN checksums file for the dir

  ./indices/find-ls.gz
  ./indices/ls-lR.gz
  ./modules/06perms.txt.gz
  ./modules/by-category/...
  ./modules/by-module/...

  $faker->add_dist($dist);

package CPAN::Faker;
BEGIN {
  $CPAN::Faker::VERSION = '0.007';
}
use 5.008;
use Moose;
# ABSTRACT: build a bogus CPAN instance for testing

use CPAN::Checksums ();
use Compress::Zlib ();
use Cwd ();
use Data::Section -setup;
use File::Find ();
use File::Next ();
use File::Path ();
use File::Spec ();
use Module::Faker::Dist 0.008; # from .dist files
use Sort::Versions qw(versioncmp);
use Text::Template;


has dest   => (is => 'ro', isa => 'Str', required => 1);
has source => (is => 'ro', isa => 'Str', required => 1);

has dist_class => (
  is  => 'ro',
  isa => 'Str',
  required => 1,
  default  => sub { 'Module::Faker::Dist' },
);

has url => (
  is      => 'ro',
  isa     => 'Str',
  default => sub {
    my ($self) = @_;
    my $url = "file://" . File::Spec->rel2abs($self->dest);
    $url =~ s{(?<!/)$}{/};
    return $url;
  },
);

has dist_dest => (
  is   => 'ro',
  lazy => 1,
  init_arg => undef,
  default  => sub { File::Spec->catdir($_[0]->dest, qw(authors id)) },
);

BEGIN {
  # These attributes are used to keep track of the indexes we'll write when we
  # finish adding content to the CPAN::Faker. -- rjbs, 2008-05-07
  for (qw(pkg_index author_index author_dir)) {
    has "_$_" => (
      is  => 'ro',
      isa => 'HashRef',
      default  => sub { {} },
      init_arg => undef,
    );
  }
}

sub __dor { defined $_[0] ? $_[0] : $_[1] }


sub make_cpan {
  my ($self) = @_;

  for ($self->source) {
    Carp::croak "source directory does not exist"     unless -e;
    Carp::croak "source directory is not a directory" unless -d;
    Carp::croak "source directory is not writeable"   unless -w;
  }

  for ($self->dest) {
    if (-e) {
      Carp::croak "destination directory is not a directory" unless -d;

      opendir my $dir, $self->dest;
      my @files = grep { $_ ne '.' and $_ ne '..' } readdir $dir;
      Carp::croak "destination directory is not empty" if @files;
    } else {
      my $error;
      # actually *using* $error is annoying; will sort it out later..?
      # -- rjbs, 2011-04-18
      Carp::croak "couldn't create destination"
        unless File::Path::make_path($self->dest, { error => \$error });
    }
  }

  my $iter = File::Next::files($self->source);

  while (my $file = $iter->()) {
    my $dist = $self->dist_class->from_file($file);
    $self->add_dist($dist);
  }

  $self->_update_author_checksums;

  $self->write_package_index;
  $self->write_author_index;
  $self->write_modlist_index;
  $self->write_perms_index;
}


sub add_dist {
  my ($self, $dist) = @_;

  my $archive = $dist->make_archive({
    dir           => $self->dist_dest,
    author_prefix => 1,
  });

  $self->_learn_author_of($dist);
  $self->_maybe_index($dist);

  my ($author_dir) =
    $dist->archive_filename({ author_prefix => 1 }) =~ m{\A(.+)/};

  $self->_author_dir->{ $author_dir } = 1;
}

sub _update_author_checksums {
  my ($self) = @_;

  my $dist_dest = File::Spec->catdir($self->dest, qw(authors id));

  for my $dir (keys %{ $self->_author_dir }) {
    $dir = File::Spec->catdir($dist_dest, $dir);
    CPAN::Checksums::updatedir($dir);
  }
}


sub add_author {
  my ($self, $pauseid, $info) = @_;
  $self->_author_index->{$pauseid} = $info->{mailbox};
}

sub _learn_author_of {
  my ($self, $dist) = @_;

  my ($author) = $dist->authors;
  my $pauseid = $dist->cpan_author;

  return unless $author and $pauseid;

  $self->add_author($pauseid => { mailbox => $author });
}


sub index_package {
  my ($self, $package_name, $info) = @_;

  unless ($info->{dist_filename}) {
    Carp::croak "invalid package entry: missing dist_filename";
  }

  $self->_pkg_index->{$package_name} = {
    version       => $info->{version},
    dist_filename => $info->{dist_filename},
    dist_version  => $info->{dist_version},
    dist_author   => $info->{dist_author},
  };
}

sub _index_pkg_obj {
  my ($self, $pkg, $dist) = @_;
  $self->index_package(
    $pkg->name => {
      version       => $pkg->version,
      dist_filename => $dist->archive_filename({ author_prefix => 1 }),
      dist_version  => $dist->version,
      dist_author   => $dist->cpan_author,
    },
  );
}

sub _maybe_index {
  my ($self, $dist) = @_;

  my $index = $self->_pkg_index;

  PACKAGE: for my $package ($dist->provides) {
    if (my $e = $index->{ $package->name }) {
      if (defined $package->version and not defined $e->{version}) {
        $self->_index_pkg_obj($package, $dist);
        next PACKAGE;
      } elsif (not defined $package->version and defined $e->{version}) {
        next PACKAGE;
      } else {
        my $pkg_cmp = versioncmp($package->version, $e->{version});

        if ($pkg_cmp == 1) {
          $self->_index_pkg_obj($package, $dist);
          next PACKAGE;
        } elsif ($pkg_cmp == 0) {
          if (versioncmp($dist->version, $e->{dist_version}) == 1) {
            $self->_index_pkg_obj($package, $dist);
            next PACKAGE;
          }
        }

        next PACKAGE;
      }
    } else {
      $self->_index_pkg_obj($package, $dist);
    }
  }
}


sub write_author_index {
  my ($self) = @_;

  my $index = $self->_author_index;

  my $index_dir = File::Spec->catdir($self->dest, 'authors');
  File::Path::mkpath($index_dir);

  my $index_filename = File::Spec->catfile(
    $index_dir,
    '01mailrc.txt.gz',
  );

  my $gz = Compress::Zlib::gzopen($index_filename, 'wb');

  for my $pauseid (sort keys %$index) {
    $gz->gzwrite(qq[alias $pauseid "$index->{$pauseid}"\n])
      or die "error writing to $index_filename"
  }

  $gz->gzclose and die "error closing $index_filename";
}

sub write_package_index {
  my ($self) = @_;

  my $index = $self->_pkg_index;

  my @lines;
  for my $name (sort keys %$index) {
    my $info = $index->{ $name };

    push @lines, sprintf "%-34s %5s  %s\n",
      $name,
      __dor($info->{version}, 'undef'),
      $info->{dist_filename};
  }

  my $front = $self->_02pkg_front_matter({ lines => scalar @lines });

  my $index_dir = File::Spec->catdir($self->dest, 'modules');
  File::Path::mkpath($index_dir);

  my $index_filename = File::Spec->catfile(
    $index_dir,
    '02packages.details.txt.gz',
  );

  my $gz = Compress::Zlib::gzopen($index_filename, 'wb');
  $gz->gzwrite("$front\n");
  $gz->gzwrite($_) || die "error writing to $index_filename" for @lines;
  $gz->gzclose and die "error closing $index_filename";
}

sub write_modlist_index {
  my ($self) = @_;

  my $index_dir = File::Spec->catdir($self->dest, 'modules');

  my $index_filename = File::Spec->catfile(
    $index_dir,
    '03modlist.data.gz',
  );

  my $gz = Compress::Zlib::gzopen($index_filename, 'wb');
  $gz->gzwrite(${ $self->section_data('modlist') });
  $gz->gzclose and die "error closing $index_filename";
}

sub write_perms_index {
  my ($self) = @_;

  my $index_dir = File::Spec->catdir($self->dest, 'modules');

  my $index_filename = File::Spec->catfile(
    $index_dir,
    '06perms.txt',
  );

  my $template = $self->section_data('packages');

  my $index = $self->_pkg_index;
  my $lines = keys %$index;

  my $text = Text::Template->fill_this_in(
    $$template,
    DELIMITERS => [ '{{', '}}' ],
    HASH       => {
      lines => \$lines,
      self  => \$self,
    },
  );

  open my $fh, '>', $index_filename
    or die "can't open $index_filename for writing: $!";

  print {$fh} $text, "\n";

  for my $pkg (sort keys %$index) {
    my $author = $index->{$pkg}{dist_author};

    printf {$fh} "%s,%s,%s\n", $pkg, $author, 'f';
  }

  close $fh or die "error closing $index_filename after writing: $!";
}

sub _02pkg_front_matter {
  my ($self, $arg) = @_;

  my $template = $self->section_data('packages');

  my $text = Text::Template->fill_this_in(
    $$template,
    DELIMITERS => [ '{{', '}}' ],
    HASH       => {
      self => \$self,
      (map {; $_ => \($arg->{$_}) } keys %$arg),
    },
  );

  return $text;
}

no Moose;
1;

__DATA__
__[packages]__
File:         02packages.details.txt
URL:          {{ $self->url }}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:   CPAN::Faker version {{ $CPAN::Faker::VERSION }}
Line-Count:   {{ $lines }}
Last-Updated: {{ scalar gmtime }} GMT
__[perms]__
File:        06perms.txt
Description: CSV file of upload permission to the CPAN per namespace
    best-permission is one of "m" for "modulelist", "f" for
    "first-come", "c" for "co-maint"
Columns:     package,userid,best-permission
Line-Count:  {{ $lines }}
Written-By:  Id
Date:        {{ scalar gmtime }} GMT
__[modlist]__
File:        03modlist.data
Description: CPAN::Faker does not provide modlist data.
Modcount:    0
Written-By:  CPAN::Faker version {{ $CPAN::Faker::VERSION }}
Date:        {{ scalar localtime }}

package CPAN::Modulelist;
# Usage: print Data::Dumper->new([CPAN::Modulelist->data])->Dump or similar
# cannot 'use strict', because we normally run under Safe
# use strict;
sub data {
my $result = {};
my $primary = "modid";
for (@$CPAN::Modulelist::data){
my %hash;
@hash{@$CPAN::Modulelist::cols} = @$_;
$result->{$hash{$primary}} = \%hash;
}
$result;
}
$CPAN::Modulelist::cols = [
'modid',
'statd',
'stats',
'statl',
'stati',
'statp',
'description',
'userid',
'chapterid'
];
$CPAN::Modulelist::data = [];