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/PlayCode/Plugin/DoubleToSingle.pm view on Meta::CPAN
my ( $token ) = @_;
if ( $token->isa('PPI::Token::Quote::Double') ) {
# XXX?
# why treat
# bless( {
# 'separator' => '"',
# 'content' => '"c\\n"'
# }, 'PPI::Token::Quote::Double' );
# "c\\n" as not interpolations
# bug?
view release on metacpan or search on metacpan
lib/Acme/Playpen/_common.pm view on Meta::CPAN
use strict;
use warnings;
sub new {
my $class = shift;
return bless {}, $class;
}
1;
view release on metacpan or search on metacpan
Playwright.pm view on Meta::CPAN
'fixes a turkey sandwich', 'starts making pancakes'
);
sub new {
my $class = shift;
my $self = bless {}, $class;
return $self;
}
sub RandomElement {
shift if UNIVERSAL::isa( $_[ 0 ], __PACKAGE__ );
view release on metacpan or search on metacpan
lib/Acme/ppport.h view on Meta::CPAN
sv_2uv_flags||5.009001|
sv_2uv|5.004000||p
sv_add_arena|||
sv_add_backref|||
sv_backoff|||n
sv_bless|||
sv_buf_to_ro|||
sv_buf_to_rw|||
sv_cat_decode||5.008001|
sv_catpv_flags||5.013006|
sv_catpv_mg|5.004050||p
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/PricelessMethods.pm view on Meta::CPAN
sub new {
my $self = shift;
my $object = { universe => 1 };
return bless $object, $self;
}
sub is_perl_installed {
my $self = shift;
view release on metacpan or search on metacpan
lib/Acme/Pythonic.pm view on Meta::CPAN
reports will be very welcome, just drop me a line!
=head1 THANKS
Damian Conway gave his full blessing if I wanted to write a module like
this based on his unpublished Language::Pythonesque. The code that
handles indentation is inspired by his.
Also, Dr. Conway is the author of L<Filter::Simple>, which aids a lot
blanking out PODs, strings, etc. so you can munge the source with
view release on metacpan or search on metacpan
lib/Acme/RPC.pm view on Meta::CPAN
# use Devel::Pointer;
use JSON;
use Data::Dumper;
use Devel::Caller 'caller_cv';
use PadWalker 'peek_sub';
use Scalar::Util 'blessed';
my $comment = <<'EOF';
Todo:
lib/Acme/RPC.pm view on Meta::CPAN
* Optionally require a password... use Acme::RPC password => whatever;
* entersubs=1, enterpackages=1, etc args to control how far the recurse goes in building $tree.
* Maybe don't recurse into blessed objects, but dump them nicely upon request.
Or maybe do recurse into them and dump their instance data.
If $oid is passed then recurse into arrays, hashes, and object instance data.
* We don't dump references found inside CODE in the main view.
But if they request a dump for that object, dump it.
lib/Acme/RPC.pm view on Meta::CPAN
* Should switch to our own recurse logic from Data::Dumper to support these other things.
* action=dump on anything; in the case of a coderef, find its source on disc or else deparse it
* action=call on coderefs and blessed objects, with an args parameter, or arg1, arg2, arg3, etc, and a method parameter for blessed objs.
* json will croak if a reference contains objects in side it somewhere. Should handle this gracefully.
* Offer JSON output! Not just Data::Dumper. Do this for action=dump, action=call, and the default tree view.
lib/Acme/RPC.pm view on Meta::CPAN
$request->print("<pre>$buf</pre>\n");
} else {
if($output and $output eq 'json') {
$ob = tryunref($ob, $request) or next;
$ob = tryunobject($ob, $request) or next;
$request->print(eval { to_json($ob, { ascii => 1, allow_unknown => 1, allow_blessed => 1, }, ) } || $@);
} else {
$ob = tryunref($ob, $request) or next;
$request->print("<pre>", Data::Dumper::Dumper($ob), "</pre>\n");
}
}
lib/Acme/RPC.pm view on Meta::CPAN
$i++;
}
if(ref($ob) eq 'CODE') {
@ret = $ob->(@args);
} elsif(blessed($ob)) {
my $method = $request->param('method');
$ob->can($method) or do { $request->print("object does not define that method"); next; };
@ret = $ob->can($method)->($ob, @args);
}
lib/Acme/RPC.pm view on Meta::CPAN
}
reg( $node->{'$'.$k}{chr(0)} = $scalar ); # have to do this after assigning in from the recursive call
}
}
# end for %{$package}, if %{$package}
} elsif(my $class = blessed($object)) {
# classes... instance data, methods XXX
reg( $node->{chr(0)} = $object); # do this after any recursive call, probably replacing the chr(0) value that came back
$node->{chr(1)} = $class; # comment
# let's skip the instance data, for now
# if( UNIVERSAL::isa($ob, 'HASH') ) {
lib/Acme/RPC.pm view on Meta::CPAN
}
sub tryunobject {
my $ob = shift;
my $request = shift;
if( blessed($ob) and UNIVERSAL::isa($ob, 'HASH') ) {
$ob = { %$ob };
} elsif( blessed($ob) and UNIVERSAL::isa($ob, 'ARRAY') ) {
$ob = [ @$ob ];
} elsif( blessed($ob) and UNIVERSAL::isa($ob, 'SCALAR') ) {
$ob = \ ${$ob};
} elsif( blessed($ob) ) {
$request->print("object not blessed hash, array or scalar... no logic for converting to JSON, sorry");
return;
}
return $ob;
}
lib/Acme/RPC.pm view on Meta::CPAN
use Acme::RPC;
our $test2 = t2->new();
package t2;
sub new { bless { one => 1 }, $_[0] };
sub add { ($_[1] + $_[2]); }'
Then go to:
http://localhost:7777/?path=%24test2/add()&action=call&arg0=10&arg1=15
lib/Acme/RPC.pm view on Meta::CPAN
# $buf =~ s{(0x[a-f0-9]{6,})}{<a href="?oid=$1">$1</a>}g;
$request->print(qq{<pre>$buf</pre>\n});
* Accepts posts as well, and handle by data type.
Posts to CODE refs run them with the arguments (attempt to reconstitute object references in the arguments... move to 0x style oids again
to support this).
Posts to object references (blessed things) invoke the named method in them (again, reconstituting the args).
Posts to scalars, arrays, hashes, etc merely replace their data.
view release on metacpan or search on metacpan
open(LOG,">$options->{Log}")
or die "Cant write to logfile: $options->{Log}: $!";
LOG->autoflush(1);
}
my $obj = bless $self,$class;
$obj->RobotOption(3,1); # Use Select
$obj->RobotOption(1,1); # Rotation reached
return $obj
}
view release on metacpan or search on metacpan
lib/Acme/RandomQuote/Base.pm view on Meta::CPAN
=cut
sub new {
my ( $self, $filename ) = @_;
return bless \$filename => $self;
}
=head2 get_random_quote
Returns a random line from the selected file.
view release on metacpan or search on metacpan
lib/Acme/RemoteINC.pm view on Meta::CPAN
our $VERSION = 0.15;
sub new {
my($class, %args) = @_;
my $self = {};
bless $self, $class;
foreach my $k ( qw(ftp host user password perl_root) )
{ $self->{$k} = $args{$k} if $args{$k} }
unless( $self->{ftp} ) {
my $ftp = new Net::FTP($self->{host}) or return;
$ftp->login( $self->{user} => $self->{password} ) or 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
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/pms/RayApp.pm view on Meta::CPAN
my %options;
my $ua_options = delete $options{ua_options};
my $ua = new RayApp::UserAgent(
defined($ua_options) ? %$ua_options : ()
);
my $self = bless {
%options,
base => $base,
ua => $ua,
}, $class;
return $self;
view release on metacpan or search on metacpan
lib/Acme/RightSideOutObject.pm view on Meta::CPAN
my $weaken = grep $_ eq 'weaken', @_;
my $debug = grep $_ eq 'debug', @_;
my $id = Class::InsideOut::id($their_self) or die;
my $class = ref $their_self;
my %as_a_hash;
my $self = bless \%as_a_hash, $class;
my $our_id = Class::InsideOut::id($self) or die; # sooo bad
for my $sym (keys %{$class.'::'}) {
$debug and warn "$class\::$sym\n";
my $code = *{$class.'::'.$sym}{CODE} or next;
my $op = B::svref_2object($code) or next;
lib/Acme/RightSideOutObject.pm view on Meta::CPAN
print $rightside_out->greeting(), "\n"; # prints Hello, my name is Dork Face
=head1 DESCRIPTION
Exports C<guts()> which takes a L<Class::InsideOut> object and returns a normal
blessed hashref object.
One of the most serious flaws of Class::InsideOut is that it encapsulates data,
making it difficult to directly minipulate the object's internal state.
Attempting to inspect the reference to an inside out object with
L<Data::Dumper>, you'll find this:
$VAR1 = bless( do{\(my $o = undef)}, 'My::Class' );
Fear not! Acme::RightSideOutObject to the rescue!
Acme::RightSideOutObject work exactly like the inside out object it replaces
except that it is also a hashref full of the object's instance data.
view release on metacpan or search on metacpan
lib/Acme/Robd/Boring.pm view on Meta::CPAN
use Carp qw( carp );
sub new {
return bless {}, shift;
}
sub name { __PACKAGE__ }
view release on metacpan or search on metacpan
glob gmtime exp defined caller or binmode log ord
abs lc sqrt study alarm split time or formline cos
ne rewinddir kill chdir reset prototype split sqrt
ord int localtime abs oct pack pop eq scalar print
telldir open unpack return and unlink write chroot
hex bless utime split chown split close rmdir join
exp fileno getc sleep redo glob mkdir stat ne pack
reverse getpwnam next lstat gethostent and getpgrp
eq log ord time xor chr undef and eval caller and
printf srand lstat chown chdir syscall open select
eq -w closedir sleep chr split and quotemeta reset
view release on metacpan or search on metacpan
lib/Acme/Samurai.pm view on Meta::CPAN
use Unicode::Japanese qw/unijp/;
use Text::Mecabist;
sub gozaru {
my $self = bless { }, shift;
my $text = shift // "";
my $parser = Text::Mecabist->new({
node_format => '%m,%H',
unk_format => '%m,%H',
view release on metacpan or search on metacpan
t/000-report-versions.t view on Meta::CPAN
# Implementation
# Create an empty YAML::Tiny object
sub new {
my $class = shift;
bless [ @_ ], $class;
}
# Create an object from a file
sub read {
my $class = ref $_[0] ? ref shift : shift;
t/000-report-versions.t view on Meta::CPAN
}
# Create an object from a string
sub read_string {
my $class = ref $_[0] ? ref shift : shift;
my $self = bless [], $class;
my $string = $_[0];
unless ( defined $string ) {
return $self->_error("Did not provide a string to load");
}
t/000-report-versions.t view on Meta::CPAN
# Failed to load Scalar::Util
eval <<'END_PERL';
sub refaddr {
my $pkg = ref($_[0]) or return undef;
if (!!UNIVERSAL::can($_[0], 'can')) {
bless $_[0], 'Scalar::Util::Fake';
} else {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
my $i = do { local $^W; hex $1 };
bless $_[0], $pkg if defined $pkg;
$i;
}
END_PERL
} else {
Scalar::Util->import('refaddr');
view release on metacpan or search on metacpan
lib/Acme/Scurvy/Whoreson/BilgeRat/Backend/insultserver.pm view on Meta::CPAN
}
seek DATA, $pos,0;
return bless $self, $class;
}
sub generateinsult {
my $self =shift;
view release on metacpan or search on metacpan
lib/Acme/Scurvy/Whoreson/BilgeRat.pm view on Meta::CPAN
So, on to the most complex part of all this, which thankfully isn't that
complex.
To create a plugin, you create a bog-standard module, whose name is
Acme::Scurvy::Whoreson::BilgeRat::Backend::[your language name]. It should
be a subclass of A::S::W::B. The constructor should return a blessed
object and must be called new(). You then have two options:
=over 4
=item use the built-in insult generator
In this case, you simply need to define a suitable grammar and list of
words to generate insults from. You do this by having new() return
a blessed hashref with the following keys:
=over 4
=item grammars
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
}
sub TIEARRAY {
my $cls = shift;
my $d = undef;
bless \$d => $cls;
}
sub FETCH {
my $i = pop;
my $name = _signame($i);
view release on metacpan or search on metacpan
lib/Acme/Siteswap.pm view on Meta::CPAN
sub new {
my $class = shift;
my $self = { @_ };
die "A siteswap pattern is required!" unless defined $self->{pattern};
die "The number of balls is required!" unless defined $self->{balls};
bless $self, $class;
return $self;
}
=head2 valid
view release on metacpan or search on metacpan
my %stash;
sub TIESCALAR {
my $foo;
return bless \$foo, 'Acme::Snark';
}
sub FETCH {
my $t_obj = {value => ${$_[0]} };
bless($t_obj, 'Acme::Snark::HONK');
return $t_obj;
}
sub STORE {
if (defined($_[1]) && !$_[1]) {
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
lib/Acme/Sneeze.pm view on Meta::CPAN
our @EXPORT = qw(sneeze);
sub sneeze {
my $self = shift;
my $pkg = caller;
bless $self, $pkg;
}
1;
__END__
lib/Acme/Sneeze.pm view on Meta::CPAN
use Acme::Sneeze;
package Others;
my $object = Your::Object->new;
$object->sneeze; # "bless you!"
print ref($object); # will print "Others"
=head1 DESCRIPTION
When you sneeze in America (or other English speaking countries),
you'll be blessed. But the problem is that they say "Bless you"
without the 2nd parameter: the package name.
So with Acme::Sneeze, your object will have I<sneeze> method, and when
you sneeze you'll be automatically blessed to the current package.
=head1 TODO
=head2 LOCALIZATION
view release on metacpan or search on metacpan
lib/Acme/Songmu.pm view on Meta::CPAN
},
},
);
sub instance {
state $_instance = bless {
birthday => Time::Piece->strptime('1980-06-05', '%Y-%m-%d'),
first_name => 'Masayuki',
last_name => 'Matsuki',
}, __PACKAGE__;
}
view release on metacpan or search on metacpan
local/lib/perl5/Future.pm view on Meta::CPAN
no warnings 'recursion'; # Disable the "deep recursion" warning
our $VERSION = '0.34';
use Carp qw(); # don't import croak
use Scalar::Util qw( weaken blessed reftype );
use B qw( svref_2object );
use Time::HiRes qw( gettimeofday tv_interval );
# we are not overloaded, but we want to check if other objects are
require overload;
local/lib/perl5/Future.pm view on Meta::CPAN
}
sub new
{
my $proto = shift;
return bless {
ready => 0,
callbacks => [], # [] = [$type, ...]
( DEBUG ?
( do { my $at = Carp::shortmess( "constructed" );
chomp $at; $at =~ s/\.$//;
local/lib/perl5/Future.pm view on Meta::CPAN
sub wrap
{
my $class = shift;
my @values = @_;
if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) {
return $values[0];
}
else {
return $class->done( @values );
}
local/lib/perl5/Future.pm view on Meta::CPAN
return a future. In normal circumstances is equivalent to
$future = $code->( @args )
except that if the code throws an exception, it is wrapped in a new immediate
fail future. If the return value from the code is not a blessed C<Future>
reference, an immediate fail future is returned instead to complain about this
fact.
=cut
local/lib/perl5/Future.pm view on Meta::CPAN
my $class = shift;
my ( $code, @args ) = @_;
my $f;
eval { $f = $code->( @args ); 1 } or $f = $class->fail( $@ );
blessed $f and $f->isa( "Future" ) or $f = $class->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
return $f;
}
sub _shortmess
local/lib/perl5/Future.pm view on Meta::CPAN
$fail ? $self->failure :
();
foreach my $cb ( @$callbacks ) {
my ( $flags, $code ) = @$cb;
my $is_future = blessed( $code ) && $code->isa( "Future" );
next if $done and not( $flags & CB_DONE );
next if $fail and not( $flags & CB_FAIL );
next if $cancelled and not( $flags & CB_CANCEL );
local/lib/perl5/Future.pm view on Meta::CPAN
unless( eval { $f2 = $code->( @args ); 1 } ) {
$fseq->fail( $@ );
next;
}
unless( blessed $f2 and $f2->isa( "Future" ) ) {
$fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
next;
}
$fseq->on_cancel( $f2 );
local/lib/perl5/Future.pm view on Meta::CPAN
sub on_cancel
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_cancel";
$self->{ready} and return $self;
local/lib/perl5/Future.pm view on Meta::CPAN
sub on_ready
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_ready";
if( $self->{ready} ) {
my $fail = defined $self->{failure};
local/lib/perl5/Future.pm view on Meta::CPAN
sub unwrap
{
shift; # $class
my @values = @_;
if( @values == 1 and blessed $values[0] and $values[0]->isa( __PACKAGE__ ) ) {
return $values[0]->get;
}
else {
return $values[0] if !wantarray;
return @values;
local/lib/perl5/Future.pm view on Meta::CPAN
sub on_done
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_done";
if( $self->{ready} ) {
return $self if $self->{failure} or $self->{cancelled};
local/lib/perl5/Future.pm view on Meta::CPAN
sub on_fail
{
my $self = shift;
my ( $code ) = @_;
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future or _callable( $code ) or
Carp::croak "Expected \$code to be callable or a Future in ->on_fail";
if( $self->{ready} ) {
return $self if not $self->{failure};
local/lib/perl5/Future.pm view on Meta::CPAN
return $self if $self->{ready};
$self->{cancelled}++;
foreach my $code ( reverse @{ $self->{on_cancel} || [] } ) {
my $is_future = blessed( $code ) && $code->isa( "Future" );
$is_future ? $code->cancel
: $code->( $self );
}
$self->_mark_ready( "cancel" );
local/lib/perl5/Future.pm view on Meta::CPAN
my $fseq;
unless( eval { $fseq = $code->( @args ); 1 } ) {
return Future->fail( $@ );
}
unless( blessed $fseq and $fseq->isa( "Future" ) ) {
return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
}
return $fseq;
}
local/lib/perl5/Future.pm view on Meta::CPAN
{
shift; # ignore this class
my ( $subs ) = @_;
foreach my $sub ( @$subs ) {
blessed $sub and $sub->isa( "Future" ) or Carp::croak "Expected a Future, got $_";
}
# Find the best prototype. Ideally anything derived if we can find one.
my $self;
ref($_) eq "Future" or $self = $_->new, last for @$subs;