view release on metacpan or search on metacpan
lib/Acme/Given/Hash.pm view on Meta::CPAN
sub gvn ($) {
my $when = shift;
# old hashref notation
if ( ref($when) eq 'HASH' ) {
return bless {exact => $when, calculate => []}, 'Acme::Given::Hash::Object';
}
# new arrayref notation
elsif ( ref($when) eq 'ARRAY' ) {
my $input = natatime 2, @{ $_[0] };
my $self = {exact=>{}, calculate=>[]};
lib/Acme/Given/Hash.pm view on Meta::CPAN
}
else {
push @{ $self->{calculate} }, {match => $pairs[0], value => $pairs[1]};
}
}
return bless $self, 'Acme::Given::Hash::Object';
}
die 'gvn only takes hashrefs and arrayrefs, you have passed soemthing else';
}
package Acme::Given::Hash::Object;
view release on metacpan or search on metacpan
lib/Acme/Globus.pm view on Meta::CPAN
=cut
sub new {
my ( $class, $username, $key_path ) = @_ ;
my $self = {} ;
bless $self, $class ;
$self->{username} = $username || 'none' ;
$self->{key_path} = $key_path || 'none' ;
return $self ;
}
view release on metacpan or search on metacpan
lib/Acme/Goedelize.pm view on Meta::CPAN
);
### Methods
sub new {
bless {}, shift;
}
sub to_number {
my ($self, $text) = @_;
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
view release on metacpan or search on metacpan
lib/Acme/Grep2D.pm view on Meta::CPAN
=cut
sub new {
my ($class, %opts) = @_;
my $self = \%opts;
bless $self, $class;
$.Class = $class;
./_required('text');
./_init();
return $self;
}
view release on metacpan or search on metacpan
lib/Acme/Gtk2/Ex/Builder.pm view on Meta::CPAN
sub contain (&) { @_ }
sub build (&) {
my $code = shift;
my $self = bless {
_info => {},
_widget => {},
_current => [],
}, __PACKAGE__;
view release on metacpan or search on metacpan
lib/Acme/HTTP.pm view on Meta::CPAN
unless (defined $hdl) {
$@ = 'Acme::HTTP - Internal error, hdl is undefined';
return;
}
bless { hdl => $hdl };
}
sub read_entity_body {
my $self = shift;
view release on metacpan or search on metacpan
HaltingProblem.pm view on Meta::CPAN
sub new {
my $class = shift;
my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
die "No code provided for analysis" unless $self->{Machine};
$self->{Input} = [ ] unless ref($self->{Input}) eq 'ARRAY';
return bless $self, $class;
}
sub analyse {
my $self = shift;
eval { $self->{Machine}->(@{ $self->{Input} }); };
view release on metacpan or search on metacpan
lib/Acme/Has/Tiny.pm view on Meta::CPAN
our $AUTHORITY = "cpan:TOBYINK";
our $VERSION = "0.002";
use B qw(perlstring);
use Scalar::Util qw(blessed);
our %ATTRIBUTES;
our %VALIDATORS;
sub _croak ($;@)
lib/Acme/Has/Tiny.pm view on Meta::CPAN
my $buildargs = $options{buildargs} || $default_buildargs;
my $code = sub
{
my $class = shift;
my $self = bless($class->$buildargs(@_), $class);
$me->assert_valid($class, $self);
$self->$build if $options{build};
return $self;
};
lib/Acme/Has/Tiny.pm view on Meta::CPAN
my $me = shift;
my ($class, $attr, $spec, $method) = @_;
my $inlined;
my $isa = $spec->{isa};
if (blessed($isa) and $isa->isa('Type::Tiny') and $isa->can_be_inlined)
{
$inlined = $isa->inline_assert('$_[1]');
}
elsif ($isa)
{
lib/Acme/Has/Tiny.pm view on Meta::CPAN
my $me = shift;
my ($class, $attr, $spec, $method) = @_;
my $inlined;
my $isa = $spec->{isa};
if (blessed($isa) and $isa->can_be_inlined)
{
$inlined = $isa->inline_assert('$_[1]');
}
elsif ($isa)
{
lib/Acme/Has/Tiny.pm view on Meta::CPAN
map perlstring($_), $a, $a, $class,
);
}
my $isa = $spec->{isa};
if (blessed($isa) and $isa->can_be_inlined)
{
push @code, (
sprintf('if (exists($self->{%s})) {', $a),
$isa->inline_assert(sprintf '$self->{%s}', perlstring($a)),
'}',
lib/Acme/Has/Tiny.pm view on Meta::CPAN
Returns the hashref or dies.
sub new {
my ($class, %params) = @_;
...; # other stuff here
my $self = bless(
Acme::Has::Tiny->assert_valid($class, \%params),
$class,
);
...; # other stuff here
return $self;
view release on metacpan or search on metacpan
lib/Acme/Hello.pm view on Meta::CPAN
$class = ref($class) if (ref $class);
$args{lh} ||= Acme::Hello::I18N->get_handle($args{language})
or die "Cannot find handle for language: $args{language}.\n";
return bless(\%args, $class);
}
sub hello {
my $self = ref($_[0]) ? $_[0] : __PACKAGE__->new;
view release on metacpan or search on metacpan
lib/Acme/HidamariSketch.pm view on Meta::CPAN
return $SINGLETON;
}
else {
my $class = shift;
my $SINGLETON = bless {characters => [], year => 'third'}, $class;
$SINGLETON->_init;
return $SINGLETON;
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
view release on metacpan or search on metacpan
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
$VERSION = '0.03';
@ISA = qw( Exporter DynaLoader );
@EXPORT = qw( holy );
@EXPORT_OK = qw( blessed divine hallowed consecrated sacred sacrosanct );
bootstrap Acme::Holy $VERSION;
1;
__END__
=pod
=head1 NAME
Acme::Holy - Test whether references are blessed.
=head1 SYNOPSIS
use Acme::Holy;
my $ref = ... some reference ...
my $obj = bless $ref , 'Some::Class';
print holy( $obj ); # prints 'Some::Class'
print ( holy [] ? 'object' : 'not object' ); # prints 'not object'
=head1 WARNING
This module is a classic case of reinventing the wheel and not enough
RTFM. Unless you really like having terms such as C<holy> in your code, you
should use the official "holy" implementation now found in the Perl core:
L<Scalar::Util>. There you will find the C<blessed> function which behaves
identically to C<holy()>.
... Oh well, on with the show ...
=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,
if we don't have an object, just a normal reference, then attempting to call
C<isa()> through it will result in a run-time error.
B<holy()> is a quick, single test to determine if a given scalar represents
an object (i.e. a blessed reference).
=head2 EXPORT
By default, B<Acme::Holy> exports the method B<holy()> into the current
=over 4
=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
To reflect that there are many terms for referring to something that is
blessed, B<Acme::Holy> offers a list of aliases for B<holy()> that may be
imported upon request:
use Acme::Holy qw( blessed );
The following aliases are supported:
=over 4
=item * B<blessed()>
=item * B<consecrated()>
=item * B<divine()>
already written it.
=head1 SEE ALSO
L<Scalar::Util> (oops!), L<bless|perlfunc/bless>, L<perlboot>, L<perltoot>,
L<perltooc>, L<perlbot>, L<perlobj>.
=head1 AUTHOR
view release on metacpan or search on metacpan
lib/Acme/Hospital/Bed.pm view on Meta::CPAN
my ($package, %args) = @_;
$args{total_num_of_rooms} ||= 20;
$args{lifes} ||= 3;
$args{rooms} ||= [];
$args{max_length_of_stay} ||= $args{total_num_of_rooms}*2;
my $self = bless \%args, $package;
unless ($self->{names}) {
$self->{names} = [
qw/rob robert ben tom dean dennis ruby roxy jane michelle larry liane leanne anne axel/
];
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
view release on metacpan or search on metacpan
script/gen-generic-ind-company-names view on Meta::CPAN
# } else {
# # Shallow copy anything else; this handles a reference to code, glob, regex
# $CloneCache{ $source } = $copy = $source;
# }
#
# # - Bless it into the same class as the original, if it was blessed;
# # - If it has a post-cloning initialization method, call it.
# if ( $class_name ) {
# bless $copy, $class_name;
# $copy->$CloneInitMethod() if $copy->can($CloneInitMethod);
# }
#
# return $copy;
#}
script/gen-generic-ind-company-names view on Meta::CPAN
# $attrs{ignore_unknown_directive} //= 0;
# # allow_encodings
# # disallow_encodings
# # allow_directives
# # disallow_directives
# bless \%attrs, $class;
#}
#
## borrowed from Parse::CommandLine. differences: returns arrayref. return undef
## on error (instead of dying).
#sub _parse_command_line {
script/gen-generic-ind-company-names view on Meta::CPAN
# elsif ($ref eq 'Math::BigInt') { $e = $e->bstr; $ref = ref($e) }
# elsif ($ref eq 'Regexp') { $e = "$e"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $e = ${ $e }; $ref = ref($e) }
# elsif ($ref eq 'Time::Moment') { $e = $e->epoch; $ref = ref($e) }
# elsif ($ref eq 'version') { $e = "$e"; $ref = "" }
# elsif (Scalar::Util::blessed($e)) { my $reftype = Scalar::Util::reftype($e); $e = $reftype eq "HASH" ? {%{ $e }} : $reftype eq "ARRAY" ? [@{ $e }] : $reftype eq "SCALAR" ? \(my $copy = ${ $e }) : $reftype eq "CODE" ? sub { goto &{ $e } } :(die "...
# my $reftype=Scalar::Util::reftype($e)//"";
# if ($reftype eq "ARRAY") { $process_array->($e) }
# elsif ($reftype eq "HASH") { $process_hash->($e) }
# elsif ($ref) { $e = $ref; $ref = "" }
#} } }
script/gen-generic-ind-company-names view on Meta::CPAN
# elsif ($ref eq 'Math::BigInt') { $h->{$k} = $h->{$k}->bstr; $ref = ref($h->{$k}) }
# elsif ($ref eq 'Regexp') { $h->{$k} = "$h->{$k}"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $h->{$k} = ${ $h->{$k} }; $ref = ref($h->{$k}) }
# elsif ($ref eq 'Time::Moment') { $h->{$k} = $h->{$k}->epoch; $ref = ref($h->{$k}) }
# elsif ($ref eq 'version') { $h->{$k} = "$h->{$k}"; $ref = "" }
# elsif (Scalar::Util::blessed($h->{$k})) { my $reftype = Scalar::Util::reftype($h->{$k}); $h->{$k} = $reftype eq "HASH" ? {%{ $h->{$k} }} : $reftype eq "ARRAY" ? [@{ $h->{$k} }] : $reftype eq "SCALAR" ? \(my $copy = ${ $h->{$k} }) : $reftype eq "...
# my $reftype=Scalar::Util::reftype($h->{$k})//"";
# if ($reftype eq "ARRAY") { $process_array->($h->{$k}) }
# elsif ($reftype eq "HASH") { $process_hash->($h->{$k}) }
# elsif ($ref) { $h->{$k} = $ref; $ref = "" }
#} } }
script/gen-generic-ind-company-names view on Meta::CPAN
# elsif ($ref eq 'Math::BigInt') { $_ = $_->bstr; $ref = ref($_) }
# elsif ($ref eq 'Regexp') { $_ = "$_"; $ref = "" }
# elsif ($ref eq 'SCALAR') { $_ = ${ $_ }; $ref = ref($_) }
# elsif ($ref eq 'Time::Moment') { $_ = $_->epoch; $ref = ref($_) }
# elsif ($ref eq 'version') { $_ = "$_"; $ref = "" }
# elsif (Scalar::Util::blessed($_)) { my $reftype = Scalar::Util::reftype($_); $_ = $reftype eq "HASH" ? {%{ $_ }} : $reftype eq "ARRAY" ? [@{ $_ }] : $reftype eq "SCALAR" ? \(my $copy = ${ $_ }) : $reftype eq "CODE" ? sub { goto &{ $_ } } :(die "...
# my $reftype=Scalar::Util::reftype($_)//"";
# if ($reftype eq "ARRAY") { $process_array->($_) }
# elsif ($reftype eq "HASH") { $process_hash->($_) }
# elsif ($ref) { $_ = $ref; $ref = "" }
#}
script/gen-generic-ind-company-names view on Meta::CPAN
#
# my $caller = caller(0);
# $per_target_conf{category} = $caller
# if !defined($per_target_conf{category});
# my $obj = []; $obj =~ $re_addr;
# my $pkg = "Log::ger::Obj$1"; bless $obj, $pkg;
# add_target(object => $obj, \%per_target_conf);
# if (keys %Global_Hooks) {
# require Log::ger::Heavy;
# init_target(object => $obj, \%per_target_conf);
# } else {
script/gen-generic-ind-company-names view on Meta::CPAN
# return -1;
#}
#
#sub _json {
# state $json = do {
# if (eval { require Cpanel::JSON::XS; 1 }) { Cpanel::JSON::XS->new->canonical(1)->convert_blessed->allow_nonref }
# elsif (eval { require JSON::Tiny::Subclassable; 1 }) { JSON::Tiny::Subclassable->new }
# elsif (eval { require JSON::PP; 1 }) { JSON::PP->new->canonical(1)->convert_blessed->allow_nonref }
# else { die "Can't find any JSON module" }
# };
# $json;
#};
#
view release on metacpan or search on metacpan
lib/Acme/IEnumerable.pm view on Meta::CPAN
use warnings;
use v5.10;
use Carp;
sub _create {
bless {
_list => $_[0],
_zero => 0,
_last => scalar(@{ $_[0] }) - 1,
_dir => 1,
_new => $_[1],
lib/Acme/IEnumerable.pm view on Meta::CPAN
my ($self) = @_;
return $self->to_list unless $self->count;
my $new;
$new = bless {
_list => $self->{_list},
_last => 0,
_zero => scalar(@{ $self->{_list} }) - 1,
_dir => -1,
_new => sub {
lib/Acme/IEnumerable.pm view on Meta::CPAN
use v5.10;
use Carp;
use base qw/Acme::IEnumerable/;
sub _create {
bless {
_key => $_[0],
_sgn => $_[1],
_par => $_[2],
_new => $_[3],
}, __PACKAGE__;
lib/Acme/IEnumerable.pm view on Meta::CPAN
sub from_list {
my $class = shift;
my $key = shift;
my $self = Acme::IEnumerable->from_list(@_);
$self->{key} = $key;
bless $self, __PACKAGE__;
}
sub key { $_[0]->{key} }
1;
lib/Acme/IEnumerable.pm view on Meta::CPAN
*order_by_descending =
\&Acme::IEnumerable::Ordered::then_by_descending;
};
sub _create {
bless {
_new => $_[0],
}, __PACKAGE__;
}
sub new { $_[0]->{_new}->() }
view release on metacpan or search on metacpan
lib/Acme/IRC/Art.pm view on Meta::CPAN
foreach my $temp2 (0..$largeur) {
$canevas[$temp][$temp2] = " ";
}
}
my $self = {};
bless ($self,$class);
$self->{canevas} = [@canevas];
return $self;
}
=pod
view release on metacpan or search on metacpan
lib/Acme/Ikamusume.pm view on Meta::CPAN
use Lingua::JA::Kana;
use Text::Mecabist;
sub geso {
my $self = bless { }, shift;
my $text = shift // "";
my $parser = Text::Mecabist->new({
userdic => dist_file('Acme-Ikamusume', Text::Mecabist->encoding->name .'.dic'),
});
view release on metacpan or search on metacpan
lib/Acme/InputRecordSeparatorIsRegexp.pm view on Meta::CPAN
}
my $rs = shift @opts;
my %opts = @opts;
$opts{maxrecsize} ||= ($opts{bufsize} || 16384) / 4;
$opts{bufsize} ||= $opts{maxrecsize} * 4;
my $self = bless {
%opts,
handle => $handle,
rs => $rs,
records => [],
buffer => ''
view release on metacpan or search on metacpan
lib/Acme/Insult/Evil.pm view on Meta::CPAN
$api->query_form( type => 'json', ( defined $params{language} ? ( lang => delete $params{language} ) : () ), %params );
my $res = $http->get($api); # {success} is true even when advice is not found but we'll at least know when we have valid JSON
$res->{success} ? decode_json( $res->{content} ) : ();
}
#
sub insult (%args) { my $ref = _http(%args); $ref ? bless $ref, __PACKAGE__ : $ref }
}
1;
__END__
=encoding utf-8
lib/Acme/Insult/Evil.pm view on Meta::CPAN
Insult's language. The default is C<en>. Supported languages include: C<en>, C<fr>, C<cn>, C<ja>, C<es>, etc.
=back
On success, an insult is returned as a blessed hash reference containing the following data:
=over
=item C<active>
view release on metacpan or search on metacpan
lib/Acme/Insult/Glax.pm view on Meta::CPAN
$hey->query_form(%params);
my $res = $http->get( $hey->as_string ); # {success} is true even when advice is not found but we'll at least know when we have valid JSON
$res->{success} ? decode_json( $res->{content} ) : ();
}
#
sub insult (%args) { my $ref = _http( insult => %args ); $ref ? bless $ref, __PACKAGE__ : $ref }
sub adjective ( $lang //= 'en' ) {
my $ref = _http( adjective => ( lang => $lang ) );
$ref ? bless $ref, __PACKAGE__ : $ref;
}
}
1;
__END__
view release on metacpan or search on metacpan
lib/Acme/Insult/Pirate.pm view on Meta::CPAN
# This API only returns strings for now
#~ $res->{success} ? decode_json( $res->{content} ) : ();
$res->{success} ? { insult => $res->{content} } : ();
}
#
sub insult (%args) { my $ref = _http(%args); $ref ? bless $ref, __PACKAGE__ : $ref }
}
1;
__END__
=encoding utf-8
lib/Acme/Insult/Pirate.pm view on Meta::CPAN
Arr! Tear some rogue down.
my $shade = insult( ); # Random insult
print insult( ); # stringify
On success, an insult be returned as a blessed hash reference containin' the followin' data:
=over
=item C<insult>
view release on metacpan or search on metacpan
lib/Tie/Cycle.pm view on Meta::CPAN
use constant COUNT_COL => 1;
use constant ITEM_COL => 2;
sub TIESCALAR {
my( $class, $list_ref ) = @_;
my $self = bless [], $class;
unless( $self->STORE( $list_ref ) ) {
carp "The argument to Tie::Cycle must be an array reference";
return;
}
view release on metacpan or search on metacpan
inc/Module/Install.pm view on Meta::CPAN
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
view release on metacpan or search on metacpan
t/02hooks.t view on Meta::CPAN
ok( $die_msg, $errmsg ); #06
package Acme::JavaTrace::Test;
sub TIEHANDLE {
return bless {}, shift
}
sub PRINT {
my $self = shift;
$stderr .= join '', @_;
}
view release on metacpan or search on metacpan
lib/Acme/Keyakizaka46.pm view on Meta::CPAN
MihoWatanabe
);
sub new {
my $class = shift;
my $self = bless {members => []}, $class;
$self->_initialize;
return $self;
}
view release on metacpan or search on metacpan
lib/Acme/KeyboardMarathon.pm view on Meta::CPAN
sub new {
my @args = @_;
my $class = shift @args;
my $self = {};
bless($self,$class);
croak("Odd number of arguments") if @args%2;
my %args = @args;
my $layout = delete $args{layout} || 'qwerty';
croak("Unsupported layout $layout")
view release on metacpan or search on metacpan
lib/PerlIO/via/LAUTER_DEUTSCHER.pm view on Meta::CPAN
undef $fish;
}
sub PUSHED {
my $self = '';
bless \$self, shift;
}
sub FILL {
my ( $self, $fh ) = @_;
return defined $fh ? $self->_translate(<$fh>) : undef;
view release on metacpan or search on metacpan
lib/Acme/LSD.pm view on Meta::CPAN
use base qw<Tie::Handle>;
use Symbol qw<geniosym>;
my $TRUE_STDOUT;
sub TIEHANDLE { return bless geniosym, __PACKAGE__ }
sub PRINT {
shift;
local $\ = undef;