Result:
found more than 457 distributions - search limited to the first 2001 files matching your query
( run in 1.393 )
Acme-EnclosedChar
view release on metacpan or search on metacpan
t/01_basic.t view on Meta::CPAN
enclose_kanji
enclose_all
/;
is enclose(), '';
is enclose(undef), '';
is enclose('0'), '⓪';
is enclose('1'), 'â‘ ';
is enclose('12'), 'â‘«';
is enclose('012345'), '⓪①②③④⑤';
Acme-EyeDrops
view release on metacpan or search on metacpan
lib/Acme/EyeDrops.pm view on Meta::CPAN
}
$s;
}
# Pour $n tokens from @{$rtok} (starting at index $sidx) into string
# of length $slen. Return string or undef if unsuccessful.
sub _pour_chunk {
my ($rtok, $sidx, $n, $slen) = @_;
my $eidx = $sidx + $n - 1; my $tlen = 0;
my $idot = my $iquote = my $i3quote = my $iparen = my $idollar = -1;
for my $i ($sidx .. $eidx) {
lib/Acme/EyeDrops.pm view on Meta::CPAN
return unless $d == 1;
$iparen >= 0 and return join("", @{$rtok}[$sidx .. $iparen-1],
'+' . $rtok->[$iparen], @{$rtok}[$iparen+1 .. $eidx]);
# ouch, can't test for eq '(' in case next chunk also adds '+'
$rtok->[$eidx] ne '=' && $rtok->[$sidx+$n] =~ /^['"]/ ?
join("", @{$rtok}[$sidx .. $eidx], '+') : undef;
}
sub _pour_compact_chunk {
my ($rtok, $sidx, $n, $slen) = @_; my @mytok;
for my $i ($sidx .. $sidx + $n - 1) {
lib/Acme/EyeDrops.pm view on Meta::CPAN
# Pour unsightly text $txt into shape defined by string $tlines.
sub pour_text {
my ($tlines, $txt, $gap, $tfill) = @_;
$txt =~ s/\s+//g;
my $ttlen = 0; my $txtend = length($txt);
my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
split(/\n/, $tlines));
for my $r (grep($_, @tnlines)) {
for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
}
my $nshape = int($txtend/$ttlen); my $rem = $txtend % $ttlen;
lib/Acme/EyeDrops.pm view on Meta::CPAN
# Pour sightly program $prog into shape defined by string $tlines.
sub pour_sightly {
my ($tlines, $prog, $gap, $fillv, $compact, $ihandler) = @_;
$ihandler ||= \&_def_ihandler;
my $ttlen = 0;
my @tnlines = map(length() ? [map length, split/([^ ]+)/] : undef,
split(/\n/, $tlines));
for my $r (grep($_, @tnlines)) {
for my $i (0 .. $#{$r}) { $i & 1 and $ttlen += $r->[$i] }
}
my $outstr = ""; my @ptok;
lib/Acme/EyeDrops.pm view on Meta::CPAN
'siertri' => \&_bi_siertri,
'banner' => \&_bi_banner,
'srcbanner' => \&_bi_srcbanner
);
sub get_builtin_shapes { sort keys %builtin_shapes }
# Return built-in shape string or undef if invalid shape.
sub _get_builtin_string {
my $shape = shift;
return unless exists($builtin_shapes{$shape});
$builtin_shapes{$shape}->(shift);
}
lib/Acme/EyeDrops.pm view on Meta::CPAN
sub sightly {
my $ruarg = shift; my %arg = (
Shape => "", ShapeString => "",
SourceFile => "", SourceString => "",
SourceHandle => undef, InformHandler => undef,
Width => 0, BannerString => "",
Text => 0, TextFiller => "",
Regex => 0, Compact => 0,
Print => 0, Binary => 0,
Gap => 0, Rotate => 0,
lib/Acme/EyeDrops.pm view on Meta::CPAN
Let's get more ambitious and create a big self-printing I<JAPH>.
my $src = <<'FLAMING_OSTRICHES';
open 0;
$/ = undef;
$x = <0>;
close 0;
$x =~ tr/!-~/#/;
print $x;
FLAMING_OSTRICHES
lib/Acme/EyeDrops.pm view on Meta::CPAN
Given a .eye SHAPENAME, returns the shape string.
=item get_eye_properties SHAPENAME
Given a .eye SHAPENAME, returns a hash reference of
the shape properties or undef if the shape has no
properties.
=item slurp_yerself
Returns a string containing the contents of F<EyeDrops.pm>.
lib/Acme/EyeDrops.pm view on Meta::CPAN
of two characters: C<$> and a punctuation character.
For example, RFILLVAR = C<[ '$:', '$^', '$~' ]>.
Do not use C<$;> or C<$"> or C<$_> as filler variables.
If COMPACT is 1, use compact sightly encoding,
if 0 use plain sightly encoding.
If IH (inform handler) is undef, prints status of what it is
doing to STDERR; you can override this by providing a subroutine
reference taking a single inform string argument. To shut it up,
set IH to C<sub {}>.
=item sightly HASHREF
Acme-FSM
view release on metacpan or search on metacpan
=item I<diag_level>
(positive integer)
Sets a diagnostic threshold.
It's meaning is covered in L<B<diag()> method|/diag()> documentation.
If C<undef> then set to C<1> (C<0> is B<defined>).
=item I<dumper>
(scalar or C<CODE>)
B<A::F> operates on arbitrary items and there's a diagnostic service that
=over
=item C<eturn>
That I<[turn]> will be choosen by FSM itself when I<$item> at hands is
C<undef>
(as returned by B<source()>).
I<switch()> isn't invoked -- I<$item> is void, there's nothing to call
I<switch()> with.
However, I<$action> may change I<$item>.
=item C<uturn>
That I<[turn]> will be choosen by FSM if I<$rule> is C<undef>
(as returned by B<switch()>).
Idea behind this is to give an FST an option to bailout.
In original B<DMA::FSM> that's not possible (except B<croak>ing, you know).
Also, see L<B<BUGS AND CAVEATS>|/Perl FALSE, undef, and uturn>.
=item C<tturn> and/or C<fturn>
If any (hence 'or') is present then I<$rule> returned by B<switch()> is
treated as Perl boolean, except C<undef> it's handled by C<uturn>.
That's how it is in original B<DMA::FSM>.
If B<switch()> always returns TRUE (or FALSE) then C<fturn> (or C<tturn>) can
be missing.
Also, see L<B<BUGS AND CAVEATS>|/tturn, fturn, and switch()>.
=item C<START>
It's I<$state> set by B<connect()>.
I<$action> (it's also set by B<connect()>) is ignored
(if I<$action> is C<undef> then silently replaces with empty string),
B<switch()> is invoked with no arguments
(there's not anything to process yet).
Whatever I<$item> could be returned is ignored.
I<$rule> is followed.
Thus C<eturn> can't be followed.
It's last state in the state flow.
I<$action> is retained
(that's what B<process()> will return)
(however, because it's processed before C<STOP> state is acknowledged it must
not be C<undef>)
but otherwise ignored.
B<switch()> is invoked with no arguments
(B<switch()> of previous I<{state}> should have took care).
Whatever I<$item> could be returned is ignored.
Whatever I<$rule> could be returned is reported (at I<(basic trace)> level)
If FST has such record:
somestate => { eturn => [ somestate => 'NEXT' ] }
then FSM will stay in C<somestate> as long as I<source()> callback returns
C<undef>.
Thus consuming all resources available.
No options provided to limit that consumption.
=item C<SAME>
my( $item, $dump ) = $self->query_source;
$self->diag( 3, q|{%s}(%s): %s: going with|, @$turn, $dump );
# No one gets out of this loop without the state tables permission!
while ( 1 ) {
# We should never see an undefined state unless we've made a mistake.
# NOTE:202201072131:whynot: As a matter of fact, we don't now.
$self->verify( $self->fst( $self->state ),
$self->state, '', q|record|, q|HASH| );
( $branch, $item ) = $self->query_switch( $item );
$self->diag( 5, q|changing state: (%s) (%s)|, $backup, $_[0] );
$self->{_}{state} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<fst()>
%state = %{ $bb->fst( $state ) };
%state = %{ $bb->fst( $state => \%new_state ) };
=item query specific I<{state}> of specific I<$state>
Executed if one scalar is passed in.
Returns a I<{state}> reference with whatever entries are set.
Silently returns C<undef> if I<$state> is missing from I<{fst}>.
=item set I<{state}> of specific I<$state>
Executed if one scalar and HASH are passed in.
Sets a I<{state}> with key/value pairs from HASH,
Created record isa copy of HASH, not a reference
(not a true deep copy though)
(empty I<\%new_state> is fine too)
(copying isn't by design, it's implementation's quirk).
Returns record as it was before setting
(C<undef> is returned if there were no such I<$state> before).
=item query specific I<$entry> of specific I<$state>
Executed if two scalars are passed in.
Returns an entry from named state record.
Sets an entry in named state record,
creating one (entry) if necessary.
State record must exist beforehand.
Entry isa exact value of least argument, not a copy.
Returns whatever value I<$entry> just had
(C<undef> is returned if there were none such I<$entry> before).
=back
None checks are made, except record must exist (for two latter uses).
sub fst {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| );
return undef }
elsif( 2 == @_ && ref $_[1] eq q|HASH| ) {
my $backup = $self->fst( $_[0] );
$self->diag( 3, q|%s {%s} record|,
( $backup ? q|updating| : q|creating| ), $_[0] );
# XXX:202202150056:whynot: Copy is a side-effect instead.
$self->{_}{fst}{shift @_} = {%{ pop @_ }};
return $backup }
elsif( !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
return $self->{_}{fst}{shift @_} }
elsif( 2 == @_ ) {
return $self->{_}{fst}{shift @_}{shift @_} }
elsif( 3 == @_ ) {
( $backup ? q|updating| : q|creating| ), @_[0,1] );
$self->{_}{fst}{shift @_}{shift @_} = pop @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<turn()>
$bb->turn( $state ) eq '' or die;
$bb->turn( $state => 'uturn' )->[1] eq 'NEXT' or die;
=over
=item *
C<undef> is returned if I<$state> isn't present in the I<{fst}>
(also B<carp>s).
Also see below.
=item *
(while that information is mangled anyway);
Probably bad idea).
=item *
C<undef> is returned if there's nothing to say --
neither I<tturn>, nor I<fturn>, nor turn map --
this record is kind of void.
The record should be studied to find out why.
B<carp>s in that case.
defaulting to empty string.
=item anything else
No arguments or more then two is an non-fatal error.
Returns C<undef> (with B<carp>).
=back
=cut
my %special_turns = map { $_ => 1 } qw| eturn uturn tturn fturn |;
# TODO:202202162030:whynot: Consider more elaborate (informative) returns.
sub turn {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| ); return undef }
elsif( 1 == @_ && !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
my $state = shift @_;
my $entry = $self->verify(
$self->{_}{fst}{$state}, $state, '', q|entry|, q|HASH| );
# WORKAROUND:201305070051:whynot: Otherwise there will be spurious B<carp>s about anyway useless turns in those entries.
$state eq q|STOP| || $state eq q|BREAK| and return q|HASH|;
exists $entry->{tturn} || exists $entry->{fturn} and return '';
unless( exists $entry->{turns} ) {
# XXX:201305071531:whynot: Should just B<croak> instead, probably.
$self->carp( qq|{$state}: none supported turn| );
return undef }
$self->verify( $entry->{turns}, $state, q|turns|, q|turn|, q|HASH| );
return q|HASH| }
elsif( 2 == @_ ) {
my( $state, $turn ) = @_;
my $entry;
$entry->[1] //= '' if $state eq q|START| || $state eq q|CONTINUE|;
$self->verify( $entry->[1], $state, $turn, q|action|, '' );
return $entry }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }
}
=item B<action()>
$bb->action eq $action and die;
$self->diag( 5, q|changing action: (%s) (%s)|, $backup, $_[0] );
$self->{_}{action} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<query()>
( $alpha, $bravo ) = $self->query( $what, $name, @items );
Special-state mode:
invoke B<switch()> with no arguments;
ignore whatever I<$item> has been possibly returned;
return I<$rule> alone.
=item I<$item> is C<undef>
EOF mode:
ignore B<switch()> completely;
return C<eturn> and C<undef>.
=item I<$item> is not C<undef>
King-size mode:
invoke B<switch()>, pass I<$item> as single argument.
return I<$rule> and I<$item>
(whatever it became after going through B<switch()>).
I<$rule>, as it was returned by B<switch()>, is encoded like this:
=over
=item I<$rule> is C<undef>
Return C<uturn>.
B<(note)>
Don't verify if C<uturn> I<[turn]> exists.
B<switch()> is always invoked in list context even if I<$item> would be
ignored.
If I<$rule> shouldn't be paired with I<$item> it won't be
(it's safe to call B<query_switch()> in scalar context then and
there won't be any trailing C<undef>s).
=cut
sub query_switch {
my $self = shift @_;
sprintf( q|{%s}{switch}|, $self->state ),
@_ ) if !@_ || defined $_[0];
my $kind = $self->turn( $self->state );
$turn[0] =
@_ && !defined $_[0] ? q|eturn| :
# TODO:202201071700:whynot: Make C<undef> special only when C<uturn> is present, plz.
!defined $turn[0] ? q|uturn| :
# FIXME:201304230145:whynot: Defaulting to basics here looks as bad as B<croak>ing.
# TODO:202212202039:whynot: L<Default For Turn Map>.
$kind ? qq|turn%$turn[0]| :
$turn[0] ? q|tturn| : q|fturn|;
$dump = $self->query_dumper( $item );
Seeks I<dumper> callback (L<configured at construction time|/dumper>).
If the callback wasn't configured uses simple hopefully informative and
C<undef> proof substitution.
Whatever the callback returns is checked to be B<defined>
(C<undef> is changed to C<"(unclear)">)
and then returned.
=cut
sub query_dumper {
my $self = shift @_;
return $self->verify(
$self->query(
# TODO:202202210258:whynot: This is inefficient, defaulting should happen in B<connect()> instead.
$self->{_}{dumper} // sub { sprintf q|(%s)|, $_[1] // q|undef| },
q|{dumper}|, @_ ) // q|(unclear)|,
# XXX:202202210304:whynot: 'source' looks like remnants of refactoring. Should investigate it deeper.
$self->state, qw| source source |, '' ) }
=item B<diag()>
my $self = shift @_;
$self->{_}{diag_level} >= shift @_ or return $self;
# TODO:202212222141:whynot: Since something this B<sprintf> might emit warnings. And maybe it's appropriate.
printf STDERR sprintf( qq|[%s]: %s\n|,
( split m{::}, ( caller 1 )[3])[-1], shift @_ ),
map $_ // q|(undef)|, @_;
return $self }
=item B<carp()>
$bb->carp( 'something wrong...' );
but FST might get out of hands
(ie check F<t/process/quadratic.t>).
Indeed, some kind of (limited!) linter would be much desired.
It's missing.
=item Perl FALSE, C<undef>, and C<uturn>
B<(caveat)>
Back then B<DMA::FSM> treated C<undef> as any other Perl FALSE.
C<uturn> I<$rule> mech has made C<undef> special
(if B<switch()> returns C<undef> and C<uturn> I<{turn}> isn't present then
it's a B<croak>).
Thus, at the moment, C<undef> isn't FALSE (for B<A::F>).
This is counter-intuitive, actually.
=item Returning C<undef> for misuse
B<(bug)>
Why B<A::F> screws with caller,
in case of API violations (by returning C<undef>),
is beyond my understanding now.
=item B<source()> and I<$state>
B<(bug)> (also see L<B<switch()> and I<$item>|/switch() and $item>)
=item B<turn()> and B<fst()>
B<(misdesign)>
Encoding (so to speak) in use by B<turn()> (in prediction mode) is plain
stupid.
C<undef> signals two distinct conditions
(granted, both are manifest of broken I<{fst}>).
Empty string doesn't distinguish safe (both C<tturn> and C<fturn> are present)
and risky (C<tturn> or C<fturn> is missing) I<{state}>.
C<HASH> doesn't say if there's anything in turn map.
All that needs loads of workout.
=item C<[fst]: no args>
B<(warning)>, L<B<fst()> method|/fst()>.
No arguments, it's an error.
However, instead of promptly dieing, C<undef> is returned
in blind hope this will be devastating enough.
=item C<[fst]: (%s): no such {fst} record>
B<(warning)>, L<B<fst()> method|/fst()>.
=item C<[fst]: too many args (%i)>
B<(warning)>, L<B<fst()> method|/fst()>.
Too many args have been passed in.
And again, instead of prompt dieing C<undef> is returned.
=item C<[fst]: updating {%s} record>
B<(basic trace)>, L<B<fst()> method|/fst()>.
Named record (I<%s>) has been updated.
=item C<[process]: {%s}(%s): %s: going with>
B<(basic trace)>, L<B<process()> method|/process()>.
While in I<$state> I<%s> (1st) doing I<$action> I<%s> (2nd) the I<$item>
happens to be I<%s> (3rd).
C<undef> will look like this: C<((undef))>.
=item C<[process]: {%s}(%s): %s: turning with>
B<(basic trace)>, L<B<process()> method|/process()>.
B<switch()> (of I<$state> I<%s>, the 1st) has returned I<$rule> I<%s> (2nd)
=item C<[state]: too many args (%i)>
B<(warning)>, L<B<state()> method|/state()>.
Obvious.
None or one argument is supposed.
B<state()> has returned C<undef> in this case,
most probably will bring havoc in a moment.
=item C<[turn]: (%s): no such {fst} record>
B<(warning)>, L<B<turn()> method|/turn()>.
switch => sub {
my $item = shift;
$item % 15 ? 'charlie' :
$item % 5 ? 'delta' :
$item % 3 ? 'echo' :
undef, $item
},
uturn => [ qw/ bravo NEXT / ],
turns =>
{
charlie => [ qw/ charlie SAME / ],
}
}
Again, B<source()> supposedly produces some numbers.
Then some kind of FizBuzz happens.
Also, returning C<undef> as default raises questions.
However, it's acceptable for example.
Now, quick demonstration, that's how this FizzBuzz would look
using B<DMA::FSM> capabilities (and B<A::F> of I<v2.2.7> syntax).
Acme-FizzBuzz
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2010 Adam Kennedy.
Acme-Flat
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
t/00-report-prereqs.t view on Meta::CPAN
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
Acme-Ford-Prefect-FFI
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
my $pm = "$module.pm";
$pm =~ s{::}{/}g;
if(eval { require $pm; 1 })
{
my $ver = eval { $module->VERSION };
$ver = 'undef' unless defined $ver;
diag sprintf $format, $module, $ver;
}
else
{
diag sprintf $format, $module, '-';
Acme-Ford-Prefect
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
my $pm = "$module.pm";
$pm =~ s{::}{/}g;
if(eval { require $pm; 1 })
{
my $ver = eval { $module->VERSION };
$ver = 'undef' unless defined $ver;
diag sprintf $format, $module, $ver;
}
else
{
diag sprintf $format, $module, '-';
Acme-Ford-Prefect2-FFI
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
my $pm = "$module.pm";
$pm =~ s{::}{/}g;
if(eval { require $pm; 1 })
{
my $ver = eval { $module->VERSION };
$ver = 'undef' unless defined $ver;
diag sprintf $format, $module, $ver;
}
else
{
diag sprintf $format, $module, '-';
Acme-Ford-Prefect2
view release on metacpan or search on metacpan
t/00_diag.t view on Meta::CPAN
my $pm = "$module.pm";
$pm =~ s{::}{/}g;
if(eval { require $pm; 1 })
{
my $ver = eval { $module->VERSION };
$ver = 'undef' unless defined $ver;
diag sprintf $format, $module, $ver;
}
else
{
diag sprintf $format, $module, '-';
Acme-Fork-Lazy
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 Adam Kennedy.
Acme-Free-API-Geodata-GeoIP
view release on metacpan or search on metacpan
lib/Acme/Free/API/Geodata/GeoIP.pm view on Meta::CPAN
=head1 DESCRIPTION
This module looks up GeoIP data through a public API, see L<https://www.freepublicapis.com/ip-geolocation-api>.
It returns a hashref on success, undefined on failure. To see what went wrong, set debug to a true value in new().
=head1 SEE ALSO
Call for API implementations on PerlMonks: L<https://perlmonks.org/?node_id=11161472>
Acme-Free-API-Stonks
view release on metacpan or search on metacpan
lib/Acme/Free/API/Stonks.pm view on Meta::CPAN
}
sub get {
my $self = shift;
my $resp = d2o $self->ua->get(BASEURL);
return d2o -autoundef, decode_json $resp->content;
}
sub stonks {
my $self = shift;
return $self->get;
Acme-Free-Advice-Slip
view release on metacpan or search on metacpan
t/00_compile.t view on Meta::CPAN
is my $slip = advice(224), hash {
field advice => string q[Don't drink bleach.];
field id => number 224;
end;
}, 'advice(1) returns a known slip';
is advice(100000), U(), 'advice(100000) returns undef';
};
subtest 'search for advice' => sub {
is my $list = [ search('time') ], array {
all_items hash {
field advice => D();
Acme-Free-Advice-Unsolicited
view release on metacpan or search on metacpan
t/00_compile.t view on Meta::CPAN
field id => number 224;
field source => string q[https://kk.org/thetechnium/103-bits-of-advice-i-wish-i-had-known/];
end;
}, 'advice(224) returns a known piece of wisdom';
isa_ok $slip, ['Acme::Free::Advice::Unsolicited'], 'slip is a blessed hash';
is advice(100000), U(), 'advice(100000) returns undef';
};
subtest 'gather all advice' => sub {
is my $list = [ all() ], array {
all_items hash {
field advice => D();
Acme-Free-Advice
view release on metacpan or search on metacpan
lib/Acme/Free/Advice.pm view on Meta::CPAN
=over
=item C<flavor>
If undefined, a random supported flavor is used.
Currently, supported flavors include:
=over
Acme-Free-Public-APIs
view release on metacpan or search on metacpan
lib/Acme/Free/Public/APIs.pm view on Meta::CPAN
# https://www.freepublicapis.com/api/apis
# https://www.freepublicapis.com/api/apis/275
sub apis {
my $self = shift;
my $params = d2o -autoundef, { @_ };
my $URL = sprintf "%s/apis", BASEURL;
my $ret = [];
if ($params->id) {
$URL = sprintf "%s/%d", $URL, $params->id;
my $resp = HTTPTiny2h2o $self->ua->get($URL);
$ret = d2o -autoundef, [ $resp->content ]; # preset single item in an ARRAY
}
else {
my $resp = HTTPTiny2h2o $self->ua->get($URL);
$ret = $resp->content;
}
Acme-GRYLLIDA-Utils
view release on metacpan or search on metacpan
lib/Acme/GRYLLIDA/Utils.pm view on Meta::CPAN
=head1 SUBROUTINES/METHODS
=head2 sum
This function returns a sum of its arguments. Non-number arguments are ignored. No arguments returns undef.
=cut
sub sum {
my $sum;
Acme-Geo-Whitwell-Name
view release on metacpan or search on metacpan
lib/Acme/Geo/Whitwell/Name.pm view on Meta::CPAN
}
=head2 from_whitwell($whitwell_name, signed => $yes_or_no)
Converts a Whitwell name back into a lat/lon pair, in trailing indicator
format. Results will be undefined if the string does not match the Whitwell
scheme; if the strings I<is> Whitwell-compatible, but includes extra letters,
these will be assumed to be further digits after the decimal point.
If you supply the 'signed' option with a true value, the returned values are
signed numbers rather than numbers with trailing sign indicators.
Acme-Ghost
view release on metacpan or search on metacpan
lib/Acme/Ghost.pm view on Meta::CPAN
gid => $gid,
gids => $gids,
# PID
pidfile => $args->{pidfile} || File::Spec->catfile(getcwd(), sprintf("%s.pid", $name)),
_filepid => undef,
# Log
facility => $args->{facility},
logfile => $args->{logfile},
ident => $args->{ident} || $name,
logopt => $args->{logopt},
logger => $args->{logger},
loglevel => $args->{loglevel},
loghandle => $args->{loghandle},
_log => undef,
# Runtime
initpid => $$, # PID of root process
ppid => 0, # PID before daemonize
pid => 0, # PID daemonized process
lib/Acme/Ghost.pm view on Meta::CPAN
my $gid = (split /[\s,]+/, $gids)[0]; # First GID
_debug("!! UID=%s; GID=%s; GIDs=\"%s\"", $uid, $gid, $gids);
# Pre Init Hook
$self->preinit;
$self->{_log} = undef; # Close log handlers before spawn
# Spawn
my $pid = _fork();
if ($pid) {
_debug("!! Spawned (PID=%s)", $pid);
Acme-Given-Hash
view release on metacpan or search on metacpan
lib/Acme/Given/Hash.pm view on Meta::CPAN
;
}
return RUN $pair->{value} if $match;
}
return undef; # no matches found
};
1;
Acme-Globus
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
t/00-report-prereqs.t view on Meta::CPAN
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
Acme-Godot
view release on metacpan or search on metacpan
t/00-report-prereqs.t view on Meta::CPAN
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
t/00-report-prereqs.t view on Meta::CPAN
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
Acme-Gosub
view release on metacpan or search on metacpan
lib/Acme/Gosub.pm view on Meta::CPAN
my $status = 1;
$status = filter_read(1_000_000);
return $status if $status<0;
$_ = filter_blocks($_,$offset);
$_ = "# line $offset\n" . $_ if $offset; undef $offset;
return $status;
}
use Text::Balanced ':ALL';
lib/Acme/Gosub.pm view on Meta::CPAN
# what we want. What happens is that we put an initial ";"
# so the end of the statement will be a ";" too.
my $source_for_text_balanced = ";" .
substr($source, $pos_source);
pos($source_for_text_balanced) = 0;
@pos = Text::Balanced::_match_codeblock(\$source_for_text_balanced,qr/\s*/,qr/;/,qr/;/,qr/[[{(<]/,qr/[]})>]/,undef)
or do {
die "Bad gosub statement (problem in the parentheses?) near $Acme::Gosub::file line ", line(substr($source_for_text_balanced,0,pos $source_for_text_balanced),$line), "\n";
};
my $future_pos_source = $pos_source + pos($source_for_text_balanced);
print join(",",@pos), "\n";
Acme-Goto-Line
view release on metacpan or search on metacpan
# define PL_perldb perldb
# define PL_rsfp_filters rsfp_filters
# define PL_rsfpv rsfp
# define PL_stdingv stdingv
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
/* Replace: 0 */
#endif
#ifdef HASATTRIBUTE
#endif
#ifdef SvPVbyte
# if PERL_REVISION == 5 && PERL_VERSION < 7
/* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
# undef SvPVbyte
# define SvPVbyte(sv, lp) \
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
static char *
my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
Acme-Greeting
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.04';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2011 Adam Kennedy.
Acme-HTTP
view release on metacpan or search on metacpan
lib/Acme/HTTP.pm view on Meta::CPAN
$url = $Response{'Location'};
}
unless (defined $hdl) {
$@ = 'Acme::HTTP - Internal error, hdl is undefined';
return;
}
bless { hdl => $hdl };
}
Acme-Has-Tiny
view release on metacpan or search on metacpan
t/01basic.t view on Meta::CPAN
isa_ok($bob, "Person", '$bob');
isa_ok($bob, "Employee", '$bob');
can_ok($bob, $_) for qw(name age has_name has_age _set_age id);
like(exception { $bob->_set_age("x") }, qr{^Value "x" did not pass type constraint "Num"}, 'type constraint');
ok(!$bob->has_age, 'not $bob->has_age');
is($bob->age, undef, '$bob->age undef');
is($bob->_set_age(42), 42, 'setter returns value');
ok($bob->has_age, '$bob->has_age');
is($bob->age, 42, 'getter returns value');
my $e = exception { "Employee"->new(name => undef) };
like($e, qr{^Attribute id is required by Employee}, 'required attribute exception');
done_testing;
Acme-HidamariSketch
view release on metacpan or search on metacpan
eg/characters.pl view on Meta::CPAN
my @characters = $hidamari->characters;
# ã¿ã‚“ãªã®æƒ…å ±ãŒè¦‹ãŸã„放題
foreach my $character (@characters) {
printf "-----------------------\n";
my $name = $character->{name_ja} ? $character->{name_ja} : "undef";
my $birthday = $character->{birthday} ? $character->{birthday} : "undef";
my $sign = $character->{sign} ? $character->{sign} : "undef";
my $color = $character->{color} ? $character->{color} : "undef";
printf "name: " . $name . "\n";
printf "birthday: " . $birthday . "\n";
printf "sign: " . $sign . "\n";
printf "color: " . $color . "\n";
printf "room_number:\n{\n";
eg/characters.pl view on Meta::CPAN
for my $year (qw/before first second third/) {
if (defined $room_number->{$year}) {
printf ' ' . $year . ': ' . $room_number->{$year} . "\n";
}
else {
printf ' ' . $year . ": undef\n";
};
}
printf "}\n";
}
Acme-Hidek
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
inc/Module/Install.pm view on Meta::CPAN
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
Acme-Holy
view release on metacpan or search on metacpan
=head1 DESCRIPTION
B<Acme::Holy> provides a single routine, B<holy()>, which returns the name
of the package an object has been C<bless>ed into, or C<undef>, if its first
argument is not a blessed reference.
Isn't this what C<ref()> does already? Yes, and no. If given a blessed
reference, C<ref()> will return the name of the package the reference has
been blessed into. However, if C<ref()> is passed an unblessed reference,
then it will return the type of reference (e.g. C<SCALAR>, C<HASH>, C<CODEREF>,
etc). This means that a call to C<ref()> by itself cannot determine if a
given reference is an object. B<holy()> differs from C<ref()> by returning
C<undef> if its first argument is not a blessed reference (even if it is
a reference).
Can't we use C<UNIVERSAL::isa()>? Yes, and no. If you already have an object,
then C<isa()> will let you know if it inherits from a given class. But what do
we do if we know nothing of the inheritance tree of the object's class? Also,
=item B<holy> I<scalar>
B<holy()> accepts a single scalar as its argument, and, if that scalar is
a blessed reference, returns the name of the package the reference has been
blessed into. Otherwise, B<holy()> returns C<undef>.
=back
=head2 Method Aliases
( run in 1.393 second using v1.01-cache-2.11-cpan-d80b1682f3f )