view release on metacpan or search on metacpan
lib/Plugin/Simple.pm view on Meta::CPAN
{
no warnings 'redefine';
no strict 'refs';
my $pkg = (caller)[0];
*{"$pkg\::$sub_name"} = \&_plugins;
}
}
sub _new {
my ($class, %args) = @_;
lib/Plugin/Simple.pm view on Meta::CPAN
if (@_){
croak "usage: plugins(['Load::From'], [can => 'sub']), " .
"in that order\n";
}
my $pkg = (caller)[0];
my @plugins;
if ($item){
if ($item =~ /(?:\.pm|\.pl)/){
my $abs_path;
view release on metacpan or search on metacpan
t/cpan/Mojo/File.pm view on Meta::CPAN
my ($self, $to) = @_;
copy($$self, $to) or croak qq{Can't copy file "$$self" to "$to": $!};
return $self->new(-d $to ? ($to, File::Basename::basename $self) : $to);
}
sub curfile { __PACKAGE__->new(Cwd::realpath((caller)[1])) }
sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }
sub extname { shift->basename =~ /.+\.([^.]+)$/ ? $1 : '' }
view release on metacpan or search on metacpan
lib/Pod/WSDL/AUTOLOAD.pm view on Meta::CPAN
if ($attr eq "DESTROY"){
return;
} elsif (exists $me->{'_' . $attr}) {
no strict 'refs';
if (defined $param) {
croak ref ($me) . " does not allow setting of '$attr', died" if (caller)[0] ne ref($me) and %$fbd and $fbd->{$attr} and !$fbd->{$attr}->{set};
$me->{'_' . $attr} = $param;
return $me;
} else {
croak ref ($me) . " does not allow getting of '$attr', died" if (caller)[0] ne ref($me) and %$fbd and $fbd->{$attr} and !$fbd->{$attr}->{get};
#if (ref $me->{'_' . $attr} eq 'ARRAY') {
# return @{$me->{'_' . $attr}};
#} elsif (ref $me->{'_' . $attr} eq 'HASH') {
# return %{$me->{'_' . $attr}};
#} elsif (ref $me->{'_' . $attr} eq 'SCALAR') {
view release on metacpan or search on metacpan
t/Preproc-Tiny.t view on Meta::CPAN
sub test {
my($in, $out) = @_;
write_input($in);
ok 1, "line ".(caller)[2]." - call script";
unlink @out_files;
ok 0 == system $^X, 'blib/bin/pp.pl', @in_files;
check_output($out);
ok 1, "line ".(caller)[2]." - call module";
unlink @out_files;
ok 0 == system $^X, 'blib/lib/Preproc/Tiny.pm', @in_files;
check_output($out);
ok 1, "line ".(caller)[2]." - use module";
unlink @out_files;
pp(@in_files);
check_output($out);
unlink @in_files, @out_files;
view release on metacpan or search on metacpan
lib/Prophet/App.pm view on Meta::CPAN
my $class = $args{'module'};
# Quick hack to silence warnings.
# Maybe some dependencies were lost.
unless ($class) {
warn sprintf( "no class was given at %s line %d\n", (caller)[ 1, 2 ] );
return 0;
}
return 1 if $self->already_required($class);
view release on metacpan or search on metacpan
qtcore/lib/QtCore4.pm view on Meta::CPAN
$::INC{'Qt/GlobalSpace.pm'} = $::INC{'QtCore4.pm'};
}
sub import {
my $class = shift;
my $caller = (caller)[0];
$caller .= '::';
foreach my $subname ( @_ ) {
next unless grep( $subname, @EXPORT_OK );
Qt::_internal::installSub( $caller.$subname, sub {
view release on metacpan or search on metacpan
qtcore/lib/QtCore4.pm view on Meta::CPAN
$::INC{'Qt/GlobalSpace.pm'} = $::INC{'QtCore4.pm'};
}
sub import {
my $class = shift;
my $caller = (caller)[0];
$caller .= '::';
foreach my $subname ( @_ ) {
next unless grep( $subname, @EXPORT_OK );
Qt::_internal::installSub( $caller.$subname, sub {
view release on metacpan or search on metacpan
Entanglement.pm view on Meta::CPAN
# allows for other functions to be performed accross states, can take
# as many entangled variables as you like...
# can take code ref, or "symbolic" function name (eg. p_func('substr', ..))
sub p_func {
my $func = shift;
my $package = (caller)[0];
# build up the function call by shifting off
# entangled variables until something isn't entangled
my $foo = ref($func) ? "&\$func(" : "$func(";
my @temp = @_;
my $first = $temp[0];
view release on metacpan or search on metacpan
package Quine;
$VERSION = '1.01';
sub import {
my $file = (caller)[1];
local ($/, *FILE);
open FILE, $file;
print STDOUT <FILE>;
close FILE;
exit;
view release on metacpan or search on metacpan
lib/RDF/Cowl/Lib.pm view on Meta::CPAN
$ffi;
};
}
sub mangler_default {
my $target = (caller)[0];
my $prefix = 'cowl';
sub {
my ($name) = @_;
"${prefix}_$name";
}
view release on metacpan or search on metacpan
);
}
sub get {
my $self = shift;
my $caller = (caller)[0];
return $self if $caller->isa(__PACKAGE__) || $caller->isa('RDF::Laces');
# return a tied hash which does.... things
my %hash;
tie %hash, 'RDF::Laces::Tie', $self;
view release on metacpan or search on metacpan
lib/RDFStore/Parser/NTriples.pm view on Meta::CPAN
};
sub addTriple {
my ($class,$subject,$predicate,$object,$context) = @_;
#print STDERR "addTriple('".$subject->toString."','".$predicate->toString."','".$object->toString."'".( ($context) ? ",'".$context->toString."'" : '' ).")",((caller)[2]),"\n";
# If there is no subject (about=""), then use the URI/filename where the RDF description came from
$subject = $class->{nodeFactory}->createResource($class->{sSource})
unless( (defined $subject) && ($subject->toString()) && (length($subject->toString())>0) );
lib/RDFStore/Parser/NTriples.pm view on Meta::CPAN
};
sub newReificationID {
my ($class) = @_;
#print STDERR "newReificationID($class): ",((caller)[2]),"\n";
return 'genid' . $class->{iReificationCounter}++;
};
1;
view release on metacpan or search on metacpan
lib/RPC/Serialized/Exceptions.pm view on Meta::CPAN
use Carp;
{
no warnings 'redefine';
sub Carp::carp {
die Carp::shortmess @_ if (caller)[0] =~ m/Data::Serializer/;
warn Carp::shortmess @_;
}
}
}
view release on metacpan or search on metacpan
lib/Ravenel/Document.pm view on Meta::CPAN
$self->{'document_is_totally_dynamic'} = $option->{'document_is_totally_dynamic'};
$self->{'arguments'} = $option->{'arguments'};
$self->{'tags'} = [];
$self->{'functions'} = $option->{'functions'};
$self->{'caller'} = $option->{'caller'} || (caller)[1];
if ( not $self->{'dynamic'} ) { # if static
confess("'name' required if not dynamically generated (dynamic=$self->{'dynamic'}, name=$self->{'name'})") if ( not $self->{'name'} );
# get the libraries
$self->{'lib_path'} = &get_libraries();
lib/Ravenel/Document.pm view on Meta::CPAN
my $option = shift;
confess("Option hash required") if ( not $option or not ref($option) );
$option->{'dynamic'} = ( defined($option->{'dynamic'}) ? $option->{'dynamic'} : 1 );
$option->{'caller'} = (caller)[1];
my Ravenel::Document $document = new Ravenel::Document($option);
$document->{'document_is_totally_dynamic'} = $option->{'dynamic'};
view release on metacpan or search on metacpan
$string =~ m/$regexp/;
my $cnt = 1;
if($USE_NAMED_VAR){
my $pkg = (caller)[0];
foreach my $field (@field){
my $t = ref($filter[$cnt]) eq 'CODE'? $filter[$cnt]->(${$cnt}) : ${$cnt};
$cnt++;
${"${pkg}::$field"} = $t;
}
view release on metacpan or search on metacpan
t/TestSuite.pm view on Meta::CPAN
=back
=cut
sub RCD_load_patterns ( ) {
my $fn = (caller)[1];
$fn =~ s{\.t$}{.yaml};
if( $Y_Choice->[0] eq q|tiny| ) {
my $yaml = YAML::Tiny->read( $fn );
defined $yaml or Test::More::BAIL_OUT(
qq|YAML::Tiny has this to say: | . YAML::Tiny->errstr );
view release on metacpan or search on metacpan
lib/Rex/Dondley/ProcessTaskArgs.pm view on Meta::CPAN
foreach my $key (keys %passed_params) {
my $is_valid = grep { $_ eq $key } keys %valid_keys;
if (!$is_valid) {
push @invalid_keys, $key;
}
die ("Invalid key(s): '" . join (', ', @invalid_keys) . "' from ". (caller)[1] . ', line ' . (caller)[2]) if @invalid_keys;
}
# Populate the %passed_params hash with @unkeyed_args according
# to same order they were passed to this function via @valid_args.
lib/Rex/Dondley/ProcessTaskArgs.pm view on Meta::CPAN
shift @all_array_args;
last;
}
}
die ('Too many array arguments passed from ' . (caller)[1] . ', line ' . (caller)[2] ) if @all_array_args;
}
# Ensure required args are present
my @reqd_keys = grep { $valid_keys{$_} } keys %valid_keys;
lib/Rex/Dondley/ProcessTaskArgs.pm view on Meta::CPAN
foreach my $rkey(@reqd_keys) {
if (!exists $passed_params{$rkey} || $passed_params{$rkey} eq '1') {
push @missing_keys, $rkey unless $defaults{$rkey};
}
}
die ("Missing required key(s): '" . join (', ', @missing_keys) . "' from " . (caller)[1] . ', line ' . (caller)[2]) if @missing_keys;
# handle edge case when user passes key without value
foreach my $key (keys %passed_params) {
if ($passed_params{$key} && $passed_params{$key} eq '1' && $valid_keys{$key}) {
delete $passed_params{$key};
view release on metacpan or search on metacpan
local/lib/perl5/Moo/Role.pm view on Meta::CPAN
if ($INC{'Moo/HandleMoose.pm'} && !$Moo::sification::disabled) {
Moo::HandleMoose::inject_fake_metaclass_for($new_name);
}
$COMPOSED{class}{$new_name} = 1;
_set_loaded($new_name, (caller)[1]);
return $new_name;
}
sub apply_roles_to_object {
my ($me, $object, @roles) = @_;
my $new = $me->SUPER::apply_roles_to_object($object, @roles);
my $class = ref $new;
_set_loaded($class, (caller)[1]);
my $apply_defaults = exists $APPLY_DEFAULTS{$class} ? $APPLY_DEFAULTS{$class}
: $APPLY_DEFAULTS{$class} = do {
my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles;
view release on metacpan or search on metacpan
lib/Rose/DB/Object/Manager.pm view on Meta::CPAN
my %args = @_;
local $Debug = $args{'debug'} if(exists $args{'debug'});
my $calling_class = ($class eq __PACKAGE__) ? (caller)[0] : $class;
my $target_class = $args{'target_class'} || $calling_class;
my $object_class = $args{'object_class'};
my $class_invocant = UNIVERSAL::isa($target_class, __PACKAGE__) ?
$target_class : __PACKAGE__;
view release on metacpan or search on metacpan
lib/Rose/DBx/MoreConfig.pm view on Meta::CPAN
$classpm =~ s[::__RoseDBPrivate__::.*\.pm$][.pm];
$classpm =~ s[::][/]g;
$classpm = $INC{$classpm} || $classpm;
}
else {
$classpm = (caller)[1];
}
$classpm = File::Spec->catfile( dirname($classpm), '.rosedbrc' );
# Hush warnings from Rose::DB::load_yaml_fixup_file() about data
# sources the current class doesn't implement
view release on metacpan or search on metacpan
lib/Rose/HTML/Object.pm view on Meta::CPAN
foreach my $arg (@_)
{
if($arg eq ':customize')
{
$class->import_methods(
{ target_class => (caller)[0] },
qw(object_type_class_exists object_type_class_keys
delete_object_type_class object_type_classes
clear_object_type_classes object_type_class
inherit_object_type_classes object_type_classes_cache
inherit_object_type_class add_object_type_classes
lib/Rose/HTML/Object.pm view on Meta::CPAN
{
my($this_class) = shift;
my $options = ref $_[0] && ref $_[0] eq 'HASH' ? shift : {};
my $target_class = $options->{'target_class'} || (caller)[0];
my(@search_classes, @parents);
@parents = ($this_class);
view release on metacpan or search on metacpan
lib/Rose/Object/MakeMethods.pm view on Meta::CPAN
return 1 unless(@_);
my($options, $args) = $class->_normalize_args(@_);
$options->{'target_class'} ||= (caller)[0];
$class->make_methods($options, $args);
return 1;
}
lib/Rose/Object/MakeMethods.pm view on Meta::CPAN
{
my($class) = shift;
my($options, $args) = $class->_normalize_args(@_);
$options->{'target_class'} ||= (caller)[0];
#use Data::Dumper;
#print STDERR Dumper($options);
#print STDERR Dumper($args);
lib/Rose/Object/MakeMethods.pm view on Meta::CPAN
#{
# $options = shift;
#}
#else { $options = {} }
#$options->{'target_class'} ||= (caller)[0];
my $options = shift;
my $method_type = shift;
my $methods = shift;
view release on metacpan or search on metacpan
t/lib/Rubyish/AttributeOld.pm view on Meta::CPAN
}
}
};
for my $field (@_) {
*{(caller)[0] . "::" . $field} = $make_accessor->($field);
}
}
=head2 attr_reader(@list)
t/lib/Rubyish/AttributeOld.pm view on Meta::CPAN
}
}
};
for my $field (@_) {
*{(caller)[0] . "::" . $field} = $make_reader->($field);
}
}
=head2 attr_writer(@list)
t/lib/Rubyish/AttributeOld.pm view on Meta::CPAN
}
}
};
for my $field (@_) {
*{(caller)[0] . "::" . $field} = $make_writer->($field);
}
}
=head1 DEPENDENCE
view release on metacpan or search on metacpan
lib/SPVM.pm view on Meta::CPAN
XSLoader::load('SPVM', $VERSION);
sub import {
my ($class, $class_name) = @_;
my ($file, $line) = (caller)[1, 2];
if (defined $class_name) {
SPVM::Global::build_class($class_name, $file, $line);
}
}
view release on metacpan or search on metacpan
lib/SQLite/Abstract.pm view on Meta::CPAN
$self->{q{tablename}}
or croak _err_msg("missing table name");
}
sub _err_msg {
__PACKAGE__ . q/:/ . (caller)[2] . q/:/ . __LINE__ . q/: / . "@_";
}
sub err : lvalue {
$_[1]
? $_[0]->{q{err}} = $_[1]
view release on metacpan or search on metacpan
lib/SWF/Element.pm view on Meta::CPAN
}
sub _create_flag_accessor {
no strict 'refs';
my ($name, $flagfield, $bit, $len) = @_;
my $pkg = (caller)[0];
$len ||=1;
my $field = (((1<<$len) - 1)<<$bit);
*{"${pkg}::$name"} = sub {
view release on metacpan or search on metacpan
lib/Scalar/Constant.pm view on Meta::CPAN
sub import {
my $module = shift;
my %constant = @_
or return;
my $calling_package = (caller)[0];
my @code;
while(my($name, $value) = each %constant) {
if(ref($value)) {
croak 'References are not supported';
}
view release on metacpan or search on metacpan
lib/Scalar/Random/PP/OO.pm view on Meta::CPAN
return if !$serial_id;
# mortal anonymous class
# XXX: cleaning stash with threads causes panic/SEGV.
if(exists $INC{'threads.pm'}) {
# (caller)[2] indicates the caller's line number,
# which is zero when the current thread is joining.
return if( (caller)[2] == 0);
}
# @ISA is a magical variable, so we clear it manually.
@{$self->{superclasses}} = () if exists $self->{superclasses};
view release on metacpan or search on metacpan
lib/Scrapar/Util.pm view on Meta::CPAN
for my $data (sort @array_data) {
$digest = md5_hex($data . $digest);
}
mkdir "/tmp/parray/";
my $filename = "/tmp/parray/" . join q/-/, (caller)[0], $digest ;
$ENV{SCRAPER_LOGGER}->info("parray filename: $filename");
my $X = Scrapar::PArray->new($filename);
$X->push(@array_data) if $X->{is_file_empty};
view release on metacpan or search on metacpan
Scripting/Expose.pm view on Meta::CPAN
sub import {
shift;
die "Odd number of arguments in use\n" if(@_ & 1);
my %args = (@_);
my $pkg = (caller)[0];
# Class name
my $name = $pkg;
$name = $args{as} if(exists $args{as});