view release on metacpan or search on metacpan
lib/Nagios/Plugin/OverHTTP/Formatter/Nagios/Auto.pm view on Meta::CPAN
# Look for the formatter
VERSION:
foreach my $version (@nagios_versions) {
# Split the version into the different dot parts
my @parts = split m{\.}msx, $version;
VERSION_PART:
while (@parts) {
# Construct version to check for
my $check_for_version = join q{.}, @parts;
view release on metacpan or search on metacpan
lib/Neo4j/Driver/Net/HTTP/LWP.pm view on Meta::CPAN
}
sub fetch_event {
my ($self) = @_;
$self->{buffer} = [grep { length } split m/\n|\x{1e}/, $self->fetch_all] unless defined $self->{buffer};
return shift @{$self->{buffer}};
}
sub fetch_all {
view release on metacpan or search on metacpan
t/jolt-mime.t view on Meta::CPAN
my (%params) = @_;
my $echo_plugin = Neo4j_Test::EchoHTTP->new(neo4j_version => $params{neo4j_version});
my $d = Neo4j::Driver->new('http:')->plugin($echo_plugin);
$d->{config}->{jolt} = $params{jolt}; # deprecated/internal option
my $r = $d->session->run('echo')->single;
my @accept = split m/\s*,\s*/, $r->get('accept');
}
sub in_or_diag {
my ($mime_type, $accept, $test, $negate) = @_;
view release on metacpan or search on metacpan
lib/Net/ACME/X.pm view on Meta::CPAN
sub create {
my ( $type, @args ) = @_;
my $x_package = "Net::ACME::X::$type";
my $x_pkg_path = File::Spec->catfile( split m<::>, $x_package ) . '.pm';
require $x_pkg_path;
return $x_package->new(@args);
}
view release on metacpan or search on metacpan
lib/Net/ACME2/Challenge/http_01/Handler.pm view on Meta::CPAN
my @missing = grep { !defined $opts{$_} } @required;
die "Missing: [@missing]" if @missing;
-d $opts{'document_root'} or die "Document root “$opts{'document_root'}†doesn’t exist!";
my @relpath = split m</>, $opts{'challenge'}->path();
my $file_path = File::Spec->catdir(
$opts{'document_root'},
@relpath,
);
view release on metacpan or search on metacpan
lib/Net/Abuse/Utils.pm view on Meta::CPAN
# Separate fields and order by netmask length
# 23028 | 216.90.108.0/24 | US | arin | 1998-09-25
# 701 1239 3549 3561 7132 | 216.90.108.0/24 | US | arin | 1998-09-25
for my $asinfo (@$data) {
$asinfo = { data => [ split m/ ?\| ?/, $asinfo ] };
$asinfo->{length} = ( split m|/|, $asinfo->{data}[1] )[1];
}
$data = [ map { $_->{data} }
reverse sort { $a->{length} <=> $b->{length} } @$data ];
return $data;
view release on metacpan or search on metacpan
lib/Net/Async/HTTP/Server/Request.pm view on Meta::CPAN
{
my $self = shift;
my ( $data ) = @_;
unless( defined $self->{response_status_line} ) {
( $self->{response_status_line} ) = split m/$CRLF/, $data;
}
return if $self->{is_closed};
$self->{is_done} and croak "This request has already been completed";
lib/Net/Async/HTTP/Server/Request.pm view on Meta::CPAN
sub response_status_code
{
my $self = shift;
my $line = $self->{response_status_line} or return undef;
return +( split m/ /, $line )[1];
}
# For metrics
sub bytes_written
{
view release on metacpan or search on metacpan
examples/PUT.pl view on Meta::CPAN
]
);
# Default is no protocol, we insist on HTTP/1.1 here, PUT probably requires that as a minimum anyway
$req->protocol( 'HTTP/1.1' );
$req->authorization_basic( split m/:/, $userpass, 2 ) if defined $userpass;
$req->content_length( $size );
# For stats
my $total = 0;
my $last = -1;
view release on metacpan or search on metacpan
examples/client.pl view on Meta::CPAN
on_message => sub {
my ( $self, $command, $message, $hints ) = @_;
return if $hints->{handled};
printf "<<%s>>: %s\n", $command, join( " ", $message->args );
print "| $_\n" for split m/\n/, pp( $hints );
return 1;
},
use_caps => [
( $USE_SASL ? "sasl" : () ),
view release on metacpan or search on metacpan
lib/Net/Async/Matrix/Room.pm view on Meta::CPAN
my $member = $state->member( $new_event->{sender} );
my $type = $new_event->{type};
$type =~ m/^m\.room\.(.*)$/;
my $method = $1 ? "_handle_state_event_" . join( "_", split m/\./, $1 ) : undef;
if( $method and my $code = $self->can( $method ) ) {
$self->$code( $member, $new_event, $state, %changes );
}
else {
view release on metacpan or search on metacpan
lib/Net/Async/Tangence/Client.pm view on Meta::CPAN
my $f;
if( $scheme eq "exec" ) {
# $query will contain args to exec - split them on +
$f = $self->connect_exec( [ $path, split m/\+/, $query ], %args );
}
elsif( $scheme eq "tcp" ) {
$f = $self->connect_tcp( $authority, %args );
}
elsif( $scheme eq "unix" ) {
view release on metacpan or search on metacpan
examples/s3-cat view on Meta::CPAN
my %config = do {
open my $rc, "<", ".s3rc" or die "Cannot read .s3rc config - $!\n";
map { chomp; m/^(.*?)=(.*)$/ } <$rc>;
};
my ( $bucket, $prefix ) = split m{/}, ( $config{bucket} || die "Could not find 'bucket' in config\n" ), 2;
my $s3 = Net::Async::Webservice::S3->new(
access_key => ( $config{access_key} || die "Could not find 'access_key' in config\n" ),
secret_key => ( $config{secret_key} || die "Could not find 'secret_key' in config\n" ),
ssl => $config{ssl},
bucket => $bucket,
view release on metacpan or search on metacpan
lib/Net/BitTorrent/Torrent/Generator.pm view on Meta::CPAN
my $info = { name => path($base_path)->basename, 'piece length' => $piece_length, private => $private, };
if ( @files == 1 && !$files[0]{padding} ) {
$info->{length} = $files[0]{size};
}
else {
$info->{files} = [ map { { length => $_->{size}, path => [ split m{/}, $_->{rel} ] } } @files ];
}
return $info;
}
method _wrap_torrent ( $info, $piece_layers = undef ) {
lib/Net/BitTorrent/Torrent/Generator.pm view on Meta::CPAN
my $fh = $file->{abs}->openr_raw;
my $block_idx = 0;
while ( read( $fh, my $block, 16384 ) ) {
$merkle->set_block( $block_idx++, sha256($block) );
}
my @path = split m{/}, $file->{rel};
my $curr = $file_tree;
my $name = pop @path;
$curr = ( $curr->{$_} //= {} ) for @path;
$curr->{$name} = { '' => { length => $file->{size}, 'pieces root' => $merkle->root } };
if ( $file->{size} > $piece_length ) {
view release on metacpan or search on metacpan
lib/Net/CLI/Interact/Phrasebook.pm view on Meta::CPAN
};
next;
}
if (m{^\s+match\s+(.+)\s*$}) {
my @vals = split m/\s+or\s+/, $1;
if (scalar @vals) {
push @{ $data->{actions} },
{type => 'match', value => \@vals};
next;
}
view release on metacpan or search on metacpan
lib/Net/ChooseFName.pm view on Meta::CPAN
=cut
sub protect_directory {
my ($self, $dirname) = @_;
$dirname =~ s,/(?=/),/$self->{protect_pref}empty,g; # empty components
return join '/', map($self->fix_component($_,1), split m|/|, $dirname), '';
}
=item directory_found($dirname, $f, $append, $url, $suggested, $type, $enc)
A callback to process the calculated directory name. Unless
view release on metacpan or search on metacpan
inc/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 length $func;
my $body;
eval {
view release on metacpan or search on metacpan
inc/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/Net/DAAP/DMAP.pm view on Meta::CPAN
sub dmap_seek {
my($struct, $to_find) = @_;
CHUNK: while (defined($to_find) && length($to_find)) {
my $top;
($top, $to_find) = split m{/}, $to_find, 2;
ELEMENT: foreach my $elt (@$struct) {
if ($elt->[0] eq $top) {
$struct = $elt->[1];
view release on metacpan or search on metacpan
lib/Net/DAAP/Server/AAC/Track.pm view on Meta::CPAN
$self->dmap_itemname( $tag->{TITLE} || basename($file, ".mp3") );
$self->daap_songalbum( $tag->{ALBUM} );
$self->daap_songartist( $tag->{ARTIST} );
$self->daap_songcomment( $tag->{COMMENT} );
$self->daap_songyear( $tag->{YEAR} || undef );
my ($number, $count) = split m{/}, ($tag->{TRACKNUM} || "");
$self->daap_songtrackcount( $count || 0);
$self->daap_songtracknumber( $number || 0 );
# from blech:
# if ($rtag->{TCP} || $rtag->{TCMP}) {
view release on metacpan or search on metacpan
lib/Net/DAAP/Server/Track.pm view on Meta::CPAN
$self->dmap_itemname( $tag->{TITLE} || basename($file, ".mp3") );
$self->daap_songalbum( $tag->{ALBUM} );
$self->daap_songartist( $tag->{ARTIST} );
$self->daap_songcomment( $tag->{COMMENT} );
$self->daap_songyear( $tag->{YEAR} || undef );
my ($number, $count) = split m{/}, ($tag->{TRACKNUM} || "");
$self->daap_songtrackcount( $count || 0);
$self->daap_songtracknumber( $number || 0 );
# from blech:
# if ($rtag->{TCP} || $rtag->{TCMP}) {
view release on metacpan or search on metacpan
lib/Net/DAVTalk.pm view on Meta::CPAN
if (ref $Path) {
($URL, $Path) = $$Path =~ m{(^https?://[^/]+)(.*)$};
}
if ($Path) {
$Path = join "/", map { uri_escape $_ } split m{/}, $Path, -1;
if ($Path =~ m{^/}) {
$URL =~ s{(^https?://[^/]+)(.*)}{$1$Path};
}
else {
$URL =~ s{/$}{};
view release on metacpan or search on metacpan
lib/Net/DHCP/Info/Obj.pm view on Meta::CPAN
sub _datetime {
### init
my $self = shift;
my @time = split m"[\s\:/]"mx, shift;
return DateTime->new(
year => $time[0],
month => $time[1],
day => $time[2],
view release on metacpan or search on metacpan
lib/Net/DHCPv6/Option/AftrName.pm view on Meta::CPAN
my $MAX_PTR_DEPTH = 255; ## no critic (ValuesAndExpressions::ProhibitMagicNumbers)
sub _encode_domain {
my ( $domain ) = @_;
return chr( 0 ) unless defined $domain && CORE::length( $domain );
my @labels = split m/[.]/, $domain;
return join( $EMPTY, map { pack( 'C', CORE::length ) . $_ } @labels ) . chr( 0 );
}
sub _read_labels_at {
my ( $payload, $offset_ref, $len, $depth ) = @_;
view release on metacpan or search on metacpan
lib/Net/DNS/LivedoorDomain/DDNS/Response.pm view on Meta::CPAN
my ($self, $res) = @_;
return unless $res->code =~ m/^(2|3)/;
my $content = $res->content;
return unless $content =~ m/<PRE>\n(.*)<\/PRE>/s;
$content = $1;
my @lines = split m/\n/, $content;
my %data;
for my $line(@lines) {
my ($key, $val) = split m/\:\s*/, $line;
$key = lc($key);
$self->$key($val);
}
}
view release on metacpan or search on metacpan
lib/Net/DNS/Question.pm view on Meta::CPAN
# IP address must contain address characters only
s/[%].+$//; # discard RFC4007 scopeid
return unless m#^[a-fA-F0-9:./]+$#;
my ( $address, $pfxlen ) = split m#/#;
# map IPv4 address to in-addr.arpa space
if (m#^\d*[.\d]*\d(/\d+)?$#) {
my @parse = split /\./, $address;
$pfxlen = scalar(@parse) << 3 unless $pfxlen;
view release on metacpan or search on metacpan
lib/Net/Doveadm.pm view on Meta::CPAN
if ($line2 ne '+') {
die Net::Doveadm::X->create('Response', "Error: $line2 ($line1)");
}
return [ split m<\t>, $line1, -1 ];
}
#----------------------------------------------------------------------
sub _flush_request_queue {
view release on metacpan or search on metacpan
lib/Net/FSP.pm view on Meta::CPAN
#the rest...
sub _make_remote {
my ($self, $name) = @_;
my @current = $name =~ m{ \A / }xms ? () : split m{ / }x, $self->{current_dir};
my @future = grep { !/ \A \.? \z /xms } split m{ / }x, $name;
for my $step (@future) {
if ($step eq '..') {
croak 'Can\'t go outside of root directory' if @current == 0;
pop @current;
}
view release on metacpan or search on metacpan
Recursive.pm view on Meta::CPAN
my($link_loc, $realfile) = (shift, shift);
my $i;
my $result;
my($new_realfile, $new_link, @realfile_parts, @link_parts);
@realfile_parts = split m#/#, $realfile;
@link_parts = split m#/#, $link_loc;
for ( $i = 0; $i < @realfile_parts; $i++ ) {
last unless $realfile_parts[$i] eq $link_parts[$i];
}
view release on metacpan or search on metacpan
lib/Net/FTPServer/PWP/Server.pm view on Meta::CPAN
# of 'hide mount point'...
$self->{pwp_qhandle} = Net::FTPServer::Full::DirHandle
-> new($self, $self->{pwp_qhandle}->{_pathname});
my @parts = split m!/!, $self->{pwp_qfile};
while (my $c = shift @parts) {
next if $c eq '' or $c eq '.';
if ($c eq "..") {
$self->{pwp_qhandle} = $self->{pwp_qhandle}->parent;
view release on metacpan or search on metacpan
version 0.64:
* Fixed error in daemon and ack tests
* Fixed erroneous setting of MSH fields in Message.pm
* set MSH(11) to P and MSH(15) to AL per default
* Made new() method of Message also split message string on \n
* ACK now takes MSH(11) and MSH(12) from incoming MSH, and sets MSH(15) and MSH(16)
to the empty string.
* Fixed erroneous sendAck and sendNack methods. The stuff is now sent as a single
line, to prevent perl from inserting separators, like end of lines, etc.