The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package OrePAN::Package::Index;

use strict;
use warnings;
use utf8;
use Mouse;
use IO::Zlib;
use CPAN::DistnameInfo;
use version;
use Log::Minimal;
use File::Temp qw(:mktemp);
use Carp ();

has filename => (
    is       => 'ro',
    required => 1,
);

has data => (
    is      => 'ro',
    default => sub { +{} },
);

sub BUILD {
    my ($self, ) = @_;
    if (-f $self->filename) {
        infof( "Loading %s", $self->filename);
        my $fh = IO::Zlib->new($self->filename, 'rb');
        while (<$fh>) { # skip headers
            last unless /\S/;
        }
        while (<$fh>) {
            my ($pkg, $ver, $path) = split /\s+/, $_;
            my $dist = CPAN::DistnameInfo->new($path);
            $self->{data}->{$dist->dist} ||= {
                path    => $path,
                version => $dist->version,
                modules => {},
            };
            $self->{data}->{$dist->dist}->{modules}->{$pkg} = $ver;
        }
        close $fh;
    }
}

sub add {
    my ($self, $path, $data) = @_;
    my $dist = CPAN::DistnameInfo->new($path);
    if ( $self->{data}->{$dist->dist} ) {
        my $p_version;
        my $n_version;
        eval {
            $p_version = version->parse($self->{data}->{$dist->dist}->{version});
            $n_version = version->parse($dist->version);
        };
        if ( !$@ && $n_version <= $p_version ) {
            infof( "SKIP: already has newer version %s-%s: adding %s", $dist->dist, $self->{data}->{$dist->dist}->{version}, 
                   $dist->version);
            return;
        }
    }

    infof( "Adding %s-%s", $dist->dist, $dist->version);
    $self->{data}->{$dist->dist} = {
        path    => $path,
        version => $dist->version,
        modules => $data,
    };

    for my $distname ( keys %{$self->data} ) {
        next if $dist->dist eq $distname;
        for my $pkg ( keys %$data ) {
            die "'$pkg' is exists on $distname" if exists $self->data->{$distname}->{modules}->{$pkg}
        }
    }
}

# TODO need flock?
sub save {
    my ($self, ) = @_;

    my %modules;
    for my $distname ( keys %{$self->data} ) {
        my $dist = $self->data->{$distname};
        for my $module ( keys %{$dist->{modules}} ) {
            die "'$module' is exists on $distname" if exists $modules{$module};
            $modules{$module} = [ $dist->{modules}->{$module}, $dist->{path} ];
        } 
    }

    infof( "Save %s", $self->filename);
    # Because we do rename(2) atomically, temporary file must be in same
    # partion with target file.
    my $tmp = mktemp($self->filename . '.XXXXXX');

    my $fh = IO::Zlib->new($tmp,'wb') or die $!;
    $fh->print("File:         02packages.details.txt\n\n");
    for my $key ( sort keys %modules ) {
        $fh->print(sprintf("%s\t%s\t%s\n", $key, $modules{$key}->[0] || 'undef', $modules{$key}->[1]));
    }
    $fh->close();

    rename( $tmp, $self->filename )
      or Carp::croak("Cannot rename temporary file '$tmp' to @{[ $self->filename ]}: $!");
}

no Mouse; __PACKAGE__->meta->make_immutable;
1;