Initial Commit
This commit is contained in:
Riley Schneider
308
database/perl/vendor/lib/Portable.pm
vendored
Normal file
308
database/perl/vendor/lib/Portable.pm
vendored
Normal file
@@ -0,0 +1,308 @@
|
||||
package Portable;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Portable - Perl on a Stick
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Launch a script portably
|
||||
|
||||
F:\anywhere\perl.exe -MPortable script.pl
|
||||
|
||||
Have a script specifically request to run portably
|
||||
|
||||
#!/usr/bin/perl
|
||||
use Portable;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
"Portable" is a term used for applications that are installed onto a
|
||||
portable storage device (most commonly a USB memory stick) rather than
|
||||
onto a single host.
|
||||
|
||||
This technique has become very popular for Windows applications, as it
|
||||
allows a user to make use of their own software on typical publically
|
||||
accessible computers at libraries, hotels and internet cafes.
|
||||
|
||||
Converting a Windows application into portable form has a specific set
|
||||
of challenges, as the application has no access to the Windows registry,
|
||||
no access to "My Documents" type directories, and does not exist at a
|
||||
reliable filesystem path (because the portable storage medium can be
|
||||
mounted at an arbitrary volume or filesystem location).
|
||||
|
||||
B<Portable> provides a methodology and implementation to support
|
||||
the creating of "Portable Perl" applications and distributions.
|
||||
|
||||
While this will initially be focused on a Windows implementation,
|
||||
wherever possible the module will be built to be platform-agnostic
|
||||
in the hope that future versions can support other operating systems,
|
||||
or work across multiple operating systems.
|
||||
|
||||
This module is not ready for public use. For now, see the code for
|
||||
more details on how it works...
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=cut
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Portable::LoadYaml;
|
||||
use Portable::FileSpec;
|
||||
|
||||
our $VERSION = '1.23';
|
||||
|
||||
# This variable is provided exclusively for the
|
||||
# use of test scripts.
|
||||
our $FAKE_PERL;
|
||||
|
||||
# Globally-accessible flag to see if Portable is enabled.
|
||||
# Defaults to undef, because if Portable.pm is not loaded
|
||||
# AT ALL, $Portable::ENABLED returns undef anyways.
|
||||
our $ENABLED = undef;
|
||||
|
||||
# Param-checking
|
||||
sub _STRING ($) {
|
||||
(defined $_[0] and ! ref $_[0] and length($_[0])) ? $_[0] : undef;
|
||||
}
|
||||
sub _HASH ($) {
|
||||
(ref $_[0] eq 'HASH' and scalar %{$_[0]}) ? $_[0] : undef;
|
||||
}
|
||||
sub _ARRAY ($) {
|
||||
(ref $_[0] eq 'ARRAY' and @{$_[0]}) ? $_[0] : undef;
|
||||
}
|
||||
|
||||
# Package variables
|
||||
my %applied;
|
||||
my $cache;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Pragma/Import Interface
|
||||
|
||||
sub import {
|
||||
my $class = shift;
|
||||
$class->apply( @_ ? @_ : qw{ Config CPAN } );
|
||||
}
|
||||
|
||||
sub apply {
|
||||
# default %applied;
|
||||
my $class = shift;
|
||||
my $self = $class->default;
|
||||
my %apply = map { $_ => 1 } @_;
|
||||
if ( $apply{Config} and ! $applied{Config} ) {
|
||||
$self->config->apply($self);
|
||||
$applied{Config} = 1;
|
||||
$ENABLED = 1;
|
||||
}
|
||||
if ( $apply{CPAN} and ! $applied{CPAN} and $self->cpan ) {
|
||||
$self->cpan->apply($self);
|
||||
$applied{CPAN} = 1;
|
||||
$ENABLED = 1;
|
||||
}
|
||||
if ( $apply{HomeDir} and ! $applied{HomeDir} and $self->homedir ) {
|
||||
$self->homedir->apply($self);
|
||||
$applied{HomeDir} = 1;
|
||||
$ENABLED = 1;
|
||||
}
|
||||
|
||||
# We don't need to do anything for CPAN::Mini.
|
||||
# It will load us instead (I think)
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub applied {
|
||||
$applied{$_[1]};
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Constructors
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = bless { @_ }, $class;
|
||||
|
||||
# Param checking
|
||||
unless ( exists $self->{dist_volume} ) {
|
||||
die('Missing or invalid dist_volume param');
|
||||
}
|
||||
unless ( _STRING($self->dist_dirs) ) {
|
||||
die('Missing or invalid dist_dirs param');
|
||||
}
|
||||
unless ( _STRING($self->dist_root) ) {
|
||||
die('Missing or invalid dist_root param');
|
||||
}
|
||||
unless ( _HASH($self->{portable}) ) {
|
||||
die('Missing or invalid portable param');
|
||||
}
|
||||
|
||||
# Compulsory support for Config.pm
|
||||
require Portable::Config;
|
||||
$self->{Config} = Portable::Config->new( $self );
|
||||
|
||||
# Optional support for CPAN::Config
|
||||
if ( $self->portable_cpan ) {
|
||||
require Portable::CPAN;
|
||||
$self->{CPAN} = Portable::CPAN->new( $self );
|
||||
}
|
||||
|
||||
# Optional support for File::HomeDir
|
||||
if ( $self->portable_homedir ) {
|
||||
require Portable::HomeDir;
|
||||
$self->{HomeDir} = Portable::HomeDir->new( $self );
|
||||
}
|
||||
|
||||
# Optional support for CPAN::Mini
|
||||
if ( $self->portable_minicpan ) {
|
||||
require Portable::minicpan;
|
||||
$self->{minicpan} = Portable::minicpan->new( $self );
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub default {
|
||||
# state $cache;
|
||||
return $cache if $cache;
|
||||
|
||||
# Get the perl executable location
|
||||
my $perlpath = ($ENV{HARNESS_ACTIVE} and $FAKE_PERL) ? $FAKE_PERL : $^X;
|
||||
|
||||
# The path to Perl has a localized path.
|
||||
# G:\\strawberry\\perl\\bin\\perl.exe
|
||||
# Split it up, and search upwards to try and locate the
|
||||
# portable.perl file in the distribution root.
|
||||
my ($dist_volume, $d, $f) = Portable::FileSpec::splitpath($perlpath);
|
||||
my @d = Portable::FileSpec::splitdir($d);
|
||||
pop @d if @d > 0 && $d[-1] eq '';
|
||||
my @tmp = grep {
|
||||
-f Portable::FileSpec::catpath( $dist_volume, $_, 'portable.perl' )
|
||||
}
|
||||
map {
|
||||
Portable::FileSpec::catdir(@d[0 .. $_])
|
||||
} reverse ( 0 .. $#d );
|
||||
my $dist_dirs = $tmp[0];
|
||||
unless ( defined $dist_dirs ) {
|
||||
die("Failed to find the portable.perl file");
|
||||
}
|
||||
|
||||
# Derive the main paths from the plain dirs
|
||||
my $dist_root = Portable::FileSpec::catpath($dist_volume, $dist_dirs, '' );
|
||||
my $conf = Portable::FileSpec::catpath($dist_volume, $dist_dirs, 'portable.perl' );
|
||||
|
||||
# Load the YAML file
|
||||
my $portable = Portable::LoadYaml::load_file( $conf );
|
||||
unless ( _HASH($portable) ) {
|
||||
die("Missing or invalid portable.perl file");
|
||||
}
|
||||
|
||||
# Hand off to the main constructor,
|
||||
# cache the result and return it
|
||||
$cache = __PACKAGE__->new(
|
||||
dist_volume => $dist_volume,
|
||||
dist_dirs => $dist_dirs,
|
||||
dist_root => $dist_root,
|
||||
conf => $conf,
|
||||
perlpath => $perlpath,
|
||||
portable => $portable,
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#####################################################################
|
||||
# Configuration Accessors
|
||||
|
||||
sub dist_volume {
|
||||
$_[0]->{dist_volume};
|
||||
}
|
||||
|
||||
sub dist_dirs {
|
||||
$_[0]->{dist_dirs};
|
||||
}
|
||||
|
||||
sub dist_root {
|
||||
$_[0]->{dist_root};
|
||||
}
|
||||
|
||||
sub conf {
|
||||
$_[0]->{conf};
|
||||
}
|
||||
|
||||
sub perlpath {
|
||||
$_[0]->{perlpath};
|
||||
}
|
||||
|
||||
sub portable_cpan {
|
||||
$_[0]->{portable}->{CPAN};
|
||||
}
|
||||
|
||||
sub portable_config {
|
||||
$_[0]->{portable}->{Config};
|
||||
}
|
||||
|
||||
sub portable_homedir {
|
||||
$_[0]->{portable}->{HomeDir};
|
||||
}
|
||||
|
||||
sub portable_minicpan {
|
||||
$_[0]->{portable}->{minicpan};
|
||||
}
|
||||
|
||||
sub portable_env {
|
||||
$_[0]->{portable}->{Env};
|
||||
}
|
||||
|
||||
sub config {
|
||||
$_[0]->{Config};
|
||||
}
|
||||
|
||||
sub cpan {
|
||||
$_[0]->{CPAN};
|
||||
}
|
||||
|
||||
sub homedir {
|
||||
$_[0]->{HomeDir};
|
||||
}
|
||||
|
||||
sub minicpan {
|
||||
$_[0]->{minicpan};
|
||||
}
|
||||
|
||||
sub env {
|
||||
$_[0]->{Env};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2008 - 2011 Adam Kennedy.
|
||||
|
||||
This program is free software; you can redistribute
|
||||
it and/or modify it under the same terms as Perl itself.
|
||||
|
||||
The full text of the license can be found in the
|
||||
LICENSE file included with this module.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user