package JIB::Package;

use strict;
use warnings;
use base 'Object::Accessor';

use JIB::Constants;
use JIB::Config;

use JIB::Package::Source;
use JIB::Package::Binary;
use JIB::Package::Installed;
use JIB::Package::Installable;

use File::Spec;
use File::Basename          qw[basename];
use Params::Check           qw[check];
use Log::Message::Simple    qw[:STD];
use YAML                    qw[LoadFile];

use Data::Dumper;

$Data::Dumper::Indent = 1;

my $Package_re = qr/^(\w+)     - # prefix
                    ([\w-]+?)  - # package name
                    ([\d.]+)   - # version
                    (\w+\+\S+) $ # authority
                /smx;

=head1 NAME

    JIB::Package

=head1 DESCRIPTION

Base class for:

    JIB::Package::Source
    JIB::Package::Binary
    JIB::Package::Installed

=head1 ACCESSORS 

=head2 package

Set the name of the full package package. For example:

    p5-foo-1-cpan+kane

=head1 METHODS

=head2 $pkg = JIB::Package->new( file => /path/to/jib | meta => META_OBJ );

Returns a JIB::Package::Source on a jib file, and a JIB::Package::Installed
on a META_OBJ.

XXX needs verification
XXX needs binary package recognition

=cut

{   my $acc = {
        file            => { allow => FILE_EXISTS },
        meta            => { allow => ISA_JIB_META },
        config          => { allow => ISA_JIB_CONFIG },
        package         => { allow => $Package_re, no_override => 1 },
    };

    ### acc is just for accessors, the others get added for our 
    ### param checking too
    my $tmpl = {
        %$acc,
        installation    => { allow => ISA_JIB_INSTALLATION },
        repository      => { allow => ISA_JIB_REPOSITORY },
    };

    sub new {
        my $class = shift;
        my %hash  = @_;
        
        ### might get params for underlying classes
        local $Params::Check::ALLOW_UNKNOWN = 1;
        my $args = check( $tmpl, \%hash ) 
                        or error( Params::Check->last_error ), return;
        
        ### XXX need better checks
        
        ### XXX create an object::accessor object, blessed in the right class
        my $obj = 
            $args->{repository} && $args->{file}
                ? JIB::Package::Installable->Object::Accessor::new      :
            $args->{file}           
                ? JIB::Package::Source->Object::Accessor::new           :
            $args->{installation}   
                ? JIB::Package::Installed->Object::Accessor::new        :
            JIB::Package::Binary->Object::Accessor::new;
    
        return unless $obj;

        ### create accessors
        my %acc = map { $_ => $acc->{$_}->{allow} } keys %$acc;
        $obj->mk_accessors( \%acc );
        
        ### set the config
        $obj->config( JIB::Config->new );
        
        ### call the objects new method and return it
        return $obj->new( %hash );
        
    }
}    

=head2 $meta = $pkg->extract_meta_object;

=cut

sub extract_meta_object {
    my $self = shift;
    my $conf = $self->config;
    my $meta = $self->meta;

    ### if we didn't get a meta object, we'll fetch it from the .jib
    unless( $meta ) {
        
        ### installed packages don't have a 'file' method, but they /should/
        ### have a meta object at all times
        unless( $self->can('file') ) {
            error("No file associated with this object -- " .
                  "can not extract meta object" );
            return;
        }
        
        ### extract to a temp dir
        my $my_tmp_dir = File::Spec->catdir( $conf->temp_dir . "$$" );
        system( qq[mkdir -p $my_tmp_dir] )                      and die $?;
        
        ### extract the archive to the temp dir
        system( qq[tar -f ] . $self->file . qq[ -C $my_tmp_dir -xz]) 
                                                                and die $?;

        ### extract the meta info
        my $control  = $conf->archive_control;
        system( qq[tar -f $my_tmp_dir/$control -C $my_tmp_dir -xz] )
                                                                and die $?;
              
        $meta = eval { LoadFile( File::Spec->catfile( 
                                    $my_tmp_dir,
                                    $conf->meta_file )
                ) };
        $@ and error( "Could not load meta file from archive: $@" ), return;
    
        $self->meta(JIB::Meta->new_from_struct(struct => $meta)) or return;
        system( "rm -rf $my_tmp_dir" )                          and die $?;
    }

    return $meta;
}

=head2 package_re

=head2 prefix

=head2 name

=head2 version

=head2 authority

=cut

### XXX could autogenerate
{   
    sub package_re { $Package_re };

    sub prefix {
        return $1 if shift->package() =~ $Package_re;
    }

    sub name {
        return $2 if shift->package() =~ $Package_re;
    }

    sub version {
        return $3 if shift->package() =~ $Package_re;
    }
    
    sub authority {
        return $4 if shift->package() =~ $Package_re;
    }
}    

1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: