package protoconf;

use Cwd;
use Config;
use YAML            qw[LoadFile Dump];
use Data::Dumper;

use base 'Exporter';
@EXPORT = qw[
            $Cwd            $Pms        $Root       $Meta       $Site
            $Ext            $Tmpdir     $Metactrl   $Metafile   $Available
            $Builddir       $Bindir     $Data       $Control    $Fileslist
            $Build_prefix   $Preinst    $Postinst   $Prerm      $Postrm
            $Alternatives   $Altfile    $Repoindex  $Repodir    $Metaext

            package_prefix  package_authority   package_name  package_version
            list_dependencies  dependency_satisfied   dependency_satisfied_by               
        ];


$Cwd            = cwd();
$Pms            = '_jib';                           # meta dir
$Root           = $Cwd . '/fakeroot';               # our makebelief / dir
$Meta           = $Root . '/meta';                  # dir to store metadata
$Metactrl       = $Meta . '/control';               # dir to store control MD
$Available      = $Meta . '/available';             # available packages MD
$Altfile        = $Meta . '/registered-alts';       # registered alternatives
$Alternatives   = $Meta . '/alternatives';          # Alternative link dir                                                    
$Metaext        = '.info';                          # Extension for meta files
$Metafile       = 'META' . $Metaext;                # file with MD in it
$Site           = $Root . $Config{installsitelib};  # site_perl dir
$Tmpdir         = $Root . '/tmp';                   # temp dir for install
$Bindir         = $Root . '/usr/local/bin';         # script dir
$Builddir       = $Root . '/_builddir';             # buildir on client side          
$Data           = 'data.tgz';                       # part of archive /w code
$Control        = 'control.tgz';                    # part with metadata
$Ext            = '.jib';                           # archive extension
$Fileslist      = 'files.list';                     # .packlist equiv
$Build_prefix   = 'root-';                          # builddir prefix
$Preinst        = 'PREINST.pl';                     # run before install
$Postinst       = 'POSTINST.pl';                    # run after install
$Prerm          = 'PRERM.pl';                       # run before uninstall
$Postrm         = 'POSTRM.pl';                      # run after uninstall                       
$Repodir        = $Root . '/jibs';                  # remote repo root
$Repoindex      = $Repodir . '/index';              # index file for the repo

### be strict from here on down
{   use strict;

    ### parse package names easily
    {   my $re = qr/^(\w+)      -   # the prefix
                     ([\w-]+?)  -   # the package name
                     ([\d.]+)   -   # the version
                     (\w+\+\S+) $   # the authority
                /smx;
                
        sub package_prefix      { $_[0] =~ $re; $1 }
        sub package_name        { $_[0] =~ $re; $2 }
        sub package_version     { $_[0] =~ $re; $3 }
        sub package_authority   { $_[0] =~ $re; $4 }
    }
    
    ### takes the metadata object of 1 package, and returns a list of
    ### its dependencies
    sub list_dependencies {
        my $meta    = shift or die "Meta object required";
        my $print   = shift || 0;   # print the parsed dependencies?
        my @deps    = $meta->{depends} ? @{ $meta->{depends} } : ();
        my @index   = LoadFile( $protoconf::Repoindex ); 
        my @avail   = LoadFile( $protoconf::Available );

        ### XXX move the AND to the subroutine
        if( $print and @deps ) {
            print "Translating (dependency for $meta->{package}):\n";
            print Dump( $meta->{depends} );
            #print "\n\nTo:\n";
            #print Dumper( $meta->{depends} );
            print "\n\nTo:\n";
            print _pp_depends( \@deps );
            print $/ . $/;
        }
        
        my @resolved = _parse_depends( \@deps, \@index, \@avail );

    }

    ### XXX merge with _pp_depends!      
    sub _parse_depends {
        my $deps    = shift;
        my $index   = shift or return;
        my $avail   = shift or return;

        my @maybe;
        ### AND context
        RESOLVE: for my $entry ( @$deps ) {
        
            ### plain old entry, we want to resolve this one
            if( ! ref $entry ) {
                
                ### do we have something that satisfies this dep already?
                for my $maybe (@$avail) {
                    next RESOLVE if dependency_satisfied_by($entry, $maybe);
                }

                my @found;
                ### find every package that satisfies this dependency
                for my $maybe (@$index) {
                    ### not the right package
                    next unless dependency_satisfied_by( $entry, $maybe );               

                    push @found, $maybe;
                }
               
                ### nothing satisfied this depenendency
                die "No package satisfies '$entry'\n" unless @found;
                
                ### XXX should be policy based
                my @sorted = sort { $b->{version} <=> $a->{version } } @found;

                push @maybe, $sorted[0];
                
        
            ### OR dependency
            } elsif ( UNIVERSAL::isa( $entry, 'ARRAY' ) ) {

                ### do we have something that satisfies this dep already?
                for my $sub_entry ( @$entry ) {
                    ### $avail, [] is NOT a typo -- rather than having
                    ### _parse_depends see if there's a suitable candidate
                    ### in the whole index, we only let it look at the 
                    ### installed packages. This way, we're sure that when
                    ### it returns a match, it found it in what we already
                    ### had, therefor we don't need to install it
                    ### This above section works for an OR search.
                    ### The [ ] is passed for the AND search, which will
                    ### then not be able to short circuit, as there are
                    ### no available modules on that check
                    eval { _parse_depends( [$sub_entry], $avail, [] ) }
                        and next RESOLVE;

                    
                }


                my @found;
                for my $sub_entry ( @$entry ) {

                    ### we found one that satisfied
                    if( @found = 
                        eval { _parse_depends( [$sub_entry], $index, $avail ) } 
                    ) {

                        ### add to our list and short circuit
                        push @maybe, $found[0];
                        last;
                        
                    ### OR dependency, so try the next                        
                    } elsif ( $@ =~ /^No package satisfies/ ) {
                        next;

                    ### some other error
                    } else {
                        die $@;
                    }                            
                }
    
            ### grouping    
            } elsif ( UNIVERSAL::isa( $entry, 'REF' ) ) {

                ### a mere context switch, just return what ever
                ### the recursive call returns
                push @maybe, _parse_depends( $$entry, $index, $avail );
    
            ### specific version
            } elsif ( UNIVERSAL::isa( $entry, 'HASH' ) ) {
                while (my($k,$v) = each %$entry ) {
                    my ($ver,$op) = reverse split /\s+/, $v;
                    $op ||= '>=';

                    ### do we have something that satisfies this dep already?
                    for my $maybe (@$avail) {
                        next unless dependency_satisfied_by($entry, $maybe);
                        
                        ### is the version good enough?
                        if ( eval "$maybe->{version} $op $ver" ) {
                            keys %$entry;   # reset keys!!!!!
                            next RESOLVE;
                        }
                    }

                    my @found;
                    ### find every package that satisfies this dependency
                    for my $maybe (@$index) {
                        ### not the right package
                        next unless dependency_satisfied_by( $k, $maybe );
    
                        ### not a good enough version
                        next unless eval "$maybe->{version} $op $ver";
                      
                        push @found, $maybe;
                    }

                    ### nothing satisfied this depenendency
                    unless( @found ) {
                        keys %$entry;   # reset keys!!!!!
                        die "No package satisfies '$k'\n" 
                    }

                    ### XXX should be policy based
                    my @sorted = 
                            sort { $b->{version} <=> $a->{version } } @found;

                    ### store the best match
                    push @maybe, $sorted[0];
                }
    
            } else {
                die "Illegal token: $deps\n";
            }
        }
        return @maybe;
    }

    sub _pp_depends {
        my $deps = shift;
        
        my $str = '';       
        return $str unless $deps;

        for my $entry ( @$deps ) {
            $str .= ' AND ';
    
            if( ! ref $entry ) {
                $str .= "$entry";
        
            } elsif ( UNIVERSAL::isa( $entry, 'ARRAY' ) ) {
                $str .= '(';
                $str .= join " OR ", map { _pp_depends( [$_] ) } @$entry;
                $str .= ')';
                
            } elsif ( UNIVERSAL::isa( $entry, 'REF' ) ) {
                $str .= _pp_depends( $$entry );
            } elsif ( UNIVERSAL::isa( $entry, 'HASH' ) ) {
                while (my($k,$v) = each %$entry) {
                    my ($ver,$op) = reverse split /\s+/, $v;
                    $op ||= '>=';
                    $str .= "$k $op $ver";
                }
            } else {
                die "Illegal token: $entry\n";
            }
        }
        
        $str =~ s/^ AND //;
        
        return $str;
    }
        
     
    ### takes a string with a wanted package and an optional available list
    ### and check if the package is available/provided by any installed pkg
    sub dependency_satisfied {
        my $wanted  = shift or die "Wanted package required";
        my @list    = @{ shift || [] };
        @list       = LoadFile( $protoconf::Available ) unless @list;
    
        ### XXX objectify properly
        ### XXX no | dependencies, no versions
        ### defaults to not satisfied, if we got dependencies
        my $satisfied = 0;
       
        ++$satisfied if grep {
                            $wanted eq $_
                        } map { 
                            ref $_->{provides} 
                                ? @ { $_->{provides} } 
                                : $_->{provides}
                                ;
                        } @list;
                        
        return $satisfied;
    }  

    ### takes a wanted string and a meta object, and checks if the meta object
    ### provides the wanted string
    sub dependency_satisfied_by {
        my($wanted, $meta) = @_ or die "Wanted & Meta required";
        
        return scalar grep { 
                        $wanted eq $_ 
                    } ref $meta->{provides} 
                        ? @ { $meta->{provides} } 
                        : $meta->{provides} || ();
    }      
}