view release on metacpan or search on metacpan
t/common.pm view on Meta::CPAN
use Archive::Zip qw(:ERROR_CODES);
use Exporter qw(import);
@common::EXPORT = qw(TESTDIR INPUTZIP OUTPUTZIP
TESTSTRING TESTSTRINGLENGTH TESTSTRINGCRC
PATH_REL PATH_ABS PATH_ZIPFILE PATH_ZIPDIR PATH_ZIPABS
passThrough readFile execProc execPerl dataPath testPath
azbinis azok azis
azopen azuztok azwok);
t/common.pm view on Meta::CPAN
use constant TESTDIR => do {
-d 'testdir' or mkdir 'testdir' or die $!;
tempdir(DIR => 'testdir', CLEANUP => 1, EXLOCK => 0);
};
use constant INPUTZIP =>
(tempfile('testin-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1];
use constant OUTPUTZIP =>
(tempfile('testout-XXXXX', SUFFIX => '.zip', TMPDIR => 1, $^O eq 'MSWin32' ? () : (UNLINK => 1)))[1];
# 300-character test string. CRC-32 should be ac373f32.
use constant TESTSTRING => join("\n", 1 .. 102) . "\n";
use constant TESTSTRINGLENGTH => length(TESTSTRING);
t/common.pm view on Meta::CPAN
# Check whether we can write through a (non-seekable) pipe
my $pipeCommand = '| "' . $Config{'perlpath'} . '" -pe "BEGIN{binmode(STDIN);binmode(STDOUT)}" >';
my $pipeError = "";
my $pipeWorks = eval {
my $testString = pack('C256', 0 .. 255);
my $fh = FileHandle->new("$pipeCommand " . OUTPUTZIP) or die $!;
binmode($fh) or die $!;
$fh->write($testString, length($testString)) or die $!;
$fh->close() or die $!;
(-f OUTPUTZIP) or die $!;
(-s OUTPUTZIP) == length($testString) or die "length mismatch";
readFile(OUTPUTZIP) eq $testString or die "data mismatch";
return 1;
} or $pipeError = $@;
### Test Functions
t/common.pm view on Meta::CPAN
return $ok;
}
sub azopen
{
my $file = @_ ? shift : OUTPUTZIP;
if ($pipeWorks) {
if (-f $file && ! unlink($file)) {
return undef;
}
t/common.pm view on Meta::CPAN
sub azuztok
{
my $file = @_ & 1 ? shift : undef;
my %params = @_;
$file = exists($params{'file'}) ? $params{'file'} :
defined($file) ? $file : OUTPUTZIP;
my $refzip = $params{'refzip'};
my $xppats = $params{'xppats'};
my $name = $params{'name'};
local $Test::Builder::Level = $Test::Builder::Level + 1;
t/common.pm view on Meta::CPAN
sub azwok
{
my $zip = shift;
my %params = @_;
my $file = exists($params{'file'}) ? $params{'file'} : OUTPUTZIP;
my $name = $params{'name'} ? $params{'name'} : "write and test zip file";
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok;
view all matches for this distribution
view release on metacpan or search on metacpan
memcached_pool_push(arcus->pool, mc);
}
if (RETVAL == NULL) {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
SV *
set(arcus, key, value, ...)
Arcus_API *arcus
memcached_pool_push(arcus->pool, mc);
}
if (RETVAL == NULL) {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
void
set_multi(arcus, ...)
Arcus_API *arcus
memcached_pool_push(arcus->pool, mc);
}
if (RETVAL == NULL) {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
void
get(arcus, key)
Arcus_API *arcus
do_return:
if (mc != NULL) {
memcached_pool_push(arcus->pool, mc);
}
PUTBACK;
HV *
get_multi(arcus, ...)
Arcus_API *arcus
ALIAS:
Safefree(keys_ptr);
}
if (keys_length != NULL) {
Safefree(keys_length);
}
OUTPUT:
RETVAL
SV *
delete(arcus, key)
Arcus_API *arcus
memcached_pool_push(arcus->pool, mc);
}
if (RETVAL == NULL) {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
SV *
flush_all(arcus, ...)
Arcus_API *arcus
memcached_pool_push(arcus->pool, mc);
}
if (RETVAL == NULL) {
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
HV *
server_versions(arcus)
Arcus_API *arcus
hv_store(RETVAL, SvPV_nolen(host), SvCUR(host), version, 0);
}
do_return:
sv_2mortal((SV *) RETVAL);
OUTPUT:
RETVAL
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Arepa/Repository.pm view on Meta::CPAN
if ($self->config_key_exists('repository:remote_path')) {
my $remote_repo_path = $self->get_config_key('repository:remote_path');
my $rsync_cmd = "rsync -avz --delete --dry-run --out-format='AREPA_CHANGE %i' $repo_path $remote_repo_path";
my $changes = 0;
open RSYNCOUTPUT, "$rsync_cmd |";
while (<RSYNCOUTPUT>) {
next unless /^AREPA_CHANGE/;
if (/^AREPA_CHANGE [^.]/) {
$changes = 1;
}
}
close RSYNCOUTPUT;
return (! $changes);
}
return 0;
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Ark/Plugin/CSRFDefender.pm view on Meta::CPAN
my $method = $c->req->method;
return () if !$method;
return
$method eq 'POST' ? 1 :
$method eq 'PUT' ? 1 :
$method eq 'DELETE' ? 1 : ();
}
sub html_filter_for_csrf {
my ($c, $html) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Armadito/Agent/Tools/Hostname.pm view on Meta::CPAN
$getComputerName->Call( 3, $buffer, $n );
# convert from UTF16 to UTF8
my $hostname = substr( decode( "UCS-2le", $buffer ), 0, ord $n );
return $hostname || $ENV{COMPUTERNAME};
}
1;
__END__
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Array/Base.xs view on Meta::CPAN
{
dSP; dMARK;
if(SP != MARK) {
SV **kp;
IV base = POPi;
PUTBACK;
if(MARK+1 != SP) {
for(kp = MARK; kp != SP; kp += 2) {
SV *k = kp[1];
if(SvOK(k))
kp[1] = sv_2mortal(
lib/Array/Base.xs view on Meta::CPAN
dSP; dMARK;
if(SP != MARK) {
IV base = POPi;
if(SP != MARK && SvOK(MARK[1]))
MARK[1] = sv_2mortal(newSViv(SvIV(MARK[1]) + base));
PUTBACK;
}
return PL_op->op_next;
}
#define newUNOP_munge_aeach(f, l) THX_newUNOP_munge_aeach(aTHX_ f, l)
view all matches for this distribution
view release on metacpan or search on metacpan
Override.xs view on Meta::CPAN
if (SvTYPE(sv) == SVt_PVHV) {
HV *hv = (HV *) sv;
HE *entry;
const I32 gimme = GIMME_V;
/* PUTBACK; */
entry = hv_iternext(hv);
/* SPAGAIN; */
if (entry) {
SV *const key_sv = hv_iterkeysv(entry);
Override.xs view on Meta::CPAN
PUSHs(key_sv);
if (gimme != G_ARRAY)
XSRETURN(1);
else {
SV *val;
/* PUTBACK; */
val = hv_iterval(hv, entry);
/* SPAGAIN; */
PUSHs(val);
XSRETURN(2);
}
Override.xs view on Meta::CPAN
XSRETURN(1);
}
else {
I32 n = HvKEYS(hv);
EXTEND(SP, n);
/* PUTBACK; */
while ((entry = hv_iternext(hv))) {
SV *key_sv;
/* SPAGAIN; */
key_sv = hv_iterkeysv(entry);
PUSHs(key_sv);
/* PUTBACK; */
}
/* SPAGAIN; */
XSRETURN(n);
}
}
Override.xs view on Meta::CPAN
XSRETURN(1);
}
else {
I32 n = HvKEYS(keys);
EXTEND(SP, n);
/* PUTBACK; */
while ((entry = hv_iternext(keys))) {
SV *val;
val = hv_iterval(hv, entry);
/* SPAGAIN; */
PUSHs(val);
}
/* PUTBACK; */
XSRETURN(n);
}
}
if (SvTYPE(sv) != SVt_PVAV) {
Perl_croak(aTHX_ "Argument to Array::Each::Override::array_values must "
view all matches for this distribution
view release on metacpan or search on metacpan
PROTOTYPE: \@
ALIAS:
pop_heap_idx = 1
CODE:
RETVAL = pop_heap (array (heap), cmp_nv, 0, ix);
OUTPUT:
RETVAL
SV *
pop_heap_lex (SV *heap)
PROTOTYPE: \@
CODE:
RETVAL = pop_heap (array (heap), cmp_sv, 0, 0);
OUTPUT:
RETVAL
SV *
pop_heap_cmp (SV *cmp, SV *heap)
PROTOTYPE: &\@
dCMP;
CMP_PUSH (cmp);
RETVAL = pop_heap (array (heap), cmp_custom, cmp_data, 0);
CMP_POP;
}
OUTPUT:
RETVAL
SV *
splice_heap (SV *heap, int idx)
PROTOTYPE: \@$
ALIAS:
splice_heap_idx = 1
CODE:
RETVAL = splice_heap (array (heap), cmp_nv, 0, idx, ix);
OUTPUT:
RETVAL
SV *
splice_heap_lex (SV *heap, int idx)
PROTOTYPE: \@$
CODE:
RETVAL = splice_heap (array (heap), cmp_sv, 0, idx, 0);
OUTPUT:
RETVAL
SV *
splice_heap_cmp (SV *cmp, SV *heap, int idx)
PROTOTYPE: &\@$
dCMP;
CMP_PUSH (cmp);
RETVAL = splice_heap (array (heap), cmp_custom, cmp_data, idx, 0);
CMP_POP;
}
OUTPUT:
RETVAL
void
adjust_heap (SV *heap, int idx)
PROTOTYPE: \@$
view all matches for this distribution
view release on metacpan or search on metacpan
PatternMatcher.pm view on Meta::CPAN
sub pat_match ;
sub single_match_is {
DFEATURE my $f_;
my ($is_var_and_pred, $input, $bindings) = @_ ;
DTRACE "INPUT ", Data::Dumper::Dumper(\@_) ;
my ($var,$pred) = ($is_var_and_pred->[1],$is_var_and_pred->[2]) ;
my $new_bindings = pat_match $var, $input, $bindings ;
DTRACE "NEW_BINDINGS ", Data::Dumper::Dumper($new_bindings) ;
if (!defined($new_bindings) or !defined($pred->($input))) {
view all matches for this distribution
view release on metacpan or search on metacpan
PUSHmortal|5.009002||p
PUSHn|||
PUSHp|||
PUSHs|||
PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
view all matches for this distribution
view release on metacpan or search on metacpan
t/lib/Test/Easy.pm view on Meta::CPAN
my $num = pop;
my $tb = Test::More->builder;
if ($tb->{Have_Plan}) {
require Carp;
Carp::confess(<<DAMNIT_JIM_IM_A_DOCTOR_NOT_A_BOLOGNA_SANDWICH_WHO_PUTS_KALE_ON_THEIR_BOLOGNA_SANDWICH_ANYWAY_NOW_PLEASE_TAKE_THAT_OFF_MY_HEAD);
Dang. You've tried to use 'subtest()' in a test, which is totally cool,
even on this old version of Test::More $Test::More::VERSION, which
doesn't really implement a subtest()... except it's not cool, because
you already planned your tests, and this shim needs to fake out the
plan a bit in order to convince the test harness that all is well.
t/lib/Test/Easy.pm view on Meta::CPAN
use Test::More; END { done_testing() }
Yeah, I'm not a fan of done_testing() either, but those are your choices.
DAMNIT_JIM_IM_A_DOCTOR_NOT_A_BOLOGNA_SANDWICH_WHO_PUTS_KALE_ON_THEIR_BOLOGNA_SANDWICH_ANYWAY_NOW_PLEASE_TAKE_THAT_OFF_MY_HEAD
}
if (!$tb->{'Test::Easy::tampered'}++) {
$tb->{Expected_Tests} = 0;
}
view all matches for this distribution
view release on metacpan or search on metacpan
scripts/Array-Transpose-example.pl view on Meta::CPAN
=head1 NAME
Array-Transpose-example.pl - Simple example on the use of the transpose function
=head1 OUTPUT
Input
Rows: 4, Columns: 3
a b c
1 2 3
view all matches for this distribution
view release on metacpan or search on metacpan
t/07_manager.t view on Meta::CPAN
use Test::More;
use Art::World;
use Art::World::Util;
use constant {
INITIAL_ARTIST_REPUTATION => 1,
INITIAL_CURATOR_REPUTATION => 100,
INITIAL_MANAGER_REPUTATION => 200,
};
my $manager = Art::World->new_director(
id => 111,
reputation => INITIAL_MANAGER_REPUTATION,
name => Art::World::Util->new_person->fake_name );
my $artist_1 = Art::World->new_artist(
id => 2,
reputation => INITIAL_ARTIST_REPUTATION,
name => Art::World::Util->new_person->fake_name );
my $curator_1 = Art::World->new_curator(
id => 3,
reputation => INITIAL_CURATOR_REPUTATION,
name => Art::World::Util->new_person->fake_name );
my $peoples = [ $manager, $artist_1, $curator_1 ];
$manager->networking( $peoples );
t/07_manager.t view on Meta::CPAN
is $artist_1->reputation, 126, "Artist acquired a serious reputation thanks to the influence of the institution manager";
is $curator_1->reputation, 720, "Curator acquired a serious reputation thanks to the influence of the institution manager";
my $artist_2 = Art::World->new_artist(
id => 4,
reputation => INITIAL_ARTIST_REPUTATION,
name => Art::World::Util->new_person->fake_name );
my $bumped_reputation = $artist_2->bump_fame( $artist_1->reputation );
is $bumped_reputation, 127, "The artist got it's reputation bumped by another artist";
my $networked_reputation = $manager->influence( $artist_2->reputation );
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Artifactory/Client.pm view on Meta::CPAN
return $self->_request( 'post', @args );
}
=head2 put( @args )
Invokes PUT request on LWP::UserAgent-like object; params are passed through.
=cut
sub put {
my ( $self, @args ) = @_;
lib/Artifactory/Client.pm view on Meta::CPAN
my $props = $self->_attach_properties( properties => $properties, matrix => 1 );
push @joiners, $props if ($props); # if properties aren't passed in, the function returns empty string
my $url = join( ";", @joiners );
my $req = HTTP::Request::StreamingUpload->new(
PUT => $url,
headers => HTTP::Headers->new( %{$header} ),
( $file ? ( fh => Path::Tiny::path($file)->openr_raw() ) : () ),
);
return $self->request($req);
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AsposeBarCodeCloud/ApiClient.pm view on Meta::CPAN
use MIME::Base64;
use LWP::UserAgent;
use HTTP::Headers;
use HTTP::Response;
use HTTP::Request::Common qw(DELETE POST GET HEAD PUT);
use HTTP::Status;
use URI::Query;
use JSON;
use URI::Escape;
use Scalar::Util;
lib/AsposeBarCodeCloud/ApiClient.pm view on Meta::CPAN
'form-data' : $header_params->{'Content-Type'};
$_request = POST($_url, %$header_params, Content => $_body_data);
}
elsif ($method eq 'PUT') {
# multipart
$header_params->{'Content-Type'} = lc $header_params->{'Content-Type'} eq 'multipart/form' ?
'form-data' : $header_params->{'Content-Type'};
$_request = PUT($_url, %$header_params, Content => $_body_data);
}
elsif ($method eq 'GET') {
my $headers = HTTP::Headers->new(%$header_params);
$_request = GET($_url, %$header_params);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AsposeCellsCloud/ApiClient.pm view on Meta::CPAN
use MIME::Base64;
use LWP::UserAgent;
use HTTP::Headers;
use HTTP::Response;
use HTTP::Request::Common qw(DELETE POST GET HEAD PUT);
use HTTP::Status;
use URI::Query;
use JSON;
use URI::Escape;
use Scalar::Util;
lib/AsposeCellsCloud/ApiClient.pm view on Meta::CPAN
}
else{
$_request = POST($_url, %$header_params);
}
}
elsif ($method eq 'PUT') {
# multipart
$header_params->{'Content-Type'} = lc $header_params->{'Content-Type'} eq 'multipart/form' ?
'form-data' : $header_params->{'Content-Type'};
if($_body_data){
$_request = PUT($_url, %$header_params, Content => $_body_data);
}
else{
$_request = PUT($_url, %$header_params);
}
}
elsif ($method eq 'GET') {
my $headers = HTTP::Headers->new(%$header_params);
if($_body_data){
view all matches for this distribution