KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

94
database/perl/vendor/lib/Portable/CPAN.pm vendored Normal file
View File

@@ -0,0 +1,94 @@
package Portable::CPAN;
use 5.008;
use strict;
use warnings;
use Portable::FileSpec;
our $VERSION = '1.23';
# Create the enumerations
our %bin = map { $_ => 1 } qw{
bzip2 curl ftp gpg gzip lynx
ncftp ncftpget pager patch
shell tar unzip wget
};
our %post = map { $_ => 1 } qw{
make_arg make_install_arg makepl_arg
mbuild_arg mbuild_install_arg mbuildpl_arg
};
our %file = ( %bin, histfile => 1 );
#####################################################################
# Constructor
sub new {
my $class = shift;
my $parent = shift;
unless ( Portable::_HASH($parent->portable_cpan) ) {
die('Missing or invalid cpan key in portable.perl');
}
# Create the object
my $self = bless { }, $class;
# Map the
my $cpan = $parent->portable_cpan;
my $root = $parent->dist_root;
foreach my $key ( sort keys %$cpan ) {
unless (
defined $cpan->{$key}
and
length $cpan->{$key}
and not
$post{$key}
) {
$self->{$key} = $cpan->{$key};
next;
}
if ($file{$key}) {
$self->{$key} = Portable::FileSpec::catfile($root, split /\//, $cpan->{$key});
}
else {
$self->{$key} = Portable::FileSpec::catdir($root, split /\//, $cpan->{$key});
}
}
my $config = $parent->config;
foreach my $key ( sort keys %post ) {
next unless defined $self->{$key};
$self->{$key} =~ s/\$(\w+)/$config->{$1}/g;
}
return $self;
}
sub apply {
my $self = shift;
my $parent = shift;
# Load the CPAN configuration
require CPAN::Config;
# Overwrite the CPAN config entries
foreach my $key ( sort keys %$self ) {
$CPAN::Config->{$key} = $self->{$key};
}
# Confirm we got all the paths
my $volume = quotemeta $parent->dist_volume;
foreach my $key ( sort keys %$CPAN::Config ) {
next unless defined $CPAN::Config->{$key};
next if $CPAN::Config->{$key} =~ /$volume/;
next unless $CPAN::Config->{$key} =~ /\b[a-z]\:/i;
next if -e $CPAN::Config->{$key};
die "Failed to localize \$CPAN::Config->{$key} ($CPAN::Config->{$key})";
}
return 1;
}
1;

94
database/perl/vendor/lib/Portable/Config.pm vendored Normal file
View File

@@ -0,0 +1,94 @@
package Portable::Config;
use 5.008;
use strict;
use warnings;
use Portable::FileSpec;
our $VERSION = '1.23';
#####################################################################
# Constructor
sub new {
my $class = shift;
my $parent = shift;
unless ( Portable::_HASH($parent->portable_config) ) {
die('Missing or invalid config key in portable.perl');
}
# Create the object
my $self = bless { }, $class;
my $conf = $parent->portable_config;
my $root = $parent->dist_root;
foreach my $key ( sort keys %$conf ) {
unless (
defined $conf->{$key}
and
length $conf->{$key}
and not
$key =~ /^ld|^libpth$/
) {
$self->{$key} = $conf->{$key};
next;
}
#join path to directory of portable perl with value from config file
if ($key eq 'perlpath') {
$self->{$key} = Portable::FileSpec::catfile($root, split /\//, $conf->{$key});
}
else {
$self->{$key} = Portable::FileSpec::catdir($root, split /\//, $conf->{$key});
}
}
foreach my $key ( grep { /^ld|^libpth$/ } keys %$self ) {
#special handling of linker config variables and libpth
next unless defined $self->{$key};
$self->{$key} =~ s/\$(\w+)/$self->{$1}/g;
}
return $self;
}
sub apply {
my $self = shift;
my $parent = shift;
# Force all Config entries to load, so that
# all Config_heavy.pl code has run, and none
# of our values will be overwritten later.
require Config;
my $preload = { %Config::Config };
# Shift the tie STORE method out the way
SCOPE: {
no warnings;
*Config::_TEMP = *Config::STORE;
*Config::STORE = sub {
$_[0]->{$_[1]} = $_[2];
};
}
# Write the values to the Config hash
foreach my $key ( sort keys %$self ) {
$Config::Config{$key} = $self->{$key};
}
# Restore the STORE method
SCOPE: {
no warnings;
*Config::STORE = delete $Config::{_TEMP};
}
# Confirm we got all the paths
my $volume = quotemeta $parent->dist_volume;
foreach my $key ( sort keys %Config::Config ) {
next unless defined $Config::Config{$key};
next if $Config::Config{$key} =~ /$volume/i;
next unless $Config::Config{$key} =~ /\b[a-z]\:/i;
die "Failed to localize \$Config::Config{$key} ($Config::Config{$key})";
}
return 1;
}
1;

180
database/perl/vendor/lib/Portable/FileSpec.pm vendored Normal file
View File

@@ -0,0 +1,180 @@
package Portable::FileSpec;
### UGLY HACK: these functions where completely copied from File::Spec::Win32
use 5.008;
use strict;
use warnings;
our $VERSION = '1.23';
# Some regexes we use for path splitting
my $DRIVE_RX = '[a-zA-Z]:';
my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+';
my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)";
sub splitpath {
my ($path, $nofile) = @_;
my ($volume,$directory,$file) = ('','','');
if ( $nofile ) {
$path =~
m{^ ( $VOL_RX ? ) (.*) }sox;
$volume = $1;
$directory = $2;
}
else {
$path =~
m{^ ( $VOL_RX ? )
( (?:.*[\\/](?:\.\.?\Z(?!\n))?)? )
(.*)
}sox;
$volume = $1;
$directory = $2;
$file = $3;
}
return ($volume,$directory,$file);
}
sub splitdir {
my ($directories) = @_ ;
#
# split() likes to forget about trailing null fields, so here we
# check to be sure that there will not be any before handling the
# simple case.
#
if ( $directories !~ m|[\\/]\Z(?!\n)| ) {
return split( m|[\\/]|, $directories );
}
else {
#
# since there was a trailing separator, add a file name to the end,
# then do the split, then replace it with ''.
#
my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ;
$directories[ $#directories ]= '' ;
return @directories ;
}
}
sub catpath {
my ($volume,$directory,$file) = @_;
# If it's UNC, make sure the glue separator is there, reusing
# whatever separator is first in the $volume
my $v;
$volume .= $v
if ( (($v) = $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s) &&
$directory =~ m@^[^\\/]@s
) ;
$volume .= $directory ;
# If the volume is not just A:, make sure the glue separator is
# there, reusing whatever separator is first in the $volume if possible.
if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s &&
$volume =~ m@[^\\/]\Z(?!\n)@ &&
$file =~ m@[^\\/]@
) {
$volume =~ m@([\\/])@ ;
my $sep = $1 ? $1 : '\\' ;
$volume .= $sep ;
}
$volume .= $file ;
return $volume ;
}
sub catdir {
# Legacy / compatibility support
return "" unless @_;
shift, return _canon_cat( "/", @_ ) if $_[0] eq "";
# Compatibility with File::Spec <= 3.26:
# catdir('A:', 'foo') should return 'A:\foo'.
return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) if $_[0] =~ m{^$DRIVE_RX\z}o;
return _canon_cat( @_ );
}
sub catfile {
# Legacy / compatibility support
#
shift, return _canon_cat( "/", @_ )
if $_[0] eq "";
# Compatibility with File::Spec <= 3.26:
# catfile('A:', 'foo') should return 'A:\foo'.
return _canon_cat( ($_[0].'\\'), @_[1..$#_] )
if $_[0] =~ m{^$DRIVE_RX\z}o;
return _canon_cat( @_ );
}
sub _canon_cat {
my ($first, @rest) = @_;
my $volume = $first =~ s{ \A ([A-Za-z]:) ([\\/]?) }{}x # drive letter
? ucfirst( $1 ).( $2 ? "\\" : "" )
: $first =~ s{ \A (?:\\\\|//) ([^\\/]+)
(?: [\\/] ([^\\/]+) )?
[\\/]? }{}xs # UNC volume
? "\\\\$1".( defined $2 ? "\\$2" : "" )."\\"
: $first =~ s{ \A [\\/] }{}x # root dir
? "\\"
: "";
my $path = join "\\", $first, @rest;
$path =~ tr#\\/#\\\\#s; # xx/yy --> xx\yy & xx\\yy --> xx\yy
# xx/././yy --> xx/yy
$path =~ s{(?:
(?:\A|\\) # at begin or after a slash
\.
(?:\\\.)* # and more
(?:\\|\z) # at end or followed by slash
)+ # performance boost -- I do not know why
}{\\}gx;
# XXX I do not know whether more dots are supported by the OS supporting
# this ... annotation (NetWare or symbian but not MSWin32).
# Then .... could easily become ../../.. etc:
# Replace \.\.\. by (\.\.\.+) and substitute with
# { $1 . ".." . "\\.." x (length($2)-2) }gex
# ... --> ../..
$path =~ s{ (\A|\\) # at begin or after a slash
\.\.\.
(?=\\|\z) # at end or followed by slash
}{$1..\\..}gx;
# xx\yy\..\zz --> xx\zz
while ( $path =~ s{(?:
(?:\A|\\) # at begin or after a slash
[^\\]+ # rip this 'yy' off
\\\.\.
(?<!\A\.\.\\\.\.) # do *not* replace ^..\..
(?<!\\\.\.\\\.\.) # do *not* replace \..\..
(?:\\|\z) # at end or followed by slash
)+ # performance boost -- I do not know why
}{\\}sx ) {}
$path =~ s#\A\\##; # \xx --> xx NOTE: this is *not* root
$path =~ s#\\\z##; # xx\ --> xx
if ( $volume =~ m#\\\z# )
{ # <vol>\.. --> <vol>\
$path =~ s{ \A # at begin
\.\.
(?:\\\.\.)* # and more
(?:\\|\z) # at end or followed by slash
}{}x;
return $1 # \\HOST\SHARE\ --> \\HOST\SHARE
if $path eq ""
and $volume =~ m#\A(\\\\.*)\\\z#s;
}
return $path ne "" || $volume ? $volume.$path : ".";
}
1;

110
database/perl/vendor/lib/Portable/HomeDir.pm vendored Normal file
View File

@@ -0,0 +1,110 @@
package Portable::HomeDir;
# In the trivial case, only my_home is implemented
use 5.008;
use strict;
use warnings;
use Portable::FileSpec;
our $VERSION = '1.23';
#####################################################################
# Portable Driver API
sub new {
my $class = shift;
my $parent = shift;
unless ( Portable::_HASH($parent->portable_homedir) ) {
die('Missing or invalid HomeDir key in portable.perl');
}
# Create the object
my $self = bless { }, $class;
# Map the
my $homedir = $parent->portable_homedir;
my $root = $parent->dist_root;
foreach my $key ( sort keys %$homedir ) {
unless (
defined $homedir->{$key}
and
length $homedir->{$key}
) {
$self->{$key} = $homedir->{$key};
next;
}
$self->{$key} = Portable::FileSpec::catdir(
$root, split /\//, $homedir->{$key}
);
}
return $self;
}
sub apply {
my $self = shift;
# Shortcut if we've already applied
if ( $File::HomeDir::IMPLEMENTED_BY eq __PACKAGE__ ) {
return 1;
}
# Load File::HomeDir and the regular platform driver
require File::HomeDir;
# Remember the platform we're on so we can default
# to it properly if there's no portable equivalent.
$self->{platform} = $File::HomeDir::IMPLEMENTED_BY;
# Hijack the implementation class to us
$File::HomeDir::IMPLEMENTED_BY = __PACKAGE__;
return 1;
}
sub platform {
$_[0]->{platform};
}
#####################################################################
# File::HomeDir::Driver API
sub _SELF {
ref($_[0]) ? $_[0] : Portable->default->homedir;
}
sub my_home {
_SELF(@_)->{my_home};
}
# The concept of "my_desktop" is incompatible with the idea of
# a Portable Perl distribution (because Windows won't overwrite
# the desktop with anything on the flash drive)
# sub my_desktop
sub my_documents {
_SELF(@_)->{my_documents};
}
sub my_music {
_SELF(@_)->{my_music};
}
sub my_pictures {
_SELF(@_)->{my_pictures};
}
sub my_videos {
_SELF(@_)->{my_videos};
}
sub my_data {
_SELF(@_)->{my_data};
}
1;

431
database/perl/vendor/lib/Portable/LoadYaml.pm vendored Normal file
View File

@@ -0,0 +1,431 @@
package Portable::LoadYaml;
### UGLY HACK: these functions where completely copied from Parse::CPAN::Meta
use 5.008;
use strict;
use warnings;
our $VERSION = '1.23';
sub load_file {
my $file = shift;
my $self = __PACKAGE__->_load_file($file);
return $self->[-1];
}
#####################################################################
# Constants
# Printed form of the unprintable characters in the lowest range
# of ASCII characters, listed by ASCII ordinal position.
my @UNPRINTABLE = qw(
0 x01 x02 x03 x04 x05 x06 a
b t n v f r x0E x0F
x10 x11 x12 x13 x14 x15 x16 x17
x18 x19 x1A e x1C x1D x1E x1F
);
# Printable characters for escapes
my %UNESCAPES = (
0 => "\x00", z => "\x00", N => "\x85",
a => "\x07", b => "\x08", t => "\x09",
n => "\x0a", v => "\x0b", f => "\x0c",
r => "\x0d", e => "\x1b", '\\' => '\\',
);
# These 3 values have special meaning when unquoted and using the
# default YAML schema. They need quotes if they are strings.
my %QUOTE = map { $_ => 1 } qw{
null true false
};
# The commented out form is simpler, but overloaded the Perl regex
# engine due to recursion and backtracking problems on strings
# larger than 32,000ish characters. Keep it for reference purposes.
# qr/\"((?:\\.|[^\"])*)\"/
my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
# unquoted re gets trailing space that needs to be stripped
my $re_capture_unquoted_key = qr/([^:]+(?::+\S[^:]*)*)(?=\s*\:(?:\s+|$))/;
my $re_trailing_comment = qr/(?:\s+\#.*)?/;
my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
###
# Loader functions:
# Create an object from a file
sub _load_file {
my $class = ref $_[0] ? ref shift : shift;
# Check the file
my $file = shift or $class->_error( 'You did not specify a file name' );
$class->_error( "File '$file' does not exist" )
unless -e $file;
$class->_error( "'$file' is a directory, not a file" )
unless -f _;
$class->_error( "Insufficient permissions to read '$file'" )
unless -r _;
# Open unbuffered
open( my $fh, "<:unix", $file );
unless ( $fh ) {
$class->_error("Failed to open file '$file': $!");
}
# slurp the contents
my $contents = eval {
use warnings FATAL => 'utf8';
local $/;
<$fh>
};
if ( my $err = $@ ) {
$class->_error("Error reading from file '$file': $err");
}
# close the file (release the lock)
unless ( close $fh ) {
$class->_error("Failed to close file '$file': $!");
}
$class->_load_string( $contents );
}
# Create an object from a string
sub _load_string {
my $class = ref $_[0] ? ref shift : shift;
my $self = bless [], $class;
my $string = $_[0];
eval {
unless ( defined $string ) {
die \"Did not provide a string to load";
}
# Check if Perl has it marked as characters, but it's internally
# inconsistent. E.g. maybe latin1 got read on a :utf8 layer
if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
die \<<'...';
Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
...
}
# Ensure Unicode character semantics, even for 0x80-0xff
utf8::upgrade($string);
# Check for and strip any leading UTF-8 BOM
$string =~ s/^\x{FEFF}//;
# Check for some special cases
return $self unless length $string;
# Split the file into lines
my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
split /(?:\015{1,2}\012|\015|\012)/, $string;
# Strip the initial YAML header
@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
# A nibbling parser
my $in_document = 0;
while ( @lines ) {
# Do we have a document header?
if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
# Handle scalar documents
shift @lines;
if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
push @$self,
$self->_load_scalar( "$1", [ undef ], \@lines );
next;
}
$in_document = 1;
}
if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
# A naked document
push @$self, undef;
while ( @lines and $lines[0] !~ /^---/ ) {
shift @lines;
}
$in_document = 0;
# XXX The final '-+$' is to look for -- which ends up being an
# error later.
} elsif ( ! $in_document && @$self ) {
# only the first document can be explicit
die \"failed to classify the line '$lines[0]'";
} elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
# An array at the root
my $document = [ ];
push @$self, $document;
$self->_load_array( $document, [ 0 ], \@lines );
} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
# A hash at the root
my $document = { };
push @$self, $document;
$self->_load_hash( $document, [ length($1) ], \@lines );
} else {
# Shouldn't get here. @lines have whitespace-only lines
# stripped, and previous match is a line with any
# non-whitespace. So this clause should only be reachable via
# a perlbug where \s is not symmetric with \S
# uncoverable statement
die \"failed to classify the line '$lines[0]'";
}
}
};
if ( ref $@ eq 'SCALAR' ) {
$self->_error(${$@});
} elsif ( $@ ) {
$self->_error($@);
}
return $self;
}
sub _unquote_single {
my ($self, $string) = @_;
return '' unless length $string;
$string =~ s/\'\'/\'/g;
return $string;
}
sub _unquote_double {
my ($self, $string) = @_;
return '' unless length $string;
$string =~ s/\\"/"/g;
$string =~
s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
{(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
return $string;
}
# Load a YAML scalar string to the actual Perl scalar
sub _load_scalar {
my ($self, $string, $indent, $lines) = @_;
# Trim trailing whitespace
$string =~ s/\s*\z//;
# Explitic null/undef
return undef if $string eq '~';
# Single quote
if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
return $self->_unquote_single($1);
}
# Double quote.
if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
return $self->_unquote_double($1);
}
# Special cases
if ( $string =~ /^[\'\"!&]/ ) {
die \"does not support a feature in line '$string'";
}
return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
# Regular unquoted string
if ( $string !~ /^[>|]/ ) {
die \"found illegal characters in plain scalar: '$string'"
if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
$string =~ /:(?:\s|$)/;
$string =~ s/\s+#.*\z//;
return $string;
}
# Error
die \"failed to find multi-line scalar content" unless @$lines;
# Check the indent depth
$lines->[0] =~ /^(\s*)/;
$indent->[-1] = length("$1");
if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
die \"found bad indenting in line '$lines->[0]'";
}
# Pull the lines
my @multiline = ();
while ( @$lines ) {
$lines->[0] =~ /^(\s*)/;
last unless length($1) >= $indent->[-1];
push @multiline, substr(shift(@$lines), length($1));
}
my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
return join( $j, @multiline ) . $t;
}
# Load an array
sub _load_array {
my ($self, $array, $indent, $lines) = @_;
while ( @$lines ) {
# Check for a new document
if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
while ( @$lines and $lines->[0] !~ /^---/ ) {
shift @$lines;
}
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
die \"found bad indenting in line '$lines->[0]'";
}
if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
# Inline nested hash
my $indent2 = length("$1");
$lines->[0] =~ s/-/ /;
push @$array, { };
$self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
shift @$lines;
unless ( @$lines ) {
push @$array, undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)\-/ ) {
my $indent2 = length("$1");
if ( $indent->[-1] == $indent2 ) {
# Null array entry
push @$array, undef;
} else {
# Naked indenter
push @$array, [ ];
$self->_load_array(
$array->[-1], [ @$indent, $indent2 ], $lines
);
}
} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
push @$array, { };
$self->_load_hash(
$array->[-1], [ @$indent, length("$1") ], $lines
);
} else {
die \"failed to classify line '$lines->[0]'";
}
} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
# Array entry with a value
shift @$lines;
push @$array, $self->_load_scalar(
"$2", [ @$indent, undef ], $lines
);
} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
# This is probably a structure like the following...
# ---
# foo:
# - list
# bar: value
#
# ... so lets return and let the hash parser handle it
return 1;
} else {
die \"failed to classify line '$lines->[0]'";
}
}
return 1;
}
# Load a hash
sub _load_hash {
my ($self, $hash, $indent, $lines) = @_;
while ( @$lines ) {
# Check for a new document
if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
while ( @$lines and $lines->[0] !~ /^---/ ) {
shift @$lines;
}
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
die \"found bad indenting in line '$lines->[0]'";
}
# Find the key
my $key;
# Quoted keys
if ( $lines->[0] =~
s/^\s*$re_capture_single_quoted$re_key_value_separator//
) {
$key = $self->_unquote_single($1);
}
elsif ( $lines->[0] =~
s/^\s*$re_capture_double_quoted$re_key_value_separator//
) {
$key = $self->_unquote_double($1);
}
elsif ( $lines->[0] =~
s/^\s*$re_capture_unquoted_key$re_key_value_separator//
) {
$key = $1;
$key =~ s/\s+$//;
}
elsif ( $lines->[0] =~ /^\s*\?/ ) {
die \"does not support a feature in line '$lines->[0]'";
}
else {
die \"failed to classify line '$lines->[0]'";
}
# Do we have a value?
if ( length $lines->[0] ) {
# Yes
$hash->{$key} = $self->_load_scalar(
shift(@$lines), [ @$indent, undef ], $lines
);
} else {
# An indent
shift @$lines;
unless ( @$lines ) {
$hash->{$key} = undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)-/ ) {
$hash->{$key} = [];
$self->_load_array(
$hash->{$key}, [ @$indent, length($1) ], $lines
);
} elsif ( $lines->[0] =~ /^(\s*)./ ) {
my $indent2 = length("$1");
if ( $indent->[-1] >= $indent2 ) {
# Null hash entry
$hash->{$key} = undef;
} else {
$hash->{$key} = {};
$self->_load_hash(
$hash->{$key}, [ @$indent, length($1) ], $lines
);
}
}
}
}
return 1;
}
1;

55
database/perl/vendor/lib/Portable/minicpan.pm vendored Normal file
View File

@@ -0,0 +1,55 @@
package Portable::minicpan;
use 5.008;
use strict;
use warnings;
use Portable::FileSpec;
our $VERSION = '1.23';
#####################################################################
# Portable Driver API
sub new {
my $class = shift;
my $parent = shift;
unless ( Portable::_HASH($parent->portable_minicpan) ) {
die('Missing or invalid minicpan key in portable.perl');
}
# Create the object
my $self = bless { }, $class;
# Map paths to absolute paths
my $minicpan = $parent->portable_minicpan;
my $root = $parent->dist_root;
foreach my $key ( qw{ local } ) {
unless (
defined $minicpan->{$key}
and
length $minicpan->{$key}
) {
$self->{$key} = $minicpan->{$key};
next;
}
$self->{$key} = Portable::FileSpec::catdir(
$root, split /\//, $minicpan->{$key}
);
}
# Add the literal params
$self->{remote} = $minicpan->{remote};
$self->{quiet} = $minicpan->{quiet};
$self->{force} = $minicpan->{force};
$self->{offline} = $minicpan->{offline};
$self->{also_mirror} = $minicpan->{also_mirror};
$self->{module_filters} = $minicpan->{module_filters};
$self->{path_filters} = $minicpan->{path_filters};
$self->{skip_cleanup} = $minicpan->{skip_cleanup};
$self->{skip_perl} = $minicpan->{skip_perl};
$self->{no_conn_cache} = $minicpan->{no_conn_cache};
return $self;
}
1;