view release on metacpan or  search on metacpan

lib/Devel/Examine/Subs.pm  view on Meta::CPAN

                    ? $INC{'Devel/Examine/Subs/Engine.pm'}
                    : 'lib/Devel/Examine/Subs/Engine.pm';
            },
    );

    my $caller = (caller)[1];

    open my $fh, '<', $caller
      or confess "can't open the caller file $caller: $!";

    my $code_found = 0;

 view release on metacpan or  search on metacpan

lib/Devel/Leak/Cb.pm  view on Meta::CPAN

	$LASTNAME = $_[0];
	return 1;
}

sub wrapper (&) {
	$DEF{int $_[0]} = [ $_[0], (caller)[0..2], $LASTNAME ];
	weaken($DEF{int $_[0]}[0]);
	subname($DEF{int $_[0]}[1].'::cb.'.$LASTNAME => $_[0]) if $LASTNAME;
	$LASTNAME = undef;
	return bless $_[0],'__cb__';
}

 view release on metacpan or  search on metacpan

lib/Devel/MaintBlead.pm  view on Meta::CPAN

Thank you for your attention.

SORRY

        my $line= (caller)[2];
        eval <<"BYEBYE" or print STDERR $@;
#line $line $0
require $REQUIRED;
BYEBYE
        exit 1;

 view release on metacpan or  search on metacpan

Messenger.pm  view on Meta::CPAN

        chomp($message[$#message]) if (substr($end, -1, 1) eq "\n");
        &$output($file, $begin, ($pre ? &$pre(caller) : ''), @message, $end);
    };
    # export subroutine
    if ($global) {
        #my $caller = (caller)[0];
        foreach my $pkg (sort grep { $_ ne 'Devel/Messenger.pm' } 'main', keys %INC) {
            (my $module = $pkg) =~ s/\.pm$//;
            $module =~ s/\//::/g;
            if (defined(&{"$module\::note"})) {
                no strict 'refs';

 view release on metacpan or  search on metacpan

t/lib/NYTProfTest.pm  view on Meta::CPAN

        $extra_options = {};
    }

    # obtain group from file name
    my $group;
    if ((caller)[1] =~ /([^\/\\]+)\.t$/) {
        $group = $1;
    } else {
        croak "Can't determine test group";
    }

 view release on metacpan or  search on metacpan

t/lib/SizemeTest.pm  view on Meta::CPAN

        }
        push @steps, [ $action, @args ];
    }

    # obtain group from file name
    my $group = ((caller)[1] =~ /([^\/\\]+)\.t$/) ? $1
        : croak "Can't determine test group";

    # .smt is "SizeMe Token" file
    my $smt_file_old = "$group.smt";
    my $smt_file_new = "$smt_file_old\-new.smt";

 view release on metacpan or  search on metacpan

lib/Devel/TraceUse.pm  view on Meta::CPAN

        CORE::require($arg);
    };
}

# initialize the tree of require calls
my $root = (caller)[1];

# keys in %TRACE:
# - ranked:    modules load attemps in chronological order
# - loaded_by: track "filename"s loaded by "filepath" (value from %INC)
# - used:      track loaded modules by "filename" (parameter to require)

 view release on metacpan or  search on metacpan

lib/Devel/Trepan/DB/SelfLoader.pm  view on Meta::CPAN

    $@ = $save;
    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
    goto &$AUTOLOAD
}

sub load_stubs { shift->_load_stubs((caller)[0]) }

sub _load_stubs {
    # $endlines is used by Devel::SelfStubber to capture lines after __END__
    my($self, $callpack, $endlines) = @_;
    no strict "refs";

 view release on metacpan or  search on metacpan

lib/Devel/Util.pm  view on Meta::CPAN

		sprintf("%dm%.3fs", int($d/60), $d - 60*int($d/60))
	};
	sub dt (&;$) {
		require Time::HiRes;
		my $block = shift;
		my $name = shift || sprintf 'dt at %s line %d', (caller)[1,2];
		my ($t_elapsed_0, $t_elapsed_1, $t_user_0, $t_user_1, $t_sys_0, $t_sys_1);
		my @ret;
		my $ret;

		($t_user_0, $t_sys_0) = times;

 view release on metacpan or  search on metacpan

lib/Dist/HomeDir.pm  view on Meta::CPAN

This module was inspired by Catalyst::Utils->home() to obtain the root
directory for obtaining application code and self-contained support data in
directories relative to the distribution root.  It does this by returning a
L<Path::Tiny> object which has a very nice interface.  However
Catalyst::Utils->home only works for perl classes.  This works for class
files and perl scripts via examining C<(caller)[1]> and thus should
B<never> be used in code that will be instaled via a cpan client or other
package manager.

Sometimes support libaries will also live in the C<t/lib> directory and the
C<script/lib> directory.  C<dist_home> will ignore these C<lib> directories

 view release on metacpan or  search on metacpan

lib/Docbook/Table.pm  view on Meta::CPAN

=cut

sub new {
    my $self = {};
    $self->{calling_package} = (caller)[0];
    bless $self;
    return $self;
}

=head2 Specifying the title

 view release on metacpan or  search on metacpan

lib/Drogo/LoadModules.pm  view on Meta::CPAN

        {
            $caller_dir = $path;
        }
        else
        {
            my @caller_dir  = split('/', (caller)[1]);
            pop @caller_dir; # trash file name

            $caller_dir = join('/', @caller_dir) . '/' . $path;
        }

 view release on metacpan or  search on metacpan

lib/Email/Send.pm  view on Meta::CPAN

# Classic Interface.

sub import {
    no strict 'refs';
    *{(caller)[0] . '::send'} = __PACKAGE__->can('_send_function');
}

sub _send_function {
    my ($mailer, $message, @args) = @_;
    __PACKAGE__->new({

 view release on metacpan or  search on metacpan

lib/EntityModel/Resolver.pm  view on Meta::CPAN

sub import {
	my $class = shift;
	my %args = @_;
	my $model = $args{model} || EntityModel->default_model;
	my $pkg = (caller)[0];

	# Now we have a better idea of what we're doing, call through
	# to the various import helpers to do the real work
	$class->import_resolve(package => $pkg, model => $model);
}

 view release on metacpan or  search on metacpan

lib/EnvDir.pm  view on Meta::CPAN

                push @_, $dir;
                $dir = $DEFAULT_ENVDIR;
            }
        }
        elsif ( $arg eq 'envdir' ) {
            my $package = (caller)[0];
            no strict 'refs';
            *{"$package\::envdir"} = \&envdir;
        }
        elsif ( $arg eq '-clean' ) {
            $self = $class->_instance;

 view release on metacpan or  search on metacpan

lib/Error/Hierarchy/Mixin.pm  view on Meta::CPAN

BEGIN {
    *CORE::GLOBAL::die = sub (@) {

        # Error.pm die()s as well, but we don't want an endless recursion.
        CORE::die(@_) if (caller)[0] eq 'Error' || ref $_[0];
        local $Error::Depth = $Error::Depth + 1;    # skip this level
        throw Error::Hierarchy::Internal::CustomMessage(
            custom_message => join(' ', @_),);
    };
}

 view release on metacpan or  search on metacpan

lib/Evented/Object/Hax.pm  view on Meta::CPAN

our $VERSION = '5.68';

# exported import subroutine.
sub import {
    my ($export_pkg, $import_pkg, @import) = (shift, (caller)[0], @_);

    # import each item.
    foreach my $item (@import) {
        my $code = $export_pkg->can($item) or next;
        export_code($import_pkg, $item, $code);

 view release on metacpan or  search on metacpan

lib/ExportTo.pm  view on Meta::CPAN

use Carp();
use strict;

sub import{
  my $pkg = (caller)[0];
  {
    no strict 'refs';
    *{$pkg . '::export_to'} = \&export_to
      if not defined &{$pkg . '::export_to'};
  }

lib/ExportTo.pm  view on Meta::CPAN

}

sub export_to {
  shift if $_[0] eq __PACKAGE__;
  my %hash = @_;
  my $pkg = (caller)[0];
  while(my($class, $subs) = each %hash){
    if(ref $subs eq 'HASH'){
      # {subname => \&coderef/subname}
      while (my($sub, $cr_or_name) = each %{$subs}) {
        my($cr, $subname) = ref $cr_or_name eq 'CODE' ? ($cr_or_name, undef) : (undef, $cr_or_name);

 view release on metacpan or  search on metacpan

lib/Exporter/Dispatch.pm  view on Meta::CPAN

package Exporter::Dispatch;
use Carp qw(croak);
our $VERSION = 2.10;

sub import {
    my $pkg = (caller)[0];
    if (@_ > 2) {
        croak 'Incorrect import list for Exporter::Dispatch';
    }
    elsif ($_[-1] eq 'create_dptable') {
        *{"${pkg}::create_dptable"} = \&create_dptable;

 view release on metacpan or  search on metacpan

lib/Exporter/Heavy.pm  view on Meta::CPAN

    my $pkg = ref $self || $self;
    return ${pkg}->VERSION($wanted);
}

sub heavy_export_tags {
  _push_tags((caller)[0], "EXPORT",    \@_);
}

sub heavy_export_ok_tags {
  _push_tags((caller)[0], "EXPORT_OK", \@_);
}

1;

 view release on metacpan or  search on metacpan

lib/ExtUtils/MM.pm  view on Meta::CPAN

unshift @ISA, $class;


sub _assert {
    my $sanity = shift;
    die sprintf "Assert failed at %s line %d\n", (caller)[1,2] unless $sanity;
    return;
}

 view release on metacpan or  search on metacpan

t/ExtUtils/SVDmaker/Test.pm  view on Meta::CPAN

    local($\, $,);   # guard against -l and other things that screw with
                     # print

    _reset_globals();

    _read_program( (caller)[1] );

    my $max=0;
    while (@_) {
	my ($k,$v) = splice(@_, 0, 2);
	if ($k =~ /^test(s)?$/) { $max = $v; }

 view release on metacpan or  search on metacpan

lib/FAST/Bio/MySeqI.pm  view on Meta::CPAN

@ISA = qw(FAST::Bio::MyPrimarySeqI);

sub _abstractDeath {
  my $self = shift;
  my $package = ref $self;
  my $caller = (caller)[1];
  
  confess "Abstract method '$caller' defined in interface FAST::Bio::SeqI not implemented by pacakge $package. Not your fault - author of $package should be blamed!";
}

=head2 top_SeqFeatures

 view release on metacpan or  search on metacpan

t/validate.t  view on Meta::CPAN

    },
);


sub t($schema, $input, $output) {
    my $line = (caller)[2];

    my $schema_copy = dclone([$schema])->[0];
    my $input_copy = dclone([$input])->[0];

    #diag explain FU::Validate->compile($schema, \%validations) if $line == 95;

t/validate.t  view on Meta::CPAN

    is_deeply $input,  $input_copy,  "input modification $line";
    is_deeply $res, $output, "data ok $line";
}

sub f($schema, $input, $error, @msg) {
    my $line = (caller)[2];

    my $schema_copy = dclone([$schema])->[0];
    my $input_copy = dclone([$input])->[0];

    #diag explain FU::Validate->compile($schema, \%validations) if $line == 176;

 view release on metacpan or  search on metacpan

lib/File/Fu.pm  view on Meta::CPAN

=cut

sub THIS_FILE {
  my $package = shift;
  my $name = (caller)[1];
  return $package->file($name);
} # end subroutine THIS_FILE definition
########################################################################

=head2 cwd

 view release on metacpan or  search on metacpan

lib/File/HomeDir/Tiny.pm  view on Meta::CPAN

package File::HomeDir::Tiny;
$VERSION='0.01';
sub import{
 shift;
 "home"ne$_
  &&die __PACKAGE__." does not export $_ at ".join(' line ',(caller)[1,2])
        .".\n"
  for@_;
 *{caller()."'home"}=\&home;_:
}
eval'sub home(){'

 view release on metacpan or  search on metacpan

lib/File/KDBX/IO.pm  view on Meta::CPAN

        *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
    };
}

sub new {
    my $class = shift || (caller)[0];
    my $self = bless gensym, ref($class) || $class;
    tie *$self, $self if 5.005 <= $];
    return $self;
}

 view release on metacpan or  search on metacpan

Lock.pm  view on Meta::CPAN

    ($constname = $AUTOLOAD) =~ s/.*:://;
    my $val;
    $val = constant($constname, @_ ? ($_[0] =~ /^\d+/ ? $_[0] : 0) : 0);
    if ($!) {
      if ($! =~ /Invalid/) {
        my ($file, $line) = (caller)[1,2];
	die "$file:$line: $constname is not a valid $SELF macro.\n";
      }
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;

 view release on metacpan or  search on metacpan

lib/File/ProjectHome.pm  view on Meta::CPAN

    Makefile.PL
    Build.PL
);

sub project_home {
    my $dir = dir((caller)[1]);
    while (my $parent = _parent($dir)) {
        for my $project_root_files (@PROJECT_ROOT_FILES) {
            if (-e File::Spec->catfile($dir, $project_root_files)) {
                return "$dir";
            }

 view release on metacpan or  search on metacpan

lib/File/TreeBuilder.pm  view on Meta::CPAN

our @EXPORT_OK = qw(build_tree);

# --------------------------------------------------------------------
sub build_tree {
    my ($dir, $str) = @_;
    my $caller_pkg = (caller)[0];
    $str = q[] unless defined $str;
    my @lines = split /\n/, $str;
        # Remove blank lines and comments.
    @lines = grep ! /^\s*(?:#|$)/, @lines;
    my $err_str = q[];