The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.008;

use strict;
use warnings;

use CPAN::Meta;
use Cwd qw{ cwd };
use ExtUtils::MakeMaker;
use ExtUtils::Manifest qw{ maniread };
use File::Copy ();
use File::Find;
use File::Glob qw{ bsd_glob };
use File::Spec;
use Getopt::Long 2.33;
use IO::Compress::Gzip qw{ gzip $GzipError };
use IO::File;
use Pod::Usage;
use Time::Local;

our $VERSION = '0.000_194';

my $base_time = timegm( 0, 0, 0, 1, 0, 100 );

my %opt;

GetOptions( \%opt,
    qw{ force! verbose! },
    help => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

if ( -d 'mock/repos' && ! $opt{force} ) {
    exit;
}

require CPAN::Checksums;

my $mail_re = qr{ [\w.-]+ \@ [\w.-]+ }smx;

my $top_dir = cwd();

my %author_index;
my %module_index;
my %mtime;

# Pack up the individual distributions, accumulating indexing
# information along the way.

foreach my $user ( bsd_glob( 'mock/src/repos/*' ) ) {

    my $cpan_id = ( File::Spec->splitpath( $user ) )[2];

    $opt{verbose}
	and print "User $cpan_id\n";

    my $dest_dir = _mkdir ( qw{ mock repos authors id },
	substr( $cpan_id, 0, 1 ), substr( $cpan_id, 0, 2 ),
	$cpan_id,
    );

    foreach my $dist ( bsd_glob( File::Spec->catfile( $user, '*' ) ) ) {

	my $dist_name = ( File::Spec->splitpath( $dist ) )[2];
	$opt{verbose}
	    and print "    $dist_name\n";

	foreach my $maker (
	    [ 'Makefile.PL' => 'make' ],
	    [ 'Build.PL' => './Build' ],
	) {
	    my ( $premake, $make ) = @{ $maker };
	    my $path = File::Spec->catfile( $dist, $premake );
	    -f $path
		or next;

	    chdir $dist
		or die "Can not change directory to $dist: $!";

	    my $manifest = maniread() || {};
	    foreach my $file ( keys %{ $manifest } ) {
		my @stat = stat $file
		    or next;
		$mtime{"$cpan_id/$dist_name/$file"} = $stat[9] -
		    $base_time;
	    }

	    my $kit_file;

	    eval {

		system perl => $premake;
		system $make, 'dist';

		my $meta;
		foreach my $meta_file ( qw{ MYMETA.json MYMETA.yml } ) {
		    -f $meta_file or next;
		    $meta = CPAN::Meta->load_file( $meta_file )
			and last;
		}

		my $kit_prefix = join '-', map { $meta->$_ } qw{ name version };
		$opt{verbose}
		    and print "    Glob $kit_prefix*\n";
		my @kit = bsd_glob( "$kit_prefix*" )
		    or die "No kit built for $dist";
		@kit > 1
		    and die "Multiple kits @kit for $dist";

		my $distribution = join '/',
		    substr( $cpan_id, 0, 1 ),
		    substr( $cpan_id, 0, 2 ),
		    $cpan_id,
		    $kit[0];

		$opt{verbose}
		    and print "    $kit[0]\n";

		my $provides = $meta->provides();
		%{ $provides } or $provides = _provides();
		while ( my ( $module, $data ) = each %{ $provides } ) {
		    $module_index{$module} ||= {
			distribution => $distribution,
			version	=> $data->{version},
		    };
		}

		my ( $author ) = $meta->author();
		if ( $author =~ s{ \s* [(] ( $mail_re ) [)] }{}smx
		    || $author =~ s{ \s* < ( $mail_re ) > }{}smx ) {
		    my $mail = $1;
		    if ( $mail =~ m{ \A ( [^\@]+ ) }smx ) {
			my $cpan_id = uc $1;
			$author_index{$cpan_id} ||= {
			    name	=> $author,
			    address	=> $mail,
			};
		    }
		}

		system $make, 'realclean';

		$kit_file = File::Spec->catfile( $dist, $kit[0] );

		1;
	    } or die "Build failed: $@";

	    chdir $top_dir
		or die "Can not change directory to $top_dir: $!";

	    File::Copy::move( $kit_file, $dest_dir )
		or die "Failed to move $kit_file to $dest_dir: $!";

	    last;
	}
    }

    CPAN::Checksums::updatedir( $dest_dir );

}

# Generate the mtimes file

{
    open my $fh, '>', 'mock/repos/mtimes.dat'
	or die "Unable to open mock/repos/mtimes.dat: $!\n";
    foreach my $file ( sort keys %mtime ) {
	print { $fh } "$file\t$mtime{$file}\n";
    }
    close $fh;
}

# Generate modules/02packages.details.txt and
# modules/02packages.details.txt.gz

{
    my $base = '02packages.details.txt';
    my $dest_dir = _mkdir( qw{ mock repos modules } );
    my $fn = File::Spec->catfile( $dest_dir, $base );
    my $fh = IO::File->new( $fn, '>' )
	or die "Failed to create $fn: $!";

    printf $fh "%-16s %s\n", 'File:' => $base;
    printf $fh "%-16s %s\n", 'Description:' =>
	'Package names found in directory $CPAN/authors/id/';
    printf $fh "%-16s %s\n", 'Columns:' =>
        'package name, version, path';

    print $fh "\n";

    foreach my $module ( sort keys %module_index ) {
	my $version = $module_index{$module}{version};
	defined $version
	    or $version = 'undef';
	printf $fh "%-32s %-8s %s\n", $module, $version,
	    $module_index{$module}{distribution};
    }
    $fh->close();

    gzip( $fn, "$fn.gz" )
	or die "Failed to compress $fn: $GzipError";
}

# generate authors/01mailrc.txt.gz

{
    my $base = '01mailrc.txt';
    my $dest_dir = _mkdir( qw{ mock repos authors } );

    my $fn = File::Spec->catfile( $dest_dir, $base );
    my $fh = IO::File->new( $fn, '>' )
	or die "Failed to create $fn: $!";

    foreach my $cpan_id ( sort keys %author_index ) {
	printf $fh qq{alias %-10s "%s <%s>"\n},
	    $cpan_id,
	    $author_index{$cpan_id}{name},
	    $author_index{$cpan_id}{address};
    }
    $fh->close();

    gzip( $fn, "$fn.gz" )
	or die "Failed to compress $fn: $GzipError";

    unlink $fn;
}

# Generate 03modlist.data.gz

{
    my $base = '03modlist.data';
    my $dest_dir = _mkdir( qw{ mock repos modules } );
    my $sf = File::Spec->catfile( qw{ mock src }, $base );
    my $df = File::Spec->catfile( $dest_dir, "$base.gz" );
    gzip( $sf, $df )
	or die "Failed to compress $sf: $GzipError";
}

sub _mkdir {
    my @args = @_;
    my $dest_dir = shift @args;
    -d $dest_dir
	or mkdir $dest_dir
	or die "Failed to make $dest_dir: $!\n";
    foreach ( @args ) {
	$dest_dir = File::Spec->catdir( $dest_dir, $_ );
	-d $dest_dir
	    or mkdir $dest_dir
	    or die "Failed to mkdir $dest_dir: $!";
    }
    return $dest_dir;
}

# ExtUtils::MakeMaker metadata does not supply the 'provides' key, so we
# need to be able to make it ourselves. For this, we require the modules
# to be in lib/.

sub _provides {
    my %provides;
    use ExtUtils::Manifest;
    my $manifest = maniread()
	or return {};
    while ( my ( $file, $comment ) = each %{ $manifest } ) {

	( my $module = $file ) =~ s{ [.] pm \z }{}smx
	    or next;
	$module =~ s{ \A lib/ }{}smx
	    or next;
	$module =~ s{ / }{::}smxg;

	my $version = MM->parse_version( $file );
	defined $version or $version = 'undef';

	$provides{$module} ||= {
	    file	=> $file,
	    version	=> $version,
	};
    }

    return \%provides;
}

__END__

=head1 TITLE

Build_Repos.PL - Build the CPAN::Access::AdHoc mock repository

=head1 SYNOPSIS

 Build_Repos.PL
 Build_Repos.PL -help
 Build_Repos.PL -version

=head1 OPTIONS

=head2 -help

This option displays the documentation for this script. The script then
exits.

=head2 -verbose

This option causes progress information to be written. Of course, if you
are building modules with C<ExtUtils::MakeMaker>, the information you
want may get lost in all of C<ExtUtils::MakeMaker>'s verbosity.

=head2 -version

This option displays the version of this script. The script then exits.

=head1 DETAILS

This Perl script builds the mock CPAN repository used to test
CPAN::Access::AdHoc. It expects the source to be in F<mock/src/repos/>, and it
places the output in F<mock/repos/>.

The F<mock/src/repos/> directory is expected to contain one directory
for each pseudo-CPAN ID. Under that directory are source directories for
packages by that author.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012-2014 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :