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;
view release on metacpan or search on metacpan
DataLoader/MapIt.pm view on Meta::CPAN
my $temp="/tmp";
=pod
## just messing around here disreguard for now
if($filename !~ /\</){
my @fname=split m[/], $filename;
my $file=pop @fname;
my $temp="/tmp/".$file.".map";
open(TMP, ">$temp")||die "could not open temp $temp $@";
use Data::Dumper;
#$Data::Dumper::Purity=1;
view release on metacpan or search on metacpan
t/52_memory_leak.t view on Meta::CPAN
return "$i-@k";
}
sub mem {
open my $in, "/proc/$$/statm" or return 0;
my $line = [ split m/\s+/, <$in> ];
close $in;
return $line->[shift];
}
view release on metacpan or search on metacpan
lib/DNS/Unbound.pm view on Meta::CPAN
use constant _ctx_err => {
(
map { $_ => _ub_strerror($_) }
map { __PACKAGE__->can($_)->() }
split m<\s+>, _ERROR_NAMES_STR()
)
};
#----------------------------------------------------------------------
view release on metacpan or search on metacpan
lib/Dallycot/Library/Core/Strings.pm view on Meta::CPAN
if($max_count) {
if ( $max_count->isa('Dallycot::Value::Numeric') ) {
$count = $max_count->value->numify;
}
else {
croak 'Limit for string-split must be numeric';
}
}
if($patt -> isa('Dallycot::Value::String')) {
if($count) {
@bits = split($patt -> value, $source, $count);
lib/Dallycot/Library/Core/Strings.pm view on Meta::CPAN
else {
@bits = split($patt -> value, $source);
}
}
else {
croak 'Pattern for string-split must be a string';
}
}
return Dallycot::Value::Vector->new(
map {
Dallycot::Value::String->new($_, $string->lang)
view release on metacpan or search on metacpan
lib/Dancer/Plugin/CRUD.pm view on Meta::CPAN
register(
wrap => sub($$$) {
my ( $action, $route, $coderef ) = @_;
my @route = grep { defined and length } split m{/+}, $route;
my $parent = @$stack ? $stack->[-1] : undef;
foreach my $route (@route) {
push @$stack => { resname => $route };
}
view release on metacpan or search on metacpan
lib/Dancer/Plugin/DirectoryView.pm view on Meta::CPAN
);
for my $name (sort { $a cmp $b } @entries) {
my $file = catfile($real_path, $name);
my $url = $name;
$url = join '/', map { uri_escape($_) } split m!/!, $url;
my $is_dir = -d $file;
my @stat = stat(_);
if ($is_dir) {
view release on metacpan or search on metacpan
bin/index-filesystem.pl view on Meta::CPAN
# munge the title so we get magic completion for document titles:
# This should be mostly done in an Elasticsearch filter+analyzer combo
# Except for bands/song titles, which we want to manually munge
my @parts = map {lc $_}
((split /\s+/, $msg->{title}),
(split m![\\/]!, $msg->{url}));
$msg->{title_suggest} = {
input => \@parts,
#output => $msg->{title},
# Maybe some payload to directly link to the document. Later
view release on metacpan or search on metacpan
Author: Naveed Massjouni <naveedm9@gmail.com>
Date : 2016-05-25 12:03:37 +0000
Merge pull request #16 from SysPete/plugin2
split multiple-schemas tests into two
Change: a5293666d05c6d1445ede9137962e21c85dbc31e
Author: Peter Mottram (SysPete) <peter@sysnix.com>
Date : 2016-04-09 15:57:59 +0000
split multiple-schemas tests into two
Plugin2's config attribute is immutable and so config cannot be
changed after using plugin during runtime.
-------------------------------------------
view release on metacpan or search on metacpan
lib/Dancer2/Plugin/OpenAPIRoutes.pm view on Meta::CPAN
keys %{ $paths->{$_} }
]
)
}
sort { ## no critic (BuiltinFunctions::RequireSimpleSortBlock)
my @a = split m{/}, $a;
my @b = split m{/}, $b;
@b <=> @a;
}
grep { !/^x-/ && 'HASH' eq ref $paths->{$_} }
keys %{$paths};
#>>>
lib/Dancer2/Plugin/OpenAPIRoutes.pm view on Meta::CPAN
my $p = $paths[$i];
my $ma = $paths[$i + 1];
my $m;
my $mn = @$ma;
if ($mn == 1 && !exists $paths{$p}) {
my @p = split m{/}, $p;
if (@p > 2) {
$m = pop @p;
}
$p = join "/", @p;
}
lib/Dancer2/Plugin/OpenAPIRoutes.pm view on Meta::CPAN
sub _path_to_fqfn {
my ($config, $schema, $path_spec, $method) = @_;
my $paths = $schema->{paths};
my $module_name;
my $func = $paths->{$path_spec}{$method}{'x-path-map'}{func};
my @pwsr = split m{/}, $paths->{$path_spec}{$method}{'x-path-map'}{module_path};
$module_name = join "::", map {_path2mod $_ } @pwsr;
if ($http_methods_func_map{"$method:$path_spec"}) {
my ($mf, $mm) = split /:/, $http_methods_func_map{"$method:$path_spec"}, 2;
$func = $mf if $mf;
$module_name = $mm if $mm;
view release on metacpan or search on metacpan
share/assets/dash_renderer/dash_renderer.dev.js view on Meta::CPAN
requiresPrefixDashCased = Object.keys(requiresPrefix).map(function (prop) {
return (0, _hyphenateProperty2.default)(prop);
});
}
// only split multi values, not cubic beziers
var multipleValues = value.split(/,(?![^()]*(?:\([^()]*\))?\))/g);
requiresPrefixDashCased.forEach(function (prop) {
multipleValues.forEach(function (val, index) {
if (val.indexOf(prop) > -1 && prop !== 'order') {
share/assets/dash_renderer/dash_renderer.dev.js view on Meta::CPAN
function prefixValue(value, propertyPrefixMap) {
if ((0, _isPrefixedValue2.default)(value)) {
return value;
}
// only split multi values, not cubic beziers
var multipleValues = value.split(/,(?![^()]*(?:\([^()]*\))?\))/g);
for (var i = 0, len = multipleValues.length; i < len; ++i) {
var singleValue = multipleValues[i];
var values = [singleValue];
view release on metacpan or search on metacpan
0.20 2014-12-10 Released-By: PERLANCAR
- No functional changes.
- Use new name of renamed/split module SHARYANTO::String::Util ->
String::LineNumber & String::PerlQuote.
0.19 2014-11-13 Released-By: PERLANCAR
view release on metacpan or search on metacpan
0.20 2014-12-10 Released-By: PERLANCAR
- No functional changes.
- Use new name of renamed/split module SHARYANTO::String::Util ->
String::LineNumber & String::PerlQuote.
0.19 2014-11-13 Released-By: PERLANCAR
view release on metacpan or search on metacpan
t/01always_pass.t view on Meta::CPAN
my ($module, $version) = @_;
defined $version or $version = eval "require $module; $module->VERSION";
defined $version or return warn sprintf " %-30s undef\n", $module;
my ($major, $rest) = split m{ \. }mx, $version;
return warn sprintf " %-30s % 4d.%s\n", $module, $major, $rest;
}
sub diag_env {
view release on metacpan or search on metacpan
lib/Data/Context.pm view on Meta::CPAN
my ( $self, $path ) = @_;
# TODO add some cache controls here or in ::Instance::init();
return $self->instance_cache->{$path} if $self->instance_cache->{$path};
my @path = split m{/+}xms, $path;
shift @path if !defined $path[0] || $path[0] eq '';
push @path, 'index' if $path =~ m{/$}xms;
my $count = 1;
my $loader;
view release on metacpan or search on metacpan
lib/Data/Edit/Xml/Lint.pm view on Meta::CPAN
sub read($) #S Reread a linted xml L<file|/file> and extract the L<attributes|/Attributes> associated with the L<lint|/lint>
{my ($file) = @_; # File containing xml
my $s = readFile($file); # Read xml from file
my %a = $s =~ m/<!--(\w+):\s+(.+?)\s+-->/igs; # Get attributes
my @a = split m/\n/, $s; # Split into lines
my $l = {}; # Reconstructed labels
for(@a) # Each source line
{if (/<!--labels:\s+(.+?)\s+-->/gs) # Labels line
{my ($w) = my @w = split /\s+/, $1; # Id, labels
view release on metacpan or search on metacpan
lib/Data/Edit/Xml/To/DitaVb.pm view on Meta::CPAN
}
sub chunkFile($) #P Chunk a file name to make it more readable
{my ($file) = @_; # File to chunk
my $f = swapFilePrefix($file, home); # Remove common prefix
join " <big><b>/</b></big> ", split m(/), $f; # Chunk the file name to make it more readable
}
sub copyFilesToWeb2 #P Copy files into position so that they can be web served
{return if develop;
my $client = client;
lib/Data/Edit/Xml/To/DitaVb.pm view on Meta::CPAN
join q(), @s;
}->($S);
my $H = sub # Expand hrefs
{my ($text) = @_;
my @hrefs = split m((?= href="[^"]+)), $text;
for my $h(@hrefs)
{if ($h =~ m(\A href="([^"]+)"(.*)\Z)s)
{my $hrefFile = $1;
my $rest = $2;
my $F = absFromAbsPlusRel($file, $hrefFile);
view release on metacpan or search on metacpan
lib/Data/Edit/Xml/Xref.pm view on Meta::CPAN
undef # Failed
};
my $fixRelRef = sub # Attempt to fix a reference broken by relocation
{my ($R, $rest) = split m(#)s, $ref, 2; # Get referenced file name
if ($R)
{my $r = fne($R); # Href file base name
if (my $F = $xref->baseFiles->{$r}) # Relocated else where
{my @targets = sort keys(%$F); # Relocation targets
if (@targets == 1) # Just one such relocation
lib/Data/Edit/Xml/Xref.pm view on Meta::CPAN
{my ($tag, $lineLocation) = @{$xref->guidHrefs->{$file}{$href}}; # Tag of node and location in source file of node doing the referencing
# 2019.08.29 The following line does not appear to be needed - it is happening to late to affect anything
$xref->fixRefs->{$file}{$href}++ unless $xref->fixRefs->{$file}{$href}; # Avoid double counting - all guid hrefs will be fixed if we are fixing hrefs as both good and bad will fail.
if ($href =~ m(#)) # Href with #
{my ($guid, $topic, $id) = split m(#|\/), $href, 3; # Guid, topic, remainder
my $targetFile = $guidToFile{$guid}; # Locate file defining guid
if (!defined $targetFile) # No definition of this guid
{push @bad, # Report missing guid
["No such guid defined", $tag, $href, $lineLocation, q(),
lib/Data/Edit/Xml/Xref.pm view on Meta::CPAN
my $t = &$makeNavTitle($n);
push @m, qq(<subjectHead id="$n" navtitle="$t">);
my %c; # Normalize all the othermeta
for my $content(sort keys $o{$n}->%*)
{for my $c(split m(\s+)s, $content)
{$c{$c}++
}
}
for my $c(sort keys %c) # Write the normalized othermeta
{my $t = &$makeNavTitle($c);
view release on metacpan or search on metacpan
lib/Data/Edit/Xml.pm view on Meta::CPAN
.q(<span class="xmlGt">></span>)
."\n";
return $r if $depth; # Return from sub tree
my $h = join "\n", map {qq(<div class="xmlLine">$_</div>)} split m/\n/, $r; # Wrap div around each line
qq($h\n)
}
sub prettyStringHtml($@) # Return a string of L<html> representing a node of a L<parse|/parse> tree and all the nodes below it if the node is in the specified context.
{my ($node, @context) = @_; # Node, optional context
lib/Data/Edit/Xml.pm view on Meta::CPAN
#D1 Location # Locate the line numbers and columns of a specified node and write that information as a L<Oxygen Message|/https://www.oxygenxml.com/doc/versions/20.1/ug-author/topics/l...
sub parseLineLocation($) #PS Parse a line location
{my ($loc) = @_; # Location
my ($l, $c, $L, $C) = split m/[.:]/, $loc; # Position of node in source
for my $n($l, $c, $L) # Check that some-one else is not using xtrf for some other reason
{return () unless $n and $n =~ m(\A\d+\Z)s;
}
return () if $L and $L !~ m(\A\d+\Z)s;
lib/Data/Edit/Xml.pm view on Meta::CPAN
sub checkAllPaths($) #S Create a representation of all the paths permitted in a block of L<xml>. The syntax of each line is a word representing an L<xml> tag followed by one of: tag B<1 * + ?...
{my ($valid) = @_; # Path descriptions
my %valid; # Perl representation of validating string
my @stack; # Tag stack
my @lines = split m/\n/, $valid; # Split into lines
for my $i(keys @lines) # Each line
{my $line = $lines[$i] =~ s(\s*#.*\Z) ()r; # Remove trailing comments
next unless $line =~ m(\S); # Ignore blank lines
lib/Data/Edit/Xml.pm view on Meta::CPAN
next;
}
last;
}
my ($tagName, @words) = split m/\s+/, $tag; # Save tag on the tag stack
push @stack, $tagName;
my $count = sub # The count indicator optionally follows the tag
{return 1 unless @words; # The default is just one and it is required
my $c = shift @words;
lib/Data/Edit/Xml.pm view on Meta::CPAN
my ($root) = @stack; # The root tag
for my $a(sort keys %valid) # Create get methods
{for my $b(sort keys %valid)
{my $c = $valid{$b}[0]; # Count field
my @b = split m/\s+/, $b;
my $m = pop @b;
if ($a eq join " ", @b or !@b) # Has children
{my @m = ($root, @b);
if (!isSubInPackage((join '::', @m), $m))
{my $d = $c eq q(*) || $c eq q(+) ? q([]) : q/q()/; # Default return value
lib/Data/Edit/Xml.pm view on Meta::CPAN
});
for my $v(sort keys %$validator) # Validate presence of required elements by checking the application of each rule which requires at least one sub element
{my ($count) = $$validator{$v}->@*; # Count specification from this validation specification
next unless $count =~ m(\A[1+]\Z)i; # We are only interested in required elements
my @path = split m/\s+/, $v; # Path to this rule
my $parent = join ' ', reverse $xmlTree->tag, @path[0..@path-2]; # Path to parent of this rule
$xmlTree->by(sub # Traverse xml to build Perl data structure
{my ($o) = @_;
if ($parent eq $o->context) # Point in the xml parse tree that matches the parent rule
view release on metacpan or search on metacpan
t/fake-meta.t view on Meta::CPAN
}
# fake_metacategory() picks one theme at random
{
my $metacategory = fake_metacategory();
my ($theme) = split m:/:, $metacategory->();
# same theme each time
for ( 1 .. $count ) {
my $category = $metacategory->();
like( $category, qr{^$theme(?:/|$)}, "$category belongs to $theme" );
t/fake-meta.t view on Meta::CPAN
my $metacategory = fake_metacategory( fake_metatheme() );
my @categories;
push @categories, $metacategory->()
until @categories >= $count && $categories[-1] =~ m:/:;
for my $category ( splice @categories, -$count ) {
my ($theme) = split m:/:, $category;
like( $category, qr{^$theme(?:/|$)}, "$category belongs to $theme" );
}
done_testing;
view release on metacpan or search on metacpan
0.11 2014-12-10 (PERLANCAR)
- No functional changes.
- Use new name of renamed/split module SHARYANTO::String::Util ->
String::LineNumber.
0.10 2014-02-14 (SHARYANTO)
view release on metacpan or search on metacpan
0.08 2014-12-10 (PERLANCAR)
- No functional changes.
- Use new name of renamed/split module SHARYANTO::String::Util ->
String::LineNumber.
0.07 2014-02-14 (SHARYANTO)
view release on metacpan or search on metacpan
lib/Data/Hash/Diff/Smart/Engine.pm view on Meta::CPAN
next;
}
# String rule: check for wildcard
if ($r =~ /\*/) {
my @parts = grep { length $_ } split m{/}, $r;
push @rules, { type => 'wildcard', parts => \@parts };
}
else {
push @rules, { type => 'exact', path => $r };
}
lib/Data/Hash/Diff/Smart/Engine.pm view on Meta::CPAN
sub _is_ignored {
my ($path, $rules) = @_;
return 0 unless $rules && @$rules;
# Split current path into parts
my @path_parts = grep { length $_ } split m{/}, $path;
RULE:
for my $rule (@$rules) {
if ($rule->{type} eq 'exact') {
view release on metacpan or search on metacpan
lib/Data/Hash/Patch/Smart/Engine.pm view on Meta::CPAN
sub _split_path {
my $path = $_[0];
return () if !defined $path || $path eq '';
my @parts = grep { length $_ } split m{/}, $path;
return @parts;
}
# Walk down the structure following the given path segments,
# stopping at the parent of the leaf. In strict mode, we die on