view release on metacpan or search on metacpan
t/line-numbers.t view on Meta::CPAN
=cut
my $snippet = $examples->named("as_data multiple blocks return")
->as_code();
my @sniplines = split m/\n/, $snippet;
my $linemarkup = shift @sniplines;
ok((my ($line, $file) = $linemarkup =~ m/^#line (\d+) "(.*)"$/),
"line numbering markup found at the top")
or die "no markup line found, rest of the test is pointless";
like($file, qr/Pod.*Snippets/, "file name OK");
t/line-numbers.t view on Meta::CPAN
($INC{"Pod/Snippets.pm"},
-markup => "metatests",
-named_snippets => "strict",
-line => 42);
@sniplines = split m/\n/,
$examples_offset->named("as_data multiple blocks return")
->as_code();
ok((my ($offsetline, undef) = $sniplines[0] =~ m/^#line (\d+) "(.*)"$/),
"line numbering markup found at the top");
is($offsetline, $line + 41, "line offset feature");
view release on metacpan or search on metacpan
lib/Pod/Tree/HTML.pm view on Meta::CPAN
}
$node1 or return undef; ##no critic (ProhibitExplicitReturnUndef)
my $text = $node1->get_deep_text;
($title) = split m(\s+-), $text;
$title or return undef; ##no critic (ProhibitExplicitReturnUndef)
$title =~ s(\s+$)();
$title;
view release on metacpan or search on metacpan
t/has-version.t view on Meta::CPAN
use File::Spec ();
{
my $text = _slurp(
File::Spec->catfile(
File::Spec->curdir, split m#/#, "lib/Pod/Weaver/PluginBundle/SHLOMIF.pm"
)
);
my $ver;
view release on metacpan or search on metacpan
lib/Pod/Webserver/Source.pm view on Meta::CPAN
package Pod::Webserver::Source;
# $Id: Source.pm,v 1.1 2005/01/05 12:26:39 cwest Exp $
use strict;
use vars qw[$LINK_PATH $PERLTIDY_ARGV $VERSION];
$PERLTIDY_ARGV = [qw[-html -npod -nnn]];
$VERSION = sprintf "%d.%02d", split m/\./, (qw$Revision: 1.1 $)[1];
sub _serve_thing {
my ($self, $conn, $req) = @_;
return $conn->send_error(405) unless $req->method eq 'GET'; # sanity
view release on metacpan or search on metacpan
lib/Pod/WordML.pm view on Meta::CPAN
my $self = shift;
# get rid of all but one trailing newline
$self->{'scratch'} =~ s/\s+\z//;
chomp( my @lines = split m/^/m, $self->{'scratch'} );
$self->{'scratch'} = '';
@lines = map { s/</</g; $_ } @lines;
if( @lines == 1 )
view release on metacpan or search on metacpan
# Output any pending index entries, and optionally an index entry given as
# an argument. Support multiple index entries in X<> separated by slashes,
# and strip special escapes from index entries.
sub outindex {
my ($self, $section, $index) = @_;
my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} };
return unless ($section || @entries);
$$self{INDEX} = [];
my $output;
if (@entries) {
my $output = '.INDEX '
view release on metacpan or search on metacpan
The value 0777 will cause Perl to slurp files whole since there is no
legal character with that value.
=item B<-a>
turns on autosplit mode when used with a B<-n> or B<-p>. An implicit
split command to the @F array is done as the first thing inside the
implicit while loop produced by the B<-n> or B<-p>.
perl -ane 'print pop(@F), "\n";'
view release on metacpan or search on metacpan
lib/Podcast/ESLPodcast/Splitter.pm view on Meta::CPAN
You can listen to these dialogs as you like.
This module works as follows.
1. fetch a XML feed for the ESLPodcast.
2. parse XML and extract duration information and mp3 file URIs.
3. split mp3 files according to the duration information.
=head1 INTERFACE
$splitter->run
do mentioned above
view release on metacpan or search on metacpan
lib/PostScript/CDCover.pm view on Meta::CPAN
sub add_directory {
my ($self, $path) = @_;
$path =~ s|^[/\\]||;
my ($head, $rest) = split m|[/\\]|, $path, 2;
my $dir = $self->directory($head);
$dir->add_directory($rest) if $rest;
}
# Add a file somewhere in the subtree. If the file does not belong to the
lib/PostScript/CDCover.pm view on Meta::CPAN
sub add_file {
my ($self, $path) = @_;
$path =~ s|^[/\\]||;
my ($head, $rest) = split m|[/\\]|, $path, 2;
if ( $rest ) {
$self->directory($head)->add_file($rest);
}
else {
push @{$self->{_files}}, $head;
view release on metacpan or search on metacpan
Graph/XY.pm view on Meta::CPAN
$opts = $o->{opt}{style} unless (defined $opts);
$opts->{line} = {} unless (defined $opts->{line});
$opts->{point} = {} unless (defined $opts->{point});
$style = new PostScript::Graph::Style($opts) unless (defined $style);
## split multi-columns into seperate lines
my $name = $o->{default}++;
my ($first, @rest) = split_data($data);
foreach my $column (@rest) {
$o->line_from_array($column, $opts);
}
view release on metacpan or search on metacpan
lib/Preprocess/Ops.pm view on Meta::CPAN
}
sub printData($$) #P Print statement
{my ($lineNumber, $line) = @_; # Code line number, code line
my ($command, @w) = split m/\s+/, $line; # Parse print line
my @f;
for my $w(@w) # Each variable to be printed
{push @f, join ' ', $w, "=", $w =~ m((\A|\.|\->)[i-n]) ? "%lu" : "%s";
}
my $f = join " ", @f;
lib/Preprocess/Ops.pm view on Meta::CPAN
my $d = $c =~ s(//.*\Z) ()gsr; # Without trailing comment
if ($c =~ m(\Ainclude)) # Expand include files so that we can pull in code and structures from other files in the includes folder.
{push @c, &includeFile($i, $file, $cFile, $hFile, $d);
}
elsif ($c =~ m(\Aexports\s)) # Add exports from included package if named in the include list
{my ($command, $name, @exports) = split m/\s+/, $d; # Export command, list name, exports in list
if ($items{qq(:$name)}) # Requested this list
{for my $e(@exports) # Add exports unless they have been excluded
{$items{$e} ++ unless $items{qq(!$e)};
}
}
view release on metacpan or search on metacpan
Prima/sys/FS.pm view on Meta::CPAN
push @matches, $pwent[7] . $2;
}
} elsif ( $q =~ m/(?<!\\)\*|\?/ ) {
my @paths = ('');
my $expanded;
for my $subpath ( split m{(/)}, $q ) {
if ( !$expanded && $subpath =~ m/(?<!\\)\*|\?/ ) {
$subpath =~ s/(?<!\\)\*/.*/g;
$subpath =~ s/(?<!\\)\?/./g;
$subpath = qr/$subpath/;
next MATCH unless Prima::sys::FS::opendir( my $dh, length($paths[0]) ? $paths[0] : '.' );
view release on metacpan or search on metacpan
lib/Print/Indented/Handle.pm view on Meta::CPAN
my ($pkg, $filename, $nr) = caller;
if (any { $pkg =~ $_ } $self->packages_re) {
my $line = (path($filename)->lines)[$nr-1];
my ($indent) = $line =~ /^(\s*)/;
foreach (grep length, split m<(.*$/?)>, join('', @args)) {
print { $self->original_fh } "$indent$_";
}
} else {
# do not indent
print { $self->original_fh } @args;
view release on metacpan or search on metacpan
lib/Proc/InvokeEditor.pm view on Meta::CPAN
);
} else {
($result) = _edit($arg, \@DEFAULT_EDITORS, 1, 0, undef, $suff);
}
if (wantarray) {
my @result = split m|$/|, $result;
return @result;
} else {
return $result;
}
}
view release on metacpan or search on metacpan
lib/Proc/Hevy/Reader.pm view on Meta::CPAN
else {
my $scratch = ( defined $self->{scratch} ? $self->{scratch} : '' ) . $data;
if( defined $/ ) {
while( index( $scratch, $/ ) != -1 ) {
( my $line, $scratch ) = split m#$/#, $scratch, 2;
$self->_flush( $line );
}
}
$self->{scratch} = length $scratch ? $scratch : undef;
view release on metacpan or search on metacpan
$^X =~ m|([^/]+)$|;
($me = $1) =~ s/\.exe$//;
}
}
my $cols = delete($ENV{'COLUMNS'}); # prevents `ps` from wrapping
my @ps = split m|$/|, qx/ps -fp $pid/
|| die "ps utility not available: $!";
s/^\s+// for @ps; # leading spaces confuse us
$ENV{'COLUMNS'} = $cols if defined($cols);
no warnings; # hate that deprecated @_ thing
view release on metacpan or search on metacpan
lib/Protocol/BitTorrent/Metainfo.pm view on Meta::CPAN
$self->{info}{name} = $self->root_path;
$self->{info}{files} = [];
foreach my $file ($self->files) {
push @{ $self->{info}{files} }, {
'length' => $file->{length},
'path' => [ split m{/}, $file->{name} ],
}
}
}
}
return $self->{info};
view release on metacpan or search on metacpan
lib/Protocol/DBus/Address.pm view on Meta::CPAN
my $xport = substr( $_, 0, 1 + index($_, ':'), q<> );
chop $xport;
my %kvs = (
map { split m<=>, $_ } (split m<,>, $_),
);
s<%(..)><chr hex $1>ge for values %kvs;
bless { _str => $str, _transport => $xport, _attrs => \%kvs }, __PACKAGE__;
} ( split m<;>, $_[0] );
}
#----------------------------------------------------------------------
sub transport {
view release on metacpan or search on metacpan
lib/Net/Gearman/Worker.pm view on Meta::CPAN
$worker->can_do( 'sum' );
while(1) {
my $job = $worker->grab_job->get;
my $total = sum split m/,/, $job->arg;
$job->complete( $total );
}
=head1 DESCRIPTION
view release on metacpan or search on metacpan
lib/Protocol/IRC/Client.pm view on Meta::CPAN
my $verb = $message->arg(1);
my %hints = (
%$hints,
verb => $verb,
caps => { map { $_ => 1 } split m/ /, $message->arg(2) },
);
$self->invoke( "on_message_cap_$verb", $message, \%hints ) and $hints{handled} = 1;
$self->invoke( "on_message_cap", $verb, $message, \%hints ) and $hints{handled} = 1;
view release on metacpan or search on metacpan
lib/Protocol/Tus/Util.pm view on Meta::CPAN
sub validate_checksum ($dref, $chk) {
return unless defined($chk);
$chk =~ s{\A\s+|\s+\z}{}gmxs;
my ($type, $expected) = split m{\s+}mxs, $chk, 2;
ouch 400, 'Bad Request, unsupported checksum algorithm'
if ($type // '') ne 'sha1';
$expected //= '';
my $got = sha1_base64($$dref);
view release on metacpan or search on metacpan
lib/Prty/ApplicationPaths.pm view on Meta::CPAN
}
# HomeDir bestimmen, indem wir das Programm und $depth
# Verzeichnisse darüber vom Pfad entfernen
my @path = split m|/|,$path;
splice @path,-($depth+1);
my $homeDir = join '/',@path;
# <application> ist die letzte Pfadkomponente
view release on metacpan or search on metacpan
lib/QRCode/Encoder/Matrix.pm view on Meta::CPAN
my $i = 0;
my @queue;
return sub {
if (! @queue) {
if ($i < $n_expanded) {
push @queue, split m{}mxs, unpack 'B*', substr($data->{expanded}, $i++, 1);
}
else {
push @queue, ('0') x $rem;
$rem = 0;
}
lib/QRCode/Encoder/Matrix.pm view on Meta::CPAN
# adjacences
my @contributions =
map { $_ - 2 }
grep { $_ >= 5 }
map { length }
split m{(0+)}mxs, $seq;
$penalty += sum(@contributions) if @contributions;
# 000011311 | 113110000
my @matches = $seq =~ m{
(
view release on metacpan or search on metacpan
qtgui/examples/network/network-chat/PeerManager.pm view on Meta::CPAN
my $environment = Qt::Process::systemEnvironment();
foreach my $string ( @envVariables ) {
my $index = first_index{ $_ =~ m/$string/ } @{$environment};
if ($index != -1) {
my @stringList = split m/=/, $environment->[$index];
if (scalar @stringList == 2) {
utf8::decode($stringList[1]);
this->{username} = Qt::ByteArray($stringList[1]);
last;
}
qtgui/examples/network/network-chat/PeerManager.pm view on Meta::CPAN
if (broadcastSocket()->readDatagram(\$datagram, $datagramSize,
$senderIp, \$senderPort) == -1) {
next;
}
my @list = split m/@/, $datagram;
if (scalar @list != 2) {
next;
}
my $senderServerPort = $list[1];
view release on metacpan or search on metacpan
qtcore/src/doxsubpp.pl view on Meta::CPAN
my ($xsubppdir) = map{ m/^XSUBPPDIR = (.*)/ } grep{ m/^XSUBPPDIR =/ } @xsubinfo;
my $xsubpp = "$xsubppdir/xsubpp";
my ($xsubppargs) = map{ m/^XSUBPPARGS = (.*)/ } grep{ m/^XSUBPPARGS =/ } @xsubinfo;
my @xsubppargs = split m/ /, $xsubppargs;
my @cmd = ($perl, $xsubpp, @xsubppargs, $in);
my $xsubpp_gencode = `@cmd`;
my $status = $? >> 8;
if ( $status != 0 ){
view release on metacpan or search on metacpan
lib/Quiq/ApplicationPaths.pm view on Meta::CPAN
}
# HomeDir bestimmen, indem wir das Programm und $depth
# Verzeichnisse darüber vom Pfad entfernen
my @path = split m|/|,$path;
splice @path,-($depth+1);
my $homeDir = join '/',@path;
# <application> ist die letzte Pfadkomponente
view release on metacpan or search on metacpan
t/lib/Test/HTTP/Server.pm view on Meta::CPAN
);
$self->{out_headers} = { %default_headers };
my $req = $self->{request}->[1];
$req =~ s#^/##;
my @args = map { uri_unescape $_ } split m#/#, $req;
my $func = shift @args;
$func = "index" unless defined $func and length $func;
my $body;
eval {
view release on metacpan or search on metacpan
lib/REST/Application/Routes.pm view on Meta::CPAN
# the keys is a URI template, see if the current path info matches that
# template. Save the parent matches for passing into the handler.
for my $template (keys %{ $self->resourceHooks() }) {
my $regex = join "\\/",
map {/^:/ ? '([^\/]+)' : quotemeta $_}
split m{/}, $template;
$regex = "^(?:$regex)\\/?\$";
if ($self->checkMatch($path, $regex)) {
$self->{__last_match_pattern} = $template;
%vars = $self->getTemplateVars($template);
$handler = $self->_getHandlerFromHook($template);
lib/REST/Application/Routes.pm view on Meta::CPAN
}
sub getTemplateVars {
my ($self, $route) = @_;
my @matches = $self->_getLastRegexMatches();
my @vars = map {s/^://; $_} grep /^:/, split m{/}, $route;
return map { $vars[$_] => $matches[$_] } (0 .. scalar(@matches)-1);
}
sub getLastMatchTemplate {
my $self = shift;
view release on metacpan or search on metacpan
t/json_utf8.t view on Meta::CPAN
my $not_connected = connect($TEST_SERVER,$user,$pass);
diag "Test server unavailable (".$not_connected->message.") : tests skipped" if $not_connected;
sub to_hex ($) {
join ' ', map { sprintf "%02x", ord $_ } split m//, shift;
}
SKIP : {
skip 'no local connection to neo4j', 37 if $not_connected;
view release on metacpan or search on metacpan
lib/REST/Utils.pm view on Meta::CPAN
# "*" Turn it into a legal wildcard.
if ( $full_type eq q{*} ) {
$full_type = q{*/*};
}
my ( $type, $subtype ) = split m{/}msx, $full_type;
return _strip($type), _strip($subtype), \%params;
}
=head3 quality($mime_type, $ranges)