view release on metacpan or search on metacpan
bin/plx-packed view on Meta::CPAN
$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
use 5.008001;use strict;package Parse::CPAN::Meta;our$VERSION='1.4414';use Exporter;use Carp 'croak';our@ISA=qw/Exporter/;our@EXPORT_OK=qw/Load LoadFile/;sub load_file {my ($class,$filename)=@_;my$meta=_slurp($filename);if ($filename =~ /\.ya?ml$...
PARSE_CPAN_META
$fatpacked{"Parse/PMFile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_PMFILE';
package Parse::PMFile;sub __clean_eval {eval $_[0]}use strict;use warnings;use Safe;use JSON::PP ();use Dumpvalue;use version ();use File::Spec ();our$VERSION='0.36';our$VERBOSE=0;our$ALLOW_DEV_VERSION=0;our$FORK=0;our$UNSAFE=$] < 5.010000 ? 1 : ...
read the file. It issued the following error: C< $err->{r} >},);$errors{$package}={open=>$err->{r},infile=>$pp->{infile},}}else {$pp->{version}="undef";$self->_verbose(1,qq{Parse::PMFile was not able to
parse the following line in that file: C< $err->{line} >
Note: the indexer is running in a Safe compartement and cannot
provide the full functionality of perl in the VERSION line. It
view release on metacpan or search on metacpan
}
}
# add path r from v to p.
sub grow {
my ($p, $v, $r) = @_;
my @d = split m|/|, $r;
my $f = pop @d;
for (@d) {
$p->{$_} = {%{$v->{$_}},
c => {}} if not $p->{$_};
$p = $p->{$_}{c}, $v = $v->{$_}{c};
my $r = shift;
if ($r =~ m{^/}) {
die c(RR, "Absolute path $r not prefixed by $s->{root}"), ".\n" unless 0 == index $r, $s->{root};
$r = substr $r, length $s->{root};
}
my ($d, @p) = (0, split m{/}, $r);
{subr => sub {
my $o = shift;
if ($o->{event} eq 'ent') {
my $u = $d >= @p || $o->{ent} eq $p[$d];
$d += 1 if $u and $o->{db}{c};
view release on metacpan or search on metacpan
}
}
FILE: foreach my $filename ( sort keys %{ content( \%Defaults ) } ) {
my @path = split m|\Q$Defaults{dir_sep}|, $filename;
my $file = catfile( $Defaults{directory}, @path );
$show_message->( "Checking for file [$filename]... " );
if( -e $file ) { $show_message->( "already exists\n" ); next FILE }
view release on metacpan or search on metacpan
lib/App/sdview.pm view on Meta::CPAN
if( -f( my $configpath = "$ENV{HOME}/.sdviewrc" ) ) {
App::sdview::Style->load_config( $configpath );
}
my %output_options = map {
map { m/^(.*?)=(.*)$/ ? ( $1 => $2 ) : ( $_ => !!1 ) } split m/,/, $_;
} $output_options->@*;
my $parser_class;
if( defined $format ) {
view release on metacpan or search on metacpan
script/sitelen-mute view on Meta::CPAN
# extracting title and description from a string containing newlines
sub cap_from_str {
my ($title, $desc) = @_;
return unless $title;
($title, $desc) = split m{\n+}, $title unless $desc;
return [cap_clean($title), cap_clean($desc)];
}
# extracting title and description from a properties hash reference
sub cap_from_props {
script/sitelen-mute view on Meta::CPAN
rename("$absFtmp.tmp", $absFtmp);
}
# generate main image
my @sfile = ($props{ImageWidth}, $props{ImageHeight});
my @simg = split m{\n+}, sys('convert', '-quiet', $absFtmp,
'-gamma', '0.454545',
'-geometry', "$maxfull[0]x$maxfull[1]>",
'-print', '%w\n%h',
'-gamma', '2.2',
'+profile', '!icc,*',
script/sitelen-mute view on Meta::CPAN
);
# face/center detection
my @center = (0.5, 0.5);
if ($facedet) {
my @f = split m{\n+}, sys("facedetect", "--best", "--center", catfile($absOut, $fimg));
for (@f) {
if (my @tmp = /(\d+) (\d+) (\d+) (\d+)/) {
@center = ($tmp[0] / $simg[0], $tmp[1] / $simg[1]);
last;
}
view release on metacpan or search on metacpan
push @opt, $_;
}
close $of;
}
}
foreach my $opt (split m/[:;]/ => $ENV{IVRC} || "") {
$opt =~ s{^[-/]?(\S+\s*=\s*\S.*)}{$1} or next;
push @opt, $opt;
}
while (@ARGV && $ARGV[0] =~ s{^[-/]?(\S+\s*=\s*\S.*)}{$1}) {
push @opt, shift @ARGV;
}
for (@opt) {
m/^(\S+)\s*=\s*(\S.*)/ or next;
my ($opt, $val) = (lc $1, $2);
$opt =~ m/^keys_/ and $val = [ split m/\s+/, $val ];
$Option{$opt} = $val;
}
}
foreach my $k (grep m/^keys_/ => keys %Option) {
s/^<?(.*?)>?$/<$1>/ for @{$Option{$k}};
$w->createText (5, 35,
-anchor => "nw",
-fill => $Option{exifinfocolor},
-font => $Option{smallfont},
-text => join ("\x{00b7}" =>
map { join " " => map { ucfirst lc $_ } split m/\s+/ => $_ }
grep m/\S/, map { $ei->{$_} // "" }
"Make", # Nikon
"Model", # Coolpix S9700
"DeviceType", # Cell Phone
"FileSource", # Digital Camera
view release on metacpan or search on metacpan
lib/App/tmclean.pm view on Meta::CPAN
die "failed to execute `tmutil listbackups`: $?\n";
}
# e.g. /Volumes/Time Machine Backup/Backups.backupdb/$machine/2018-01-07-033608
return grep {
chomp;
my @paths = split m!/!, $_;
my $backup_date = eval { Time::Piece->strptime($paths[-1], '%Y-%m-%d-%H%M%S') };
$backup_date && $self->before_tp > $backup_date;
} @backups;
}
lib/App/tmclean.pm view on Meta::CPAN
}->();
}
sub dev_name {
my $path = shift;
my @paths = split m!/!, $path;
join '/', @paths[0..2];
}
sub machine_name {
my $self = shift;
view release on metacpan or search on metacpan
lib/App/wmiirc/Dwim.pm view on Meta::CPAN
system config("commands", "browser") . " '$action'&";
} elsif($action =~ m{^[\w.+-]+@}) {
$action =~ s/\@$//; # so I can type foo@ but it gets parsed properly
system config("commands", "mail") . " '$action'&";
} else {
my($host, $rest) = split m{/}, $action, 2;
if(exists $aliases{$host}) {
system config("commands", "browser") . " '" .
sprintf($aliases{$host}, uri_escape_utf8 "$rest@args") . "'&";
# TODO: Use IO::Async's lookup code for non-blocking here
view release on metacpan or search on metacpan
lib/Earabic.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
# Allow historic support for dashless bundled options
# tar cvf file.tar
# is valid (GNU) tar style
@ARGV && $ARGV[0] =~ m/^[DdcvzthxIC]+[fT]?$/ and
unshift @ARGV, map { "-$_" } split m// => shift @ARGV;
my $opts = {};
getopts('Ddcvzthxf:ICT:', $opts) or die usage();
### show the help message ###
die usage() if $opts->{h};
view release on metacpan or search on metacpan
lib/Ask/Zenity.pm view on Meta::CPAN
sub file_selection {
my $self = shift;
my $text = readline( $self->_zenity( file_selection => @_ )->stdout );
chomp $text;
my @files = map path( $_ ), split m#[|]#, $text;
@files == 1 ? $files[0] : @files;
}
sub single_choice {
my ( $self, %o ) = @_;
lib/Ask/Zenity.pm view on Meta::CPAN
'--hide-column=2',
'--text', $o{text},
map { ( $subsequent++ ? 'FALSE' : 'TRUE' ), @$_ } @{ $o{choices} },
);
chomp( my $line = readline( $zen->stdout ) );
split m{\|}, $line;
} #/ sub _choice
1;
__END__
view release on metacpan or search on metacpan
lib/Atompub/MediaType.pm view on Meta::CPAN
);
sub new {
my($class, $arg) = @_;
my $media_type = $ATOM_TYPE{$arg} || $arg or return;
my($type, $subtype, $param) = split m{[/;]}, $media_type;
bless {
type => $type,
subtype => $subtype,
parameters => $param,
}, $class;
view release on metacpan or search on metacpan
lib/Attribute/Storage.pm view on Meta::CPAN
my ( $pkg, $ref, undef, $opts ) = @_;
my $attrs = _get_attr_hash( $ref, 1 );
my %type;
foreach ( split m/\s*,\s*/, $opts ) {
m/^(?:CODE|SCALAR|ARRAY|HASH)$/ and
( $type{lc $_} = 1 ), next;
m/^RAWDATA$/ and
( $type{raw} = 1 ), next;
view release on metacpan or search on metacpan
lib/Authen/SASL/Perl/NTLM.pm view on Meta::CPAN
my $user = $self->_call('user');
# Check for the domain in the username
my $domain;
( $domain, $user ) = split m{ \\ }xms, $user
if index( $user, q{\\} ) > -1;
$self->{ntlm} = Authen::NTLM->new(
host => $self->host,
domain => $domain,
view release on metacpan or search on metacpan
t/lib/Schema/RBAC/ResultSet/Page.pm view on Meta::CPAN
=cut
sub retrieve_pages_from_path {
my ( $self, $path, $get_all_pages ) = @_;
my $nodes = [ split m%/%, $path ];
$$nodes[0] = '/';
my $lasted_obj;
my (@not_found, @all_pages);
my $parent_id = 0; # page /
view release on metacpan or search on metacpan
t/02AutoSplit.t view on Meta::CPAN
# Assumption: no characters in arguments need escaping from the shell or perl
my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))");
print "# command: $com\n";
# There may be a way to capture STDOUT without spawning a child process, but
# it's probably worthwhile spawning, as it ensures that nothing in AutoSplit
# can load functions from split modules into this perl.
my $output = `$com`;
warn "Exit status $? from running: >>$com<<" if $?;
return $output;
}
view release on metacpan or search on metacpan
my $s = uc $s;
my ($out) = $s . "\n" if $style;
my $token;
my @tokens = split m:/:, $s;
while ($token = shift @tokens) {
my ($element, $value) = ('', '');
if (($element, $value) = split / /, $token, 2) {
if (exists $abb_pirep{$element}) {
view release on metacpan or search on metacpan
doc/OLD_CHANGES.md view on Meta::CPAN
# Changes between 0.561 and 0.57:
* stylistic changes to symbolic constant stuff
* handled scope in `s///e` replacement code
* added unquote option for expanding `""` into concats, etc.
* split method and proto parts of `pp_entersub` into separate functions
* various minor cleanups
# Changes after 0.57:
* added parens in `\&foo` (patch by Albert Dvornik)
view release on metacpan or search on metacpan
lib/BPM/Engine/Store/ResultRole/ActivityInstanceJoin.pm view on Meta::CPAN
if($status{active}) {
return 0;
}
# completed, is_split, blocked transition path
elsif($status{completed} && scalar(keys %status) == 1) {
# OR-split should be blocked, XOR split missed this transition by definition
if($upstream_act->is_or_split) {
my $blocked = 0;
foreach my $ai(@ai) {
$blocked++ if &$split_blocked($ai, $down_trans);
}
view release on metacpan or search on metacpan
lib/Beagle/Cmd/Command/publish.pm view on Meta::CPAN
my $self = shift;
my $link = shift or die 'need a link';
my $file = shift;
$file = $link unless defined $file;
$file =~ s!^/!!;
$file = encode( locale_fs => catfile( split m{/}, $file ) );
my $res = $app->(
{
'PATH_INFO' => $link,
'REQUEST_METHOD' => 'GET',
view release on metacpan or search on metacpan
lib/Beam/Wire.pm view on Meta::CPAN
my ( $self, $name, %override ) = @_;
; print STDERR "Get service: $name\n" if DEBUG;
if ( index( $name, q{/} ) != -1 ) {
my ( $container_name, $service_name ) = split m{/}, $name, 2;
my $container = $self->get( $container_name );
# This could be a Beam::Wire container, or it could be a plain hashref.
# If it's a hashref, we can automatically create a container and then use it.
if (ref $container eq 'HASH' && !(blessed $container and $container->isa('Beam::Wire'))) {
lib/Beam/Wire.pm view on Meta::CPAN
# This was named set() before I started using Perl::Critic, and will
# continue to be named set() now that I no longer use Perl::Critic
sub set {
my ( $self, $name, $service ) = @_;
if ( $name =~ q{/} ) {
my ( $container_name, $service_name ) = split m{/}, $name, 2;
return $self->get( $container_name )->set( $service_name, $service );
}
$self->services->{$name} = $service;
return;
}
lib/Beam/Wire.pm view on Meta::CPAN
#pod =cut
sub get_config {
my ( $self, $name ) = @_;
if ( $name =~ q{/} ) {
my ( $container_name, $service ) = split m{/}, $name, 2;
my %inner_config = %{ $self->get( $container_name )->get_config( $service ) };
# Fix relative references to prefix the container name
my ( $fixed_config ) = $self->fix_refs( $container_name, \%inner_config );
return $fixed_config;
}
view release on metacpan or search on metacpan
share/PerlCritic/Critic/Annotation.pm view on Meta::CPAN
# Compose the specified modules into a regex alternation. Wrap each
# in a no-capturing group to permit "|" in the modules specification.
my @policy_name_patterns = grep { $_ ne $EMPTY }
split m{\s *[,\s] \s*}xms, $patterns_string;
my $re = join $PIPE, map {"(?:$_)"} @policy_name_patterns;
my @site_policy_names = Perl::Critic::PolicyFactory::site_policy_names();
@disabled_policy_names = grep {m/$re/ixms} @site_policy_names;
# It is possible that the Policy patterns listed in the annotation do not
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
exit print $usage unless $ARGV[0] ;
exit print $help if $ARGV[0] eq '--help' ;
exit print $usage unless -f $ARGV[0] ;
my @path = split m|/|, $ARGV[0] ;
exit print $usage unless $path[-1] eq 'db_config.h' ;
pop @path ;
pop @path ;
view release on metacpan or search on metacpan
lib/Ebig5.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
lib/Ebig5hkscs.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
lib/Bio/AutomatedAnnotation/Prokka.pm view on Meta::CPAN
if (m/^>(\S+)/) {
$sid = $1;
next;
}
my @x = split m/\s+/;
next unless @x == 5 and $x[0] =~ m/^\d+$/;
# and $x[4] =~ m/^\([ATCG]{3}\)$/i;
#$self->msg($_);
$self->msg("@x");
lib/Bio/AutomatedAnnotation/Prokka.pm view on Meta::CPAN
$self->msg("Running: $cmd");
my $tool = "SignalP:" . $tools{signalp}->{VERSION};
my $num_sigpep = 0;
open SIGNALP, "$cmd |";
while (<SIGNALP>) {
my @x = split m/\s+/;
if ( $sigpver == 3 ) {
next unless @x == 7 and $x[6] eq 'Y'; # has sig_pep
my $parent = $cds{ $x[0] };
my $prob = $x[5];
my $cleave = $x[3];
lib/Bio/AutomatedAnnotation/Prokka.pm view on Meta::CPAN
my $bls = Bio::SearchIO->new( -file => "$tempdir/$pid.seq.out", -format => $db->{FMT}, -version => $db->{VERSION} );
my $res = $bls->next_result or next;
my $hit = $res->next_hit or next;
my ( $prod, $gene, $EC ) = ( $hit->description, '', '' );
if ( $prod =~ m/~~~/ ) {
( $EC, $gene, $prod ) = split m/~~~/, $prod;
$EC =~ s/n\d+/-/g; # collapse transitionary EC numbers
}
my $cleanprod = $prod;
if ( $self->cleanup_prod ) {
view release on metacpan or search on metacpan
lib/Bio/BioStudio/BLAST.pm view on Meta::CPAN
{
open (my $BLASTINDEX, '<', $indexpath)
|| croak "BS_ERROR: Can't open BLAST index $indexpath : $OS_ERROR";
my $indexref = do {local $/ = <$BLASTINDEX>};
close $BLASTINDEX;
my @indexkeys = split m{\s}, $indexref;
%index = map {$_ => 1} @indexkeys;
}
return \%index;
}
view release on metacpan or search on metacpan
lib/Bio/Das/ProServer.pm view on Meta::CPAN
my @coordfull;
while (my $blk = <$fh_coord>) {
$blk =~ s{^\s*(<\?xml.*?>)?(\s*</?DASCOORDINATESYSTEM>\s*)?}{}mixs;
$blk =~ s/\s*$//mxs;
push @coordfull, grep { $_ }
split m{</COORDINATES>}mxs, $blk;
}
close $fh_coord or croak "Unable to close coordinates file $coordfile";
my %coords;
for (@coordfull) {
view release on metacpan or search on metacpan
lib/Bio/EnsEMBL/Mapper.pm view on Meta::CPAN
Arg 4 int $strand
raw contig orientation (+/- 1)
Arg 5 int $type
nature of transform - gives the type of
coordinates to be transformed *from*
Function inferior map method. Will only do ungapped unsplit mapping.
Will return id, start, end strand in a list.
Returntype list of results
Exceptions none
Caller Bio::EnsEMBL::AssemblyMapper
view release on metacpan or search on metacpan
lib/Bio/FeatureIO/ptt.pm view on Meta::CPAN
my $self = shift;
$self->mode eq 'r' || return; # returns if can't read next_feature when we're in write mode
my $line = $self->_readline() or return; # returns if end of file, no more features?
chomp $line;
my @col = split m/\t/, $line;
@col==$NUM_COL or $self->throw("Too many columns for PTT line");
$col[0] =~ m/(\d+)\.\.(\d+)/ or $self->throw("Invalid location (column 1)");
my $feat = Bio::SeqFeature::Generic->new(-start=>$1, -end=>$2, -primary=>'CDS');
$col[1] =~ m/^([+-])$/ or $self->throw("Invalid strand (column 2)");