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
sub TEST
{
my ($got, $expected, $true) = (@_,0);
unless ("$got" eq "$expected") {
print "\tline ", (caller)[2], "\n";
print "\texpected: ";
print $expected;
print "\n";
print "\tbut got: ";
print $got;
print "not ";
}
print "ok ", $test++, "\n";
unless (($got?1:0) == ($true?1:0)) {
print "\tline ", (caller)[2], "\n";
print "\texpected: ";
print $true ? "true" : "false";
print "\n";
print "\tbut got: ";
print $got ? "true" : "false";
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
$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||= 0;our$VERSION='5.70';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}s...
EXPORTER
$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok...
EXPORTER_HEAVY
$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.009';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {...
FILE_PUSHD
view release on metacpan or search on metacpan
lib/SPVM/HTTP/Tiny/Util.spvm view on Meta::CPAN
return join '-', Crypt::Misc::encode_b64($ct), Crypt::Misc::encode_b64($iv), Crypt::Misc::encode_b64($tag);
}
sub extract_usage {
my $file = @_ ? "$_[0]" : (caller)[1];
open my $handle, '>', \my $output;
pod2usage -exitval => 'noexit', -input => $file, -output => $handle;
$output =~ s/^.*\n|\n$//;
$output =~ s/\n$//;
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};