view release on metacpan or search on metacpan
sub _print_multi {
my ($self, $obj, $method_name, $prefix) = @_;
my $ret_value = $obj->$method_name;
my @ret_values = split m//ms, $ret_value;
my @ret;
my $not_coded = 0;
foreach my $process_ret_value (@ret_values) {
if ($process_ret_value eq ' ') {
next;
view release on metacpan or search on metacpan
lib/MIME/Structure.pm view on Meta::CPAN
return \%F;
}
sub parse_content_type {
my ($str) = @_;
my ($type, $subtype, $params_str) = split m{/|;\s*}, $str, 3;
return (lc $type, lc $subtype, parse_params($params_str));
}
sub parse_params {
my ($str) = @_;
view release on metacpan or search on metacpan
lib/MIME/Types.pm view on Meta::CPAN
my $section = $typedb{$1} or return;
my $record = $section->{$2} or return;
return $record if ref $record; # already extended
my $simple = $2;
my ($type, $ext, $enc, $char) = split m/\;/, $record;
my $os = undef; # XXX TODO
$section->{$simple} = MIME::Type->new(
type => $type,
extensions => [split /\,/, $ext],
lib/MIME/Types.pm view on Meta::CPAN
sub addType(@)
{ my $self = shift;
foreach my $type (@_)
{ my ($major, $minor) = split m!/!, $type->simplified;
$typedb{$major}{$minor} = $type;
$typedb{EXTENSIONS}{$_} = $type for $type->extensions;
}
$self;
}
view release on metacpan or search on metacpan
lib/MIME/Parser/Filer.pm view on Meta::CPAN
### Get the recommended name:
my $recommended = $head->recommended_filename;
### Get content type:
my ($type, $subtype) = split m{/}, $head->mime_type; $subtype ||= '';
### Get recommended extension, being quite conservative:
my $recommended_ext = (($recommended and ($recommended =~ m{(\.\w+)\Z}))
? $1
: undef);
view release on metacpan or search on metacpan
lib/MP3/M3U/Parser.pm view on Meta::CPAN
croak "Unknown parameter of type '$ref' passed to parse()";
}
my $cd;
if ( ! $ref ) {
my @tmp = split m{[\\/]}xms, $file;
($cd = pop @tmp) =~ s{ [.] m3u }{}xmsi;
}
my $this_file = $ref ? 'ANON'.$self->{ANON}++ : $self->_locate_file($file);
lib/MP3/M3U/Parser.pm view on Meta::CPAN
my($fh, @fh);
if ( $ref eq 'GLOB' ) {
$fh = $file;
}
elsif ( $ref eq 'SCALAR' ) {
@fh = split m{\n}xms, ${$file};
}
else {
# Open the file to parse:
require IO::File;
$fh = IO::File->new;
lib/MP3/M3U/Parser.pm view on Meta::CPAN
# and remove leading and trailing spaces
# Some artist names can also have a "-" in it.
# For this reason; require that the data has " - " in it.
# ... but the spaces can be one or more.
# So, things like "artist-song" does not work...
my($artist, @xsong) = split m{\s{1,}-\s{1,}}xms, $i->[ID3] || $i->[PATH];
if ( $artist ) {
$artist = $self->_trim( $artist );
$artist =~ s{.*[\\/]}{}xms; # remove path junk
$i->[ARTIST] = $artist;
}
lib/MP3/M3U/Parser.pm view on Meta::CPAN
next if ! $m3u; # Record may be blank if it is not a disk file.
$#{$dkey->[$index]} = MAXDATA; # For the absence of EXTINF line.
# If the extra information exists, parse it:
if ( $m3u =~ RE_INF_HEADER ) {
my($j, $sec, @song);
($j ,@song) = split m{\,}xms, $m3u;
($j ,$sec) = split m{:}xms, $j;
$temp_sec = $sec;
$ttime += $sec;
$dkey->[$index][ID3] = join q{,}, @song;
$dkey->[$index][LEN] = $self->_seconds($sec || 0);
$taver++;
view release on metacpan or search on metacpan
examples/extract-y.pl view on Meta::CPAN
#my $unknown = 0;
while (<$fh>) {
next if /###/;
#s,^(?= // ), "?" . ++$unknown ,e;
chomp;
my ($op, $d, $n) = split m( // ), $_, 3;
$n or $no_name or die "unexpected: <$_>";
process_opus_year $op, $d, \%seen, \%no;
}
# close $codm or die;
(\%seen, \%no)
examples/extract-y.pl view on Meta::CPAN
my $fn = shift;
open my $f, '<', $fn or die "error opening $fn for read";
my %ys;
while (<$f>) {
next if /^##/;
my @fields = split m( // ), $_, 4;
@fields == 4 or warn "<$_>";
$ys{$fields[0]} = $fields[2];
}
close $f or die "error closing $fn for read";
fix_year \*ARGV, \%ys;
exit 0;
} elsif ($how eq 'merge') {
my (@seen, %seen_a, %seen);
my @ids = split m(/), shift;
my @f = @ARGV;
my $c = 0;
for my $f (@f) {
@ARGV = $f;
my $sub_seen = extract_years $how, \*ARGV;
view release on metacpan or search on metacpan
lib/MVC/Neaf/Route/Main.pm view on Meta::CPAN
defined $content
or $self->my_croak( "Failed load content" );
# TODO 0.40 The regex should be: ^@@\s+(/\S+(?:\s+\w+=\S+)*)\s*$
# but we must deprecate '[TT] foo.html' first
my @parts = split m{^@@\s+(\S.*?)\s*$}m, $content, -1;
shift @parts;
confess "NEAF load_resources failed unexpectedly, file a bug in MVC::Neaf"
if @parts % 2;
my %templates;
view release on metacpan or search on metacpan
lib/Mac/Finder/Tags/Impl/mdls.pm view on Meta::CPAN
method get_tags ($path) {
return my @empty if not stat $path; # dangling symlinks etc.
$path =~ s/([\\"])/\\$1/g;
my $md = `mdls -name kMDItemFSLabel -name kMDItemUserTags -raw "$path"`;
my @md = split m/,?\n\s*/, decode_cesu8($md);
my $label = substr shift(@md), 0, 1;
pop @md;
my @tags;
if (@md == 1) {
@tags = ( Mac::Finder::Tags::Tag->new( name => trim($md[0]), color => $label ) );
view release on metacpan or search on metacpan
lib/Mail/Abuse/Filter/IP.pm view on Meta::CPAN
# {
# $rep->config->{&WITHIN} = [ $rep->config->{&WITHIN} ];
# }
$self->within([]);
for my $ip (map { new NetAddr::IP $_ }
split m/[\s,]+/, $rep->config->{&WITHIN})
{
unless ($ip)
{
die "Filter::IP: Please check your '", &WITHIN,
"' clause for errors\n";
view release on metacpan or search on metacpan
lib/Mail/Address/Tagged.pm view on Meta::CPAN
$self->_set_type($type);
$self->_set_sender($arg{sender});
if ($type eq 'confirm') {
my ($keyword, $date, $pid, $mac) = split m#\.#, $data;
$self->set_keyword($keyword);
$self->_set_candidate_time($date);
$self->_set_candidate_pid($pid);
$self->_set_candidate_mac($mac);
} elsif ($type eq 'dated') {
my ($date, $mac) = split m#\.#, $data;
$self->_set_candidate_time($date);
$self->_set_candidate_mac($mac);
} else {
$self->_set_candidate_mac($data);
view release on metacpan or search on metacpan
lib/Mail/Server/IMAP4/Fetch.pm view on Meta::CPAN
sub fetchBody($)
{ my ($self, $extended) = @_;
my $type = uc $self->{type};
my ($mediatype, $subtype) = split m[/], $type;
if($self->{parts})
{ # Multipart message
# WARNING: no blanks between part descriptions
my $parts = join '', map $_->fetchBody($extended), @{$self->{parts}};
view release on metacpan or search on metacpan
lib/Mail/Box/Mbox.pm view on Meta::CPAN
sub folderToFilename($$;$)
{ my ($thingy, $name, $folderdir, $extension) = @_;
$extension ||= ref $thingy ? $thingy->subfolderExtension : $default_sub_extension;
$name =~ s#^=#$folderdir/#;
my @parts = split m!/!, $name;
my $real = shift @parts;
$real = '/' if $real eq '';
if(@parts)
view release on metacpan or search on metacpan
t/01-basic.t view on Meta::CPAN
# feed DKIM-Signature into iterator
my ($dksig,$rest) = $mail =~m{\A
(DKIM-Signature:.*(?:\n[ \t].*)*\n)
((?s).*)
}x or die "split mail";
my @t = $dmarc->next($dksig);
check_result(\@t,[
undef,
'D'
]);
view release on metacpan or search on metacpan
lib/Mail/Message/Field.pm view on Meta::CPAN
# remove comments
my $r = '';
my $in_dquotes = 0;
my $open_paren = 0;
my @s = split m/([()"])/, $string;
while(@s)
{ my $s = shift @s;
if(CORE::length($r)&& substr($r, -1) eq "\\") { $r .= $s }
elsif($s eq '"') { $in_dquotes = not $in_dquotes; $r .= $s }
view release on metacpan or search on metacpan
Miner/Attachment.pm view on Meta::CPAN
my $content_type = shift;
# We're only using this for the generation of file names, so the
# directory we feed it is irrelevant.
my $filer = MIME::Parser::FileInto->new("/tmp");
# This code borrowed from MIME::Parser::Filer
my ($type, $subtype) = split m{/}, $content_type;
$subtype ||= '';
my $ext = ($filer->{MPF_Ext}{"$type/$subtype"} ||
$filer->{MPF_Ext}{"$type/*"} ||
$filer->{MPF_Ext}{"*/*"} ||
".dat");
view release on metacpan or search on metacpan
lib/Mail/Outlook/Folder.pm view on Meta::CPAN
sub new {
my ($self, $outlook, $foldername) = @_;
my ($mailbox,$folder,$path);
# split mailbox and path
($foldername,$path) = ($foldername =~ m!(.*?)/(.*)!)
if ($foldername =~ m!/!);
# mailbox name
if($foldernames{$foldername}) {
view release on metacpan or search on metacpan
lib/Mail/Pyzor/Digest/Pieces.pm view on Meta::CPAN
items to be returned in scalar context.
=cut
sub splitlines {
return split m<\r\n?|\n>, $_[0];
}
1;
view release on metacpan or search on metacpan
lib/Mail/SpamAssassin/Pyzor/Digest/Pieces.pm view on Meta::CPAN
items to be returned in scalar context.
=cut
sub splitlines {
return split m<\r\n?|\n>, $_[0] if defined $_[0];
}
1;
view release on metacpan or search on metacpan
lib/Mail/Cap.pm view on Meta::CPAN
return $self->{_cache}{$origtype}
if $useCache && exists $self->{_cache}{$origtype};
my ($fulltype, @params) = split /\s*;\s*/, $origtype;
my ($type, $subtype) = split m[/], $fulltype, 2;
$subtype ||= '';
my $entry;
foreach (@{$self->{"$type/$subtype"}}, @{$self->{"$type/*"}})
{ if(exists $_->{'test'})
lib/Mail/Cap.pm view on Meta::CPAN
{ my ($self, $text, $type, $file) = @_;
defined $type or return $text;
defined $file or $file = "";
my ($fulltype, @params) = split /\s*;\s*/, $type;
($type, my $subtype) = split m[/], $fulltype, 2;
my %params;
foreach (@params)
{ my($key, $val) = split /\s*=\s*/, $_, 2;
$params{$key} = $val;
view release on metacpan or search on metacpan
lib/MakeWithPerl.pm view on Meta::CPAN
if (! -e $file) # No such file
{confess "No such file:\n$file"
}
if ($search) # Upload files to GitHub or run some other action defined in the containing folder hierarchy unless search is forbidden
{my @d = split m{/}, $file; # Split file name
pop @d;
while(@d) # Look for a folder that contains a push command
{for my $n(qw(pushToGitHub upload package))
{my $u = "/".fpe(@d, $n, q(pl));
if (-e $u)
view release on metacpan or search on metacpan
lib/Map/Metro.pm view on Meta::CPAN
my $self = shift;
my $string = shift;
return $string if $string !~ m{[A-Z]};
return join '_' => map {
join ('_' => map { lc } grep { length } split m{([A-Z]{1}[^A-Z]*)})
} split '::' => $string;
}
sub parse {
my $self = shift;
view release on metacpan or search on metacpan
foreach my $node (values %{$self->{'tube'}->nodes}) {
$self->{'callback_vertex'}->($self, $node);
}
my @processed;
foreach my $node (values %{$self->{'tube'}->nodes}) {
foreach my $link (split m/,/ms, $node->link) {
if (none {
($_->[0] eq $node->id && $_->[1] eq $link)
||
($_->[0] eq $link && $_->[1] eq $node->id)
} @processed) {
view release on metacpan or search on metacpan
GraphViz.pm view on Meta::CPAN
$self->{'callback_node'}->($self, $node);
$node_cache_hr->{$node->id} = $node;
}
my @processed;
foreach my $node (values %{$self->{'tube'}->nodes}) {
foreach my $link (split m/,/ms, $node->link) {
if (none {
($_->[0] eq $node->id && $_->[1] eq $link)
||
($_->[0] eq $link && $_->[1] eq $node->id)
} @processed) {
view release on metacpan or search on metacpan
foreach my $node_name (sort keys %{$nodes_hr}) {
if (@{$nodes_hr->{$node_name}->line} > 1) {
# Get data.
my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
split m/,/ms, $nodes_hr->{$node_name}->link;
my $data_ar = [
$nodes_hr->{$node_name}->name,
(join ', ', map { $_->name } @{$nodes_hr->{$node_name}->line}),
(join ', ', sort @links),
];
if (any { $_ eq $line } map { $_->name }
@{$nodes_hr->{$node_name}->line}) {
# Get data.
my @links = map { $self->{'tube'}->get_node_by_id($_)->name }
split m/,/ms, $nodes_hr->{$node_name}->link;
my $data_ar = [
$nodes_hr->{$node_name}->name,
(join ', ', sort @links),
];
if ($self->{'print_id'}) {
view release on metacpan or search on metacpan
lib/Mariachi.pm view on Meta::CPAN
for ( keys %touched_dates ) {
my @mails = sort {
$a->epoch_date <=> $b->epoch_date
} @{ $dates{$_} };
my @depth = split m!/!;
$self->generate_pages( 'date.tt2', "$_/index.html",
archive_date => $_,
content => \@mails,
base => "../" x @depth,
perpage => 20,
view release on metacpan or search on metacpan
t/90-simd-equivalence.t view on Meta::CPAN
# Big files if present.
for my $f (glob("$FindBin::Bin/../bench/corpus/*.md")) {
open my $fh, '<:raw', $f or next;
local $/;
push @samples, { name => "corpus:" . (split m{/}, $f)[-1], md => scalar <$fh> };
}
# Spec test inputs (CommonMark + GFM) — these are the gold standard for
# coverage of weird edge cases.
for my $j ("$FindBin::Bin/data/commonmark-spec.json",
view release on metacpan or search on metacpan
etc/pod_links.pl view on Meta::CPAN
my %headers = ();
for my $pod_file (@pod_files) {
my (undef, $dir, $file) = File::Spec->splitpath($pod_file);
my @dirs = grep { $_; } File::Spec->splitdir($dir);
my ($base, $ext) = split m/[.]/xms, $file;
my $pod_name = join '::', qw(Marpa R2), @dirs, $base;
# say $pod_name;
my $tree = Pod::Simple::SimpleTree->new->parse_file($pod_file)->root;
find_header($tree, $pod_name);
}
view release on metacpan or search on metacpan
lib/Math/Numerical.pm view on Meta::CPAN
Readonly my $DEFAULT_OUTWARD_FACTOR => 1.6;
sub _create_bracket_inward_state ($x1, $x2, $f1, %params) {
my $s = {ret => undef};
$s->{split} = $params{inward_split} // $DEFAULT_INWARD_SPLIT;
croak 'inward_split must be at least 2' if $s->{split} < 2;
$s->{factor} = $params{inward_factor} // $DEFAULT_INWARD_FACTOR;
croak 'inward_factor must be at least 2' if $s->{factor} < 2;
@{$s}{'x1', 'x2'} = ($x1, $x2);
$s->{f1} = $f1;
lock_keys(%{$s});
view release on metacpan or search on metacpan
auto-dbg/auto-debug-module.pl view on Meta::CPAN
my $lldb = `lldb --version` unless $gdb or $dbx; # untested
$dbx = `dbxtool -V` and $dbxname = 'dbxtool' unless $gdb or $dbx or $lldb;
sub find_candidates () {
my($sep, @cand) = quotemeta $Config{path_sep};
for my $dir (split m($sep), ($ENV{PATH} || '')) {
for my $f (<$dir/*>) {
push @cand, $f if $f =~ m{dbx|gdb|lldb}i and -x $f;
}
}
warn 'Possible candidates for debuggers: {{{'. join('}}} {{{', @cand), '}}}' if @cand;
view release on metacpan or search on metacpan
devel/rationals-tree.pl view on Meta::CPAN
require Math::BigRat;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
# ?(1/3)=1/4 ?(1/2)=1/2 ?(2/3)=3/4
foreach my $xy ('1/3', '1/2', '2/3') {
my ($x,$y) = split m{/}, $xy;
try ($x,$y);
}
foreach my $n ($path->n_start .. 64) {
my ($x,$y) = $path->n_to_xy($n);
try ($x,$y);
}
foreach my $xy ('1/3', '1/2', '2/3') {
my ($x,$y) = split m{/}, $xy;
try ($x,$y);
}
sub try {
my ($x,$y) = @_;