view release on metacpan or search on metacpan
lib/Config/Model/Backend/Augeas.pm view on Meta::CPAN
# Likewise, hashes can be in the form
# /files/etc/ssh/sshd_config/Subsystem[2]/foo/ is-seq ditch idx
# /files/etc/ssh/sshd_config/Bar/foo/ non-seq
my @cm_steps = split m!/+!, $cm_p;
my $obj = $self->{node};
$obj = $obj->fetch_element( shift @cm_steps ) if $set_in;
while ( my $step = shift @cm_steps ) {
my ( $label, $idx ) = ( $step =~ /(\w+)(?:\[(\d+)\])?/ );
view release on metacpan or search on metacpan
lib/Config/Model/CursesUI.pm view on Meta::CPAN
my $str ;
if ($view_type eq 'tabular') {
$str =sprintf("%-28s | %-10s | %-30s", $name,$value,$node->name) ;
}
else {
my @level = split m/ +/ ,$loc ;
$str = ('. ' x scalar @level) . $name ;
$str .= " = '$value'" if @$_ == 4;
}
($idx++,$str) ;
} @good_leaves ;
view release on metacpan or search on metacpan
lib/App/Cme/Command/meta.pm view on Meta::CPAN
sub load_meta_model {
my ($self, $opt, $args) = @_;
my $root_model = $opt->{_root_model};
my $cm_lib_dir = path(split m!/!, $opt->{dir}) ; # replace with cm_lib_dir ???
if (! $cm_lib_dir->is_dir) {
$cm_lib_dir->mkdir();
}
view release on metacpan or search on metacpan
lib/Config/Model/AnyId.pm view on Meta::CPAN
my $path = delete $args{path};
my $autoadd = 1;
$autoadd = $args{autoadd} if defined $args{autoadd};
my $get_obj = delete $args{get_obj} || 0;
$path =~ s!^/!!;
my ( $item, $new_path ) = split m!/!, $path, 2;
my $dcm = $args{dir_char_mockup};
# $item =~ s($dcm)(/)g if $dcm ;
if ($dcm) {
lib/Config/Model/AnyId.pm view on Meta::CPAN
return $obj->get( path => $new_path, get_obj => $get_obj, %args );
}
sub set ($self, $path, @args) {
$path =~ s!^/!!;
my ( $item, $new_path ) = split m!/!, $path, 2;
return $self->fetch_with_id($item)->set( $new_path, @args );
}
sub copy ( $self, $from, $to ) {
view release on metacpan or search on metacpan
my $build = { %empty_build };
$pv =~ m{^\s+Compiled at\s+(.*)}m
and $build->{'stamp'} = $1;
$pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms
and $build->{'patches'} = [ split m{\n+\s*}, $1 ];
$pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms
and map { $build->{'options'}{$_} = 1 } split m{\s+|\n} => $1;
$build->{'osname'} = $config{'osname'};
$pv =~ m{^\s+Built under\s+(.*)}m
and $build->{'osname'} = $1;
$config{'osname'} ||= $build->{'osname'};
view release on metacpan or search on metacpan
lib/Config/YAML/Modern.pm view on Meta::CPAN
# this block for filename to hash key resolving
# et my.config.yaml -> { my => { config => { $data_here } } }
my ( $filename_for_hash, undef, $suffix ) =
fileparse( $filename, qr/\.[^.]*/ );
my @file_part = split m/\./, $filename_for_hash;
# I care about all of you, but it bad practice!!!
if ( defined $self->{'i_dont_use_suffix'} ) {
$suffix =~ s/^\.//;
view release on metacpan or search on metacpan
eg/config_creator.pl view on Meta::CPAN
my $config = '';
while( <> ) {
next if m/\s*#/;
chomp;
my( $directive, $description ) = split m/\s+/, $_, 2;
my $answer = prompt( $description );
$config .= "$directive $answer\n";
}
view release on metacpan or search on metacpan
lib/Contenticious.pm view on Meta::CPAN
% }
</ul>
@@ navi.html.ep
% my $node = contenticious->root_node;
% my @names = split m|/| => $cpath;
% my $level = 1;
% LOOP: { do { # perldoc perlsyn: do-while isn't a loop
% last unless $node->can('children');
% my $name = shift(@names) // '';
% my $id_prefix = 'sub' x ($level - 1);
view release on metacpan or search on metacpan
lib/Convert/AnyBase/Converter.pm view on Meta::CPAN
$string = $normalize->();
}
my $number = 0;
my $offset = 1;
my @string = reverse split m//, $string;
for ( @string ) {
my $value = index $set, $_;
croak "Unknown character $_ in input \"$string\"\n" if -1 == $value;
$number += ( $value * $offset );
view release on metacpan or search on metacpan
lib/Convert/Color/Library.pm view on Meta::CPAN
my $color;
if( $name =~ m{^(.*)/(.*)$} ) {
( my $dicts, $name ) = ( $1, $2 );
$color = Color::Library->color( [ split m/,/, $dicts ], $name );
}
else {
$color = Color::Library->color( $name );
}
view release on metacpan or search on metacpan
lib/Crane.pm view on Meta::CPAN
sub get_package_path {
my ( $package ) = @_;
my @path = split m{::}si, $package;
$path[-1] .= '.pm';
return catdir(@path);
}
view release on metacpan or search on metacpan
lib/Crypt/Format.pm view on Meta::CPAN
return _do_base64('decode', $pem);
}
sub split_pem_chain {
return split m[(?<=-)[\x0d\x0a]+(?=-)], shift();
}
sub _do_base64 {
my $path = "$BASE64_MODULE.pm";
$path =~ s<::></>g;
view release on metacpan or search on metacpan
04-headers.patch:
* Updated matrixssl_win32_inline.
Original code was written for MatrixSSL-1.2.5 which has single .h file:
matrixSsl.h. Starting from version 1.7.3 MatrixSSL split matrixSsl.h into
two files: matrixSsl.h and matrixCommon.h. Part of code which
matrixssl_win32_inline fixes was left in matrixSsl.h, but another part of
code was moved into matrixCommon.h.
Also '#define SSLPUBLIC' was renamed to '#define MATRIXPUBLIC'.
I've updated it to process both .h-files, and #include both .h-files in .xs.
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
=cut
sub package2filename {
my ($self, $package) = @_;
my @components = split m/::/, $package;
$components[$#components] .= ".pm";
return catfile(@components);
}
=item I<process_Inline_C_file($filename, @preload_modules)>
inc/My/Module/Build.pm view on Meta::CPAN
my $meta_yml = YAML::LoadFile($metafile);
$meta_yml->{no_index} = $self->{properties}->{add_to_no_index} || {};
$meta_yml->{no_index}->{directory} ||= [];
unshift(@{$meta_yml->{no_index}->{directory}}, qw(examples inc t),
(map { File::Spec::Unix->catdir("lib", split m/::/) }
(@{$meta_yml->{no_index}->{namespace} || []})));
foreach my $package (keys %{$meta_yml->{provides}}) {
delete $meta_yml->{provides}->{$package} if
(grep {$package =~ m/^\Q$_\E/}
view release on metacpan or search on metacpan
t/Crypt-Perl-Ed25519-PrivateKey.t view on Meta::CPAN
sprintf('%v.02x', $key->get_public() ),
$pub_str,
'correct public key determined',
);
my $msg = join q<>, map { chr hex } split m<\.>, $msg_vec;
my $sig = $key->sign($msg);
is(
sprintf('%v.02x', $sig),
$sig_vec,
'expected signature',
);
my $real_sig = join q<>, map { chr hex } split m<\.>, $sig_vec;
ok( $key->verify($msg, $real_sig), 'verify()' );
}
#----------------------------------------------------------------------
t/Crypt-Perl-Ed25519-PrivateKey.t view on Meta::CPAN
}
#----------------------------------------------------------------------
my $private = Crypt::Perl::Ed25519::PrivateKey->new(
join( q<>, map { chr hex } split m<\.>, '9d.61.b1.9d.ef.fd.5a.60.ba.84.4a.f4.92.ec.2c.c4.44.49.c5.69.7b.32.69.19.70.3b.ac.03.1c.ae.7f.60' ),
);
my $thumbprint = $private->get_jwk_thumbprint('sha256');
is(
$thumbprint,
view release on metacpan or search on metacpan
lib/Cwd/Ext.pm view on Meta::CPAN
unless( $abs_path=~/^\// ){
require Cwd;
$abs_path = Cwd::cwd()."/$abs_path";
}
my @elems = split m{/}, $abs_path;
my $ptr = 1;
while($ptr <= $#elems){
if($elems[$ptr] eq '' ){
splice @elems, $ptr, 1;
}
view release on metacpan or search on metacpan
lib/Ecyrillic.pm view on Meta::CPAN
}
die __FILE__, ": Can't find string terminator anywhere before EOF\n";
}
}
# split m//
elsif (/\G \b (m) \b /oxgc) {
if (/\G (\#) ((?:$qq_char)*?) (\#) ([cgimosxpadlunbB]*) /oxgc) { return e_split ($e.'qr',$1,$3,$2,$4); } # m# # --> qr # #
else {
while (not /\G \z/oxgc) {
if (/\G ((?>\s+)|\#.*) /oxgc) { $e .= $1; }
view release on metacpan or search on metacpan
0.4 2011-12-15
- removed DAIA::Error class
- support broader/narrower items
- support more RDF serialization formats
0.35 2011-12-13
- split messages and error
- moved to dist::Zilla
- started to implement DAIA/RDF
0.31 2011-01-06
- fixed service URIs (http://purl.org/ontology/daia/Service/*)
- fixed parsing from URL
view release on metacpan or search on metacpan
t/40-alltypes.t view on Meta::CPAN
$def .= <<DEF;
A_BOOLEAN BOOLEAN
DEF
}
for (split m/,[\r\n]+/ => $def) {
my ($f, $d) = m/^\s*(\S+)\s+(\S+)/;
push @{$expected{NAME}}, $f;
push @{$expected{NAME_lc}}, lc $f;
push @{$expected{NAME_uc}}, uc $f;
push @{$expected{DEF}}, $d;
view release on metacpan or search on metacpan
lib/DBD/PO/Locale/PO.pm view on Meta::CPAN
my $eol = $self->eol();
return join q{}, map {
"$leader$_$eol";
} split m{\Q$eol\E}xms, $comment;
}
# Quote a string properly
sub quote {
my $self = shift;
lib/DBD/PO/Locale/PO.pm view on Meta::CPAN
# reference
elsif ( ($value) = $line =~ m{\A \# : \s+ (.*)}xms ) {
last LINE if $is_new_entry->('comment');
$po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
# maybe more in 1 line
$value = join $eol, split m{\s+}xms, $value;
$po->reference(
defined $po->reference()
? $po->reference() . "$eol$value"
: $value
);
}
# flags
elsif ( ($value) = $line =~ m{\A \# , \s+ (.*)}xms) {
last LINE if $is_new_entry->('comment');
$po ||= $class->new(eol => $eol, -loaded_line_number => $line_number);
for my $flag ( split m{\s* , \s*}xms, $value ) {
$po->add_flag($flag);
}
}
# Translator comments
elsif (
view release on metacpan or search on metacpan
t/rt_26775_distinct.t view on Meta::CPAN
my $slurp;
while (my $line = <DATA>) {
$slurp .= $line;
}
QUERY:
for my $query (split m/ ; /xms, $slurp) {
# remove newline + leading and trailing whitespace.
chomp $query;
$query =~ s/^ \s+ //xms;
$query =~ s/ \s+ $//xms;
view release on metacpan or search on metacpan
t/rt_26775_distinct.t view on Meta::CPAN
while (my $line = <DATA>) {
$slurp .= $line;
}
QUERY:
for my $query (split m/ ; /xms, $slurp) {
# remove newline + leading and trailing whitespace.
chomp $query;
$query =~ s/^ \s+ //xms;
$query =~ s/ \s+ $//xms;
view release on metacpan or search on metacpan
t/rt_26775_distinct.t view on Meta::CPAN
my $slurp;
while (my $line = <DATA>) {
$slurp .= $line;
}
QUERY:
for my $query (split m/ ; /xms, $slurp) {
# remove newline + leading and trailing whitespace.
chomp $query;
$query =~ s/^ \s+ //xms;
$query =~ s/ \s+ $//xms;
view release on metacpan or search on metacpan
examples/describe.pl view on Meta::CPAN
$table =~ m/^\d+$/ && exists $dd->{TABLE}[$table] and
$table = join "." => $dd->{TABLE}[$table]{ANAME},
$dd->{TABLE}[$table]{NAME};
my ($sch, $tbl) = split m/\./ => $table;
$tbl or ($tbl, $sch) = ($sch, $ENV{USCHEMA} || die "No (explicit) schema\n");
my @a = grep { $_ and $_->{NAME} eq $sch } @{$dd->{AUTH}};
@a or @a = grep { $_ and lc $_->{NAME} eq lc $sch } @{$dd->{AUTH}};
@a or @a = grep { $_ and $_->{NAME} =~ m/^$sch$/ } @{$dd->{AUTH}};
view release on metacpan or search on metacpan
lib/DBI/BabyConnect.pm view on Meta::CPAN
}
sub babyconfess {
my $class = shift;
eval { confess('') };
my @stack = split m/\n/, $@;
shift @stack for 1..3;
my $stack = join "\n", @stack;
return "$stack\n\n";
}
lib/DBI/BabyConnect.pm view on Meta::CPAN
print STDERR "\t++ $cur_pkg\n\t++ $cur_meth\n\t++ $cur_file\n\t++ $cur_line\n(END)\n";
#$src_pkg && print STDERR "\n\t++ $src_pkg\n\t++ $src_meth\n\t++ $src_file\n\t++ $src_line\n";
#print STDERR "DBI STATUS: DBI::err=\t".$DBI::err."\n\t DBI::errstr=:\t".$DBI::errstr."\n\t DBI LED=\t".$DBI::state."\n\n";
eval { confess('') };
my @stack = split m/\n/, $@;
shift @stack for 1..3;
my $stack = join "\n", @stack;
print STDERR $stack,"\n\n";
};
view release on metacpan or search on metacpan
lib/DBD/File.pm view on Meta::CPAN
#
# Parsing on our own similar to parse_dsn to find attributes in 'dbname' parameter.
if ($dbname) {
my $attr_hash = {
map { (m/^\s* (\S+) \s*(?: =>? | , )\s* (\S*) \s*$/x) }
split m/;/ => $dbname };
if (defined $attr_hash->{f_dir}) {
my $f_dir = $attr_hash->{f_dir};
# DSN escapes the : in Windows' path, which is not accepted by -d
# D\\:\\\\Test\\\\DBI-01\\\\test_output_12345
# -> D:\\\\Test\\\\DBI-01\\\\test_output_12345
lib/DBD/File.pm view on Meta::CPAN
$file eq "." || $file eq ".." and return; # XXX would break a possible DBD::Dir
# XXX now called without proving f_fqfn first ...
my ($ext, $req) = ("", 0);
if ($meta->{f_ext}) {
($ext, my $opt) = split m{/}, $meta->{f_ext};
if ($ext && $opt) {
$opt =~ m/r/i and $req = 1;
}
}
view release on metacpan or search on metacpan
lib/DBICx/Modeler.pm view on Meta::CPAN
# Hammatime: Don't touch this!
}
else {
if ($name =~ s/^\-//) {
# User wants the parent (wants to be a sibling)
my @class = split m/::/, $parent_class;
pop @class;
$parent_class = join '::', @class;
}
$name = $parent_class . '::' . $name;
}
lib/DBICx/Modeler.pm view on Meta::CPAN
sub _build__namespace_list {
my $self = shift;
my $class = ref $self || $self;
my $default_namespace = do {
my @default = split m/::/, $class;
if ( my $name = $self->sibling_namespace ) {
$name = "Model" if $name eq 1;
pop @default; # Use Example::${name} instead of Example::Modeler::${name} (e.g. Example::Model)
push @default, $name;
}
view release on metacpan or search on metacpan
lib/DBIx/JCL.pm view on Meta::CPAN
"h" => \$opt_help,
"ha" => \$opt_help_args,
) || _sys_help(0);
if ( $opt_connection ) {
foreach my $connectdef ( split m/,/, $opt_connection ) {
my ($db, $inst) = split m/:/, $connectdef;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
## update default connection data
$dbdefenvr{$db} = $inst;
}
}
lib/DBIx/JCL.pm view on Meta::CPAN
sys_die( "No job conf entry found for $entry in section $section" );
}
## construct a real hash from the pseudo hash
foreach my $item ( split "\n", $pseudo ) {
my ($key, $value) = split m/$delim/, $item;
$hash{$key} = $value;
}
return \%hash; ## ref to hash
}
lib/DBIx/JCL.pm view on Meta::CPAN
Returns:
=cut
my $target_opt = shift;
foreach my $option ( @ARGV ) {
my ($opt,$val) = split m/=/, $option;
$opt =~ s/^-\s*//x;
$opt =~ s/\s+$//x;
if ( $opt =~ m/^$target_opt$/ix ) {
return 1;
}
lib/DBIx/JCL.pm view on Meta::CPAN
## handle:
## >script.pl -r -- -batchsize=10
foreach my $option ( @ARGV ) {
$option =~ s/\s+=/=/x;
$option =~ s/=\s+/=/x;
my ($opt,$val) = split m/=/, $option;
$opt =~ s/^-\s*//x;
$opt =~ s/\s+$//x;
if ( $opt =~ m/^$target_opt$/ix ) {
#$val =~ s/^\s*//;
#$val =~ s/\s*$//;
lib/DBIx/JCL.pm view on Meta::CPAN
my $wait_action = $connect_params{wait_action} || 'fail';
my $retry_duration = $connect_params{retry_duration} || 0;
my $retry_max_secs = $connect_params{retry_max_secs} || 0;
if ( $vdn =~ m/:/x ) { ## vdn contains instance definiton
my ($db, $inst) = split m/:/, $vdn;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
$dbdefenvr{$db} = $inst; ## update default connection data
$vdn = $db; ## vdn gets true vdn
}
lib/DBIx/JCL.pm view on Meta::CPAN
=cut
my ($vdn, $sql, $longrlen) = @_;
$longrlen = 0 unless $longrlen;
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
if ( $sth_name eq 'sth_default' ) {
sys_die( 'Invalid statement handle name', 0 );
}
}
lib/DBIx/JCL.pm view on Meta::CPAN
=cut
my $vdn = shift;
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
}
return $dbhandles{$vdn}{$sth_name};
}
sub db_get_defenvr {
lib/DBIx/JCL.pm view on Meta::CPAN
if ( ref $vdn ) {
$sth = $vdn; ## received a raw sth
} else {
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) { ## dot notation vdn.sthn
($vdn, $sth_name) = split m/\./x, $vdn;
}
$sth = $dbhandles{$vdn}{$sth_name};
}
foreach my $colref ( @colrefs ) {
if ( ! ref $colref ) { sys_die( "Received bad ref in db_bindcols" ); }
lib/DBIx/JCL.pm view on Meta::CPAN
if ( ref $vdn ) {
$sth = $vdn; ## received a raw sth
} else {
my $sth_name = 'sth_default'; ## default statement handle name
if ( $vdn =~ m/\./x ) {
($vdn, $sth_name) = split m/\./x, $vdn;
}
$sth = $dbhandles{$vdn}{$sth_name};
}
return $sth->fetchrow_arrayref();
}
lib/DBIx/JCL.pm view on Meta::CPAN
log_info( "$lead Status [Test] Expected/Actual/Threshold(%)/Threshold(#)" );
## perform checkpoint tests
foreach my $chkpt ( split "\n", $checkpoints ) {
my ($param,$rest) = split m/=/, $chkpt;
my ($exp,$range) = split m/:/, $rest;
$param = _trim($param); ## col to check
$exp = _trim($exp); ## expected value
$range = _trim($range); ## range/tolerance
db_execute( $vdn, $param );
lib/DBIx/JCL.pm view on Meta::CPAN
$dbitrace_file = $dbitrace_base . '_' . $osuser . $log_ext;
}
$dbitrace_filefull = $path_log_dir.$dbitrace_file;
## load data structures
@databases = split m/,/, $conf_data{'databases'}{'databases'};
@dat_envrs = split m/,/, $conf_system{'system'}{'dat_envrs'};
@job_acros = split m/,/, $conf_system{'system'}{'job_acros'};
foreach my $db ( @databases ) {
$dbname{$db} = $conf_data{'names'}{$db};
}
foreach my $db ( @databases ) {
lib/DBIx/JCL.pm view on Meta::CPAN
}
foreach my $db ( @databases ) {
$dbinst{$db} = $conf_data{'instances'}{$db};
}
foreach my $db ( @databases ) {
foreach my $inst ( split m/,/, $conf_data{'instances'}{$db} ) {
$dbconn{$db}{$inst}{'netservice'} = $conf_data{"$db $inst"}{'netservice'};
$dbconn{$db}{$inst}{'database' } = $conf_data{"$db $inst"}{'database'};
$dbconn{$db}{$inst}{'username' } = $conf_data{"$db $inst"}{'username'};
$dbconn{$db}{$inst}{'password' } = $conf_data{"$db $inst"}{'password'};
}
lib/DBIx/JCL.pm view on Meta::CPAN
=cut
my $connections = shift;
## open dbi trace file
DBI->trace(1, $dbitrace_filefull );
foreach my $connectdef ( split m/,/, $connections ) {
my ($db, $inst) = split m/:/, $connectdef;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
my $database = $dbconn{$db}{$inst}{'database'};
my $username = $dbconn{$db}{$inst}{'username'};
my $password = $dbconn{$db}{$inst}{'password'};
print "Connecting to: $db/$inst\n";
lib/DBIx/JCL.pm view on Meta::CPAN
my $lvls_str = shift;
## levls_str can be either a single value or a comma delimited list
if ( $lvls_str =~ /,/ ) {
## received a list of severity levels
my @loglvls = split m/,/, $lvls_str;
foreach my $level ( @loglvls ) {
if ( $level !~ /FATAL|ERROR|WARN|INFO|DEBUG|NONE/ ) {
sys_die( 'Invalid logging/notification severity list', 0 );
}
}
lib/DBIx/JCL.pm view on Meta::CPAN
Returns:
=cut
my $params = shift;
my ($addrlist, $message) = split m/~/, $params;
$mail_emailto = $addrlist;
_log_send_mail($message, 'MESSAGE');
exit 0;
}
lib/DBIx/JCL.pm view on Meta::CPAN
Returns:
=cut
my $params = shift;
my ($addrlist, $message) = split m/~/, $params;
$mail_pagerto = $addrlist;
_log_send_page($message, 'MESSAGE');
exit 0;
}
lib/DBIx/JCL.pm view on Meta::CPAN
=cut
my $msg = shift;
my $trimmed = '';
if ( $msg =~ /\n/ms ) { ## trim leading spaces from multi-line messages
foreach my $m ( split m/\n/, $msg ) {
$m =~ s/^\s+//;
$trimmed .= $m."\n";
}
$trimmed =~ s/\n$//ms;
} else {
lib/DBIx/JCL.pm view on Meta::CPAN
}
my ($this_db, $this_inst);
if ( $vdn =~ m/:/x ) { ## does vdn contain explicit instance?
($this_db, $this_inst) = split m/:/, $vdn;
} else {
$this_db = $vdn;
$this_inst = $dbdefenvr{$vdn};
}
lib/DBIx/JCL.pm view on Meta::CPAN
my ($vdni) = shift;
my $netservice = '';
if ( $vdni =~ m/:/x ) { ## vdn contains instance definiton
my ($db, $inst) = split m/:/, $vdni;
_check_array_val( $db, \@databases )
|| sys_die( "Invalid database: [$db]", 0 );
_check_array_val( $inst, [split m/,/, $dbinst{$db}] )
|| sys_die( "Invalid database instance: [$db.$inst]", 0 );
$netservice = $dbconn{$db}{$inst}{netservice};
}
return $netservice;
lib/DBIx/JCL.pm view on Meta::CPAN
if ( defined $dbh && $dbh ) { $dbh->disconnect; }
}
## call plugin end functions
while ( my $pluginf = pop @plugins ) {
my ($pp, $pf, $pff) = split m/~/, $pluginf;
$pp->end();
}
## send completion notifications
unless ( defined $jobname ) { $jobname = '?'; }
view release on metacpan or search on metacpan
lib/DBIx/NoSQL/ClassScaffold.pm view on Meta::CPAN
sub deploy {
my $self = shift;
my $deployment_statements = $self->deployment_statements;
s/^\s*//, s/\s*$// for $deployment_statements;
my @deployment_statements = split m/;\n\s*/, $deployment_statements;
$self->store->storage->do( $_ ) for @deployment_statements;
}
package DBIx::NoSQL::ClassScaffold::ResultClass;
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
return $_[1];
};
}
{
map { my ($pk, $vr) = split m/\s/; build_requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
Test::Most
Directory::Scratch
_END_
map { my ($pk, $vr) = split m/\s/; requires $pk => $vr || 0 } grep { ! /^\s*#/ } split m/\n/, <<_END_;
Carp::Clan::Share
DBD::SQLite
Moose
Path::Class
SQL::Script
Template
_END_
}
if (-e 'inc/.author') {
my $all_from = join '/', 'lib', split m/-/, name . '.pm';
`perldoc -tF $all_from > README` if ! -e 'README' || (stat $all_from)[9] > (stat 'README')[9];
}
auto_install;