view release on metacpan or  search on metacpan

lib/Wx/Perl/Packager/Base.pm  view on Meta::CPAN

sub get_module_app_relocate_path {
    if(my $filename = $_[0]->get_module_filename($_[1])) {
        my $dirpath = $_[0]->get_app_relocate_path();
        
        return $dirpath . $_[0]->get_path_separator . $filename;
    } else {
        return undef;
    }
}

sub get_module_app_extract_path {
    if(my $filename = $_[0]->get_module_filename($_[1])) {
        my $dirpath = $_[0]->get_app_extract_path();
        
        return $dirpath . $_[0]->get_path_separator . $filename;
    } else {
        return undef;
    }
}

sub get_module_core_load_path {
    if(my $filename = $_[0]->get_module_filename($_[1])) {
        my $dirpath = ( $_[0]->get_core_relocated ) 
            ? $_[0]->get_app_relocate_path
            : $_[0]->get_wx_load_path;
        my $sep = ( $_[0]->get_is_mswin ) ? "\\" : '/';
        
        return ( $dirpath ) ? $dirpath . $sep . $filename : $filename;
    } else {
        return undef;
    }
}
    
sub setsys_filepath {
    my($self, $filepath) = @_;
    $filepath =~ s/\\/\//g;
    return $filepath;
}


#------------------------------------------
# If we have no alternative but to relocate
# wx dlls ........
#------------------------------------------

sub config_relocate_path {
    my $self = shift;
    return if !$self->get_relocateable(); # just in case
    
    # app extract path is writable by us - so create our wxlib extract
    # files side by side
    
    my $appextractpath = $self->get_app_extract_path();
    die qq(error in determining extract paths) if !-d $appextractpath;
    
    # determine where the standard PDK path is
    
    # get a unique extract directory for this application build
    my $runtime = $self->get_runtime();
    my $uid = getlogin || (getpwuid($<))[0];
    my $toplevel = 'wxppl-' . $uid;
    $toplevel =~ s/[^A-Za-z0-9\-_]/_/g;
    
    my $apprelocatedir;
    
    if($runtime eq 'PERLAPP') {
        # get a unique dir for this build in this location
        my $ctx = Digest::MD5->new;
        my $exec = PerlApp::exe();
        $ctx->add( $exec  );
        my $basestatfile = $appextractpath . '/' . $self->get_basemodule();
        $self->debug_print(qq(Base Core extracted module = $basestatfile));
        my $filestat = (-f $basestatfile ) ? (stat($basestatfile))[7]: 'fixed data';
        $ctx->add( $filestat );
        
        if($self->get_relocate_wx_main) {
            # we also relocate wxmain - which means we have to add that to uniqueness
            if( my $wxmain = $self->get_module_filename('wx') ) {
                my $mainstatfile = $appextractpath . '/' . $wxmain;
                $self->debug_print(qq(Wx Main extracted module = $mainstatfile));
                my $mainfilestat = (-f $mainstatfile ) ? (stat($mainstatfile))[7]: 'wxmain data';
                $ctx->add( $mainfilestat );
            }
        }
        
        $apprelocatedir = $ctx->hexdigest;
        
    }   elsif( $runtime eq 'PDKCHECK' ) {
        # we keep the same dir and overwrite
        $apprelocatedir = 'PDKCHECKBUILDING';
    }
    
    # build the directories
    my @paths = split(/[\/\\]/, $appextractpath);
    pop(@paths);
    my $apprunpath = join('/', (@paths, $toplevel));
    mkdir($apprunpath, 0700) if !-d $apprunpath;
    $apprunpath .= '/' . $apprelocatedir;
    mkdir($apprunpath, 0700) if !-d $apprunpath;
    
    $self->set_app_relocate_path($apprunpath);
}

1;