view release on metacpan or  search on metacpan

lib/Net/SC.pm  view on Meta::CPAN

	local $_;

	unless ( exists $self->{ 'CFG_' . uc($section) } ) {
		$self->log_error("Use unknown configuration variable : `$section'");
		return undef;
	} elsif ( uc($section) eq 'CHAIN_DATA' and (caller)[0] ne __PACKAGE__ ) {
		#
		# íÁÌÅÎØËÁÑ ËÕÞËÁ ÓÏÌÏÍËÉ, ÏÔ ÉÚÍÅÎÅÎÉÑ ÄÁÎÎÙÈ ËÏÎÆÉÇÕÒÁÃÉÏÎÎÏÇÏ ÆÁÊÌÁ...
		#
		return $self->{ 'CFG_' . uc($section) };
	} else {

lib/Net/SC.pm  view on Meta::CPAN

	#
	# syslogd
	#
	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		foreach ( @_ ) {
			syslog( 'debug', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
		return 1;
	}
	#
	# ÷ÓÅ ÏÓÔÁÌØÎÏÅ

lib/Net/SC.pm  view on Meta::CPAN

	if ( ref $self and $self->configure( 'SYSLOG' ) and $^O !~ /[Ww]in32/ ) {
		#
		# syslogd
		#
		foreach ( @_ ) {
			syslog( 'warning', '%s [ %d ]', $_, (caller)[-1] ) unless /^\s*$/;
		}
	} elsif (	ref $self and
				$self->configure( 'SYSLOG' ) and
				defined $self->configure( 'LOG_FH' ) ) {
		#

lib/Net/SC.pm  view on Meta::CPAN

		} elsif ( not defined ( $sym = $self->configure( 'LOG_FH' ) ) ) {
				$sym = \*STDERR;
		}
		my_flock ( $sym, LOCK_EX );
		foreach ( @_ ) {
			printf $sym "%2.2d/%2.2d %2.2d:%2.2d:%2.2d [ %5.5d : %d ] : %s\n",(localtime(time))[3,4,2,1,0], $$, (caller)[-1], $_ unless /^\s*$/;
		}
		my_flock ( $sym, LOCK_UN );
	}

	return 1;

 view release on metacpan or  search on metacpan

lib/Net/SFTP/Foreign/Compat.pm  view on Meta::CPAN

    for my $method (@forbidden) {
        my $super = "SUPER::$method";
        no strict 'refs';
        *{$method} = sub {
            unless (index((caller)[0], "Net::SFTP::Foreign") == 0) {
                croak "Method '$method' is not available from " . __PACKAGE__
                    . ", use the real Net::SFTP::Foreign if you want it!";
            }
            shift->$super(@_);
        };

 view release on metacpan or  search on metacpan

t/05-cipher.t  view on Meta::CPAN

    _check_it($ciph1, $ciph2);
}

sub _check_it {
    my($ciph1, $ciph2) = @_;
	my $line = (caller)[2];
    ok($ciph1, "First argument was true from line $line");
    ok($ciph2, "Second argument was true from line $line");
    my($enc, $dec);
    $enc = $ciph1->encrypt(_checkbytes());
    $dec = $ciph2->decrypt($enc);

 view release on metacpan or  search on metacpan

lib/Net/Telnet/Netgear.pm  view on Meta::CPAN

    my $self = shift;
    # If this method is being called from this package and it has '-callparent' as the first arg,
    # then execute the implementation of the superclass. This is a work-around, because
    # unfortunately $self->SUPER::$method does not work. :(
    return $self->SUPER::open (splice @_, 1)
        if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
    # Call our magical method.
    _open_method ($self, "open", @_);
}

sub fhopen

lib/Net/Telnet/Netgear.pm  view on Meta::CPAN

    my $self = shift;
    # If this method is being called from this package and it has '-callparent' as the first arg,
    # then execute the implementation of the superclass. This is a work-around, because
    # unfortunately $self->SUPER::$method does not work. :(
    return $self->SUPER::fhopen (splice @_, 1)
        if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
    # Call our magical method.
    _open_method ($self, "fhopen", @_);
}

sub apply_netgear_defaults

 view release on metacpan or  search on metacpan

lib/Netx/WebRadio/Station/Shoutcast.pm  view on Meta::CPAN

=cut

sub disconnected {
    my $self = shift;
    warn "disconnected " . (caller)[0] . " " . (caller)[2] . "\n";
    return 0;
}

=head1 BUGS

 view release on metacpan or  search on metacpan

lib/Nile.pm  view on Meta::CPAN

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub detect_app_path {

    my ($self, $script) = @_;

    $script ||= (caller)[1];

    my ($vol, $dirs, $name) =   File::Spec->splitpath(File::Spec->rel2abs($script));

    if (-d (my $fulldir = File::Spec->catdir($dirs, $name))) {
        $dirs = $fulldir;

 view release on metacpan or  search on metacpan

lib/Number/Phone/FR.pm  view on Meta::CPAN

            eval "require $class; 1" or croak "$@\n";
            $class->isa(__PACKAGE__) or croak "$class is not a valid class";
        }
    } else {
        #croak "unexpected arguments for import" if @_;
        my $pkg = (caller)[0];
        croak "$class is private" unless $pkg =~ m/^Number::Phone(?:::|$)/;
        $pkg2impl{$pkg} = $class;
    }
}

 view release on metacpan or  search on metacpan

lib/Number/RGB.pm  view on Meta::CPAN

our @CARP_NOT = ('Attribute::Handlers', __PACKAGE__);
$Carp::Internal{'attributes'}++; # no idea why doesn't work in @CARP_NOT

sub import {
    my $class  = shift;
    my $caller = (caller)[0];
    eval qq[
        package $caller;
        use Attribute::Handlers;
        sub RGB :ATTR(RAWDATA) { goto &$class\::RGB }
        package $class;

 view release on metacpan or  search on metacpan

LL_Array.pm  view on Meta::CPAN

$VERSION = '0.1504';

my %exported;
sub import {
  my($p, $f, $tr, $P, @e, $renew) = ( shift, (caller)[1], {}, (caller(0))[0] );
  for my $sym (@_) {
    $tr{$1} = $2, $tr_c .= $1, $rx = qr/[$tr_c]/, next
       if $sym =~ /^:(\w)=(\w)$/;
    push @e, $sym and next if $sym =~ /^\d/;	# Somebody required a Version
    my $Sym = $sym;		# Some values may be read-only

 view release on metacpan or  search on metacpan

t/t_TestCommon.pm  view on Meta::CPAN

# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!

sub t_ok($;$) {
  my ($isok, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//"") . " (line $lno)";
  @_ = ( $isok, $test_label );
  goto &Test2::V0::ok;  # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };

sub t_is($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp//"undef") . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::is;  # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }

sub t_like($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp) . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::like;  # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }

sub _mycheck_end($$$) {
  my ($errmsg, $test_label, $ok_only_if_failed) = @_;
  return
    if $ok_only_if_failed && !$errmsg;
  my $lno = (caller)[2];
  &Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
  @_ = ( !$errmsg, $test_label );
  goto &ok_with_lineno;
}

 view release on metacpan or  search on metacpan

t/t_TestCommon.pm  view on Meta::CPAN

# This is only visible with using "perl -Ilib t/xxx.t"
# not with 'prove -l' and so mostly pointless!

sub t_ok($;$) {
  my ($isok, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//"") . " (line $lno)";
  @_ = ( $isok, $test_label );
  goto &Test2::V0::ok;  # show caller's line number
}
sub ok_with_lineno($;$) { goto &t_ok };

sub t_is($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp//"undef") . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::is;  # show caller's line number
}
sub is_with_lineno($$;$) { goto &t_is }

sub t_like($$;$) {
  my ($got, $exp, $test_label) = @_;
  my $lno = (caller)[2];
  $test_label = ($test_label//$exp) . " (line $lno)";
  @_ = ( $got, $exp, $test_label );
  goto &Test2::V0::like;  # show caller's line number
}
sub like_with_lineno($$;$) { goto &t_like }

sub _mycheck_end($$$) {
  my ($errmsg, $test_label, $ok_only_if_failed) = @_;
  return
    if $ok_only_if_failed && !$errmsg;
  my $lno = (caller)[2];
  &Test2::V0::diag("**********\n${errmsg}***********\n") if $errmsg;
  @_ = ( !$errmsg, $test_label );
  goto &ok_with_lineno;
}

 view release on metacpan or  search on metacpan

lib/OWL/Config.pm  view on Meta::CPAN

# imports names into the caller's namespace as global variables;
# adapted from the same method in Config::Simple

sub import_names {
    shift;
    my $namespace = @_ ? shift : (caller)[0];
    return if $namespace eq 'OWL::Config';

    no strict 'refs';
    no warnings;   # avoid "Useless use of a variable..."
    while ( my ($key, $value) = each %Config ) {

 view release on metacpan or  search on metacpan

t/test.pl  view on Meta::CPAN

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

    return ($ok);
}

t/test.pl  view on Meta::CPAN

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#      got: $got\n");
        print("# expected: $expected\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

t/test.pl  view on Meta::CPAN

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#      got: $got\n");
        print("# expected: $expected\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

t/test.pl  view on Meta::CPAN

    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
        print("#      got: $g_err\n");
        print("# expected: $e_err\n");
        print(STDERR "# FAIL: $name\n") if (! exists($ENV{'PERL_CORE'}));
    }

 view release on metacpan or  search on metacpan

hax/make_argcheck_ops.c.inc  view on Meta::CPAN

#define make_croak_op(message)  S_make_croak_op(aTHX_ message)
static OP *S_make_croak_op(pTHX_ SV *message)
{
  sv_catpvs(message, " at %s line %d.\n");
  /* die sprintf($message, (caller)[1,2]) */
  return op_convert_list(OP_DIE, 0,
    op_convert_list(OP_SPRINTF, 0,
      op_append_list(OP_LIST,
        newSVOP(OP_CONST, 0, message),
        newSLICEOP(0,

 view release on metacpan or  search on metacpan

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

our @TYPES = $ENV{TYPE} ? split(/,/, $ENV{TYPE}) : qw(mojo lwp plack catalyst dancer2);
our $TYPE = $ENV{TYPE} ? (split(/,/, $ENV{TYPE}))[0] : 'mojo'; # safe default

# Note: if you want your query parameters or uri fragment to be normalized, set them afterwards
sub request ($method, $uri_string, $headers = [], $body_content = undef) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
  die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
    if length $body_content and $body_content =~ /[^\x00-\xff]/;

  my $req;
  if ($TYPE eq 'lwp' or $TYPE eq 'plack' or $TYPE eq 'catalyst' or $TYPE eq 'dancer2') {
    test_needs('HTTP::Request', 'URI');

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

    # add missing Content-Length, etc
    $req->fix_headers;
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $req;
}

sub response ($code, $headers = [], $body_content = undef) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;
  die 'Wide character in body content at ', join(' line ', (caller)[1,2]), ".\n"
    if length $body_content and $body_content =~ /[^\x00-\xff]/;

  my $res;
  if ($TYPE eq 'lwp') {
    test_needs('HTTP::Response', 'HTTP::Status');

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

    $res->headers->header('Content-Length' => length $body_content)
      if defined $body_content and not defined $res->headers->header('Content-Length')
        and not defined $res->headers->header('Transfer-Encoding');
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $res;
}

sub uri ($uri_string, @path_parts) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  my $uri;
  if ($TYPE eq 'lwp' or $TYPE eq 'plack' or $TYPE eq 'catalyst') {
    test_needs('URI');
    $uri = URI->new($uri_string);

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

  elsif ($TYPE eq 'mojo') {
    $uri = Mojo::URL->new($uri_string);
    $uri->path->parts(\@path_parts) if @path_parts;
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $uri;
}

# sets query parameters on the request
sub query_params ($request, $pairs) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  my $uri;
  if ($TYPE eq 'lwp') {
    $request->uri->query_form($pairs);
  }

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

    $request->env->{QUERY_STRING} = Mojo::Parameters->new->pairs($pairs)->to_string;
    $request->env->{REQUEST_URI} .= '?' . $request->env->{QUERY_STRING};
    # $request->_clear_parameters if $TYPE eq 'catalyst';  # might need this later
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }

  return $uri;
}

sub remove_header ($message, $header_name) {
  die '$TYPE is not set at ', join(' line ', (caller)[1,2]), ".\n" if not defined $TYPE;

  if ($TYPE eq 'lwp') {
    $message->headers->remove_header($header_name);
  }
  elsif ($TYPE eq 'mojo') {

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

  elsif ($TYPE eq 'plack' or $TYPE eq 'catalyst' or $TYPE eq 'dancer2') {
    $message->headers->remove_header($header_name);
    delete $message->env->{uc $header_name =~ s/-/_/r} if $message->can('env');
  }
  else {
    die '$TYPE '.$TYPE.' not supported at ', join(' line ', (caller)[1,2]), ".\n";
  }
}

# prints the method and URI of the request, or the response code and message of the response,
# or the method and URI of the two-element hash

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

  }
  elsif ($message->isa('Plack::Response') or $message->isa('Catalyst::Response')) {
    return $message->status.' '.HTTP::Status::status_message($message->status);
  }

  die 'unrecognized type ', ref $message, ' at ', join(' line ', (caller)[1,2]), ".\n";
}

# create a Result object out of the document errors; suitable for stringifying
# as the OpenAPI::Modern constructor might do.
sub document_result ($document) {

 view release on metacpan or  search on metacpan

OpenPlugin/Application.pm  view on Meta::CPAN

# CGI.pm.  Otherwise, it just passes the request onto OpenPlugin.
sub param {
    my $self   = shift;
    my @params = @_;

    if( (caller)[0] eq "CGI::Application" ) {
        return $self->SUPER::param->get_incoming( @params );
    }
    else {
        return $self->SUPER::param( @params );
    }

OpenPlugin/Application.pm  view on Meta::CPAN

# CGI.pm.  Otherwise, it just passes the request onto OpenPlugin.
sub header {
    my $self   = shift;
    my @params = @_;

    if( (caller)[0] eq "CGI::Application" ) {
        return $self->SUPER::httpheader->send_outgoing( @params );
    }
    else {
        return $self->SUPER::httpheader( @params );
    }

 view release on metacpan or  search on metacpan

t/lib/Line/Storage.pm  view on Meta::CPAN

my %lines;

sub remember_line {
    my ($name) = @_;
    die "$name already taken" if $lines{$name};
    $lines{$name} = (caller)[2];
    return;
}

sub recall_line {
    my ($name) = @_;

 view release on metacpan or  search on metacpan

lib/OurNet/BBS/Utils.pm  view on Meta::CPAN

sub locate {
    my ($file, $path) = @_;

    unless ($path) {
	$path = (caller)[0];
	$path =~ s|::\w+$||;
    }

    $path =~ s|::|/|g;

 view release on metacpan or  search on metacpan

lib/P.pm  view on Meta::CPAN

	sub ops($) { my $p = shift; my $c = ref $p || $p;
		bless $p = {};
		use Carp qw(croak);
		my $caller	= (caller)[0];
		my	$args = $_[0];
		croak "ops takes a hash to pass arguments" unless HASH $args;
		foreach (sort keys %$args) {
			if (defined $_dflts{$_}) { $p->{$_} = $args->{$_} } 
			else { 

 view release on metacpan or  search on metacpan

t/data/lib/Myfile.pm  view on Meta::CPAN

use strict;
use warnings;
use Cwd;

sub from_caller  { Cwd::realpath(_from_caller()) }
sub _from_caller { (caller)[1] }
sub from_file    { Cwd::realpath(__FILE__) }

1;

 view release on metacpan or  search on metacpan

PApp/XML.pm  view on Meta::CPAN

   my $self = shift;
   my $dom = shift;
   my $temp = bless {
      attr => {@_},
   }, PApp::XML::Template::;
   my $package = (caller)[0];

   $temp->{code} = $temp->_dom2sub($dom, $self, $package);

   delete $temp->{attr}{special};

 view release on metacpan or  search on metacpan

lib/PDF/Boxer/Role/SizePosition.pm  view on Meta::CPAN

sub move{
  my ($self, $x, $y) = @_;
  return if 
    ($self->margin_left && $self->margin_left == $x)
    && ($self->margin_top && $self->margin_top == $y);
  warn $self->name." move $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ margin_left => $x, margin_top => $y });
}

sub set_width{
  my ($self, $arg) = @_;
  return if $self->width && $self->width == $arg;
  warn $self->name." set width $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ width => $arg });
}

sub set_margin_width{
  my ($self, $arg) = @_;
  return if $self->margin_width && $self->margin_width == $arg;
  warn $self->name." set margin_width $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ margin_width => $arg });
}

sub set_height{
  my ($self, $arg) = @_;
  return if $self->height && $self->height == $arg;
  warn $self->name." set height $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ height => $arg });
}

sub set_margin_height{
  my ($self, $arg) = @_;
  return if $self->margin_height && $self->margin_height == $arg;
  warn $self->name." set margin_height $arg from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ margin_height => $arg });
}

sub set_size{
  my ($self, $x, $y) = @_;
  return if 
    ($self->width && $self->width == $x)
    && ($self->height && $self->height == $y);
  warn $self->name." size $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ width => $x, height => $y });
}

sub set_margin_size{
  my ($self, $x, $y) = @_;
  return if $self->margin_width == $x && $self->margin_height == $y;
  warn $self->name." size $x, $y from ".join('-',(caller)[0,2])."\n" if $self->debug && $self->name;
  $self->adjust({ margin_width => $x, margin_height => $y });
}

sub child_height_set{};
sub child_width_set{};

 view release on metacpan or  search on metacpan

t/test.pl  view on Meta::CPAN

	# The tests in lib run in a temporary subdirectory of t, and always
	# pass in a list of "programs" to run
	@prgs = @_;
    } else {
        # The tests below t run in t and pass in a file handle. In theory we
        # can pass (caller)[1] as the second argument to report errors with
        # the filename of our caller, as the handle is always DATA. However,
        # line numbers in DATA count from the __END__ token, so will be wrong.
        # Which is more confusing than not providing line numbers. So, for now,
        # don't provide line numbers. No obvious clean solution - one hack
        # would be to seek DATA back to the start and read to the __END__ token,

 view release on metacpan or  search on metacpan

lib/PDL/Demos.pm  view on Meta::CPAN

   defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
}

sub act($) {
   local $SIG{__DIE__} = \&Carp::confess;
   actnw($_[0], (caller)[0]);
   my $prompt = "---- (press enter)";
   defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
}

sub _eval_pkg {

lib/PDL/Demos.pm  view on Meta::CPAN

   local $SIG{__DIE__} = \&Carp::confess;
   my ($script, $pack) = @_;
   print "---- Code:";
   print $script;
   print "---- Output:\n";
   _eval_pkg($script, $pack // (caller)[0]);
   print "----\n";
   print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
}

my ($searched, @found);

 view release on metacpan or  search on metacpan

Basic/SourceFilter/FilterUtilCall.pm  view on Meta::CPAN

# and one to an import file.
#   --CED 5-Nov-2007
#
sub import {
    my ($class) = @_;
    ($file,$offset) = (caller)[1,2];  # for error reporting
    $offset++;
    
    ## Parse class name into a regexp suitable for filtration
    my $terminator = terminator_regexp($class);

 view release on metacpan or  search on metacpan

Demos/Screen.pm  view on Meta::CPAN

   my $script = $_[0];
   $script =~ s/^(\s*)output/$1print/mg;
   print "---- Code:";
   print $script;
   print "---- Output:\n";
   my $pack = (caller)[0];
#	eval "package $pack; use PDLA; $_[0]";
   eval "package $pack; use PDLA; $_[0]";
   print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
   my $prompt = "---- (press enter)";
   defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );

Demos/Screen.pm  view on Meta::CPAN

   my $script = $_[0];
   $script =~ s/^(\s*)output/$1print/mg;
   print "---- Code:";
   print $script;
   print "---- Output:\n";
   my $pack = (caller)[0];
#	eval "package $pack; use PDLA; $_[0]";
   eval "package $pack; use PDLA; $_[0]";
   print "----\n";
   print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
}

 view release on metacpan or  search on metacpan

Basic/SourceFilter/FilterUtilCall.pm  view on Meta::CPAN

# and one to an import file.
#   --CED 5-Nov-2007
#
sub import {
    my ($class) = @_;
    ($file,$offset) = (caller)[1,2];  # for error reporting
    $offset++;
    
    ## Parse class name into a regexp suitable for filtration
    my $terminator = terminator_regexp($class);

 view release on metacpan or  search on metacpan

PGP/Pipe.pm  view on Meta::CPAN

  $args =~ s/%p/$self->{PGPPATH}/g;
  $args =~ s/%r/$self->{PGPPATH}\/$self->{Keyring}/g;   # PGP::Keyring
  $args =~ s/%k/0x$self->{Keyid}/g;			# PGP::Key
			  
  # Put the file descriptors in the callers package
  $fin = (caller)[0] . "::$in";
  $fout = (caller)[0] . "::$out";
  $ferr = (caller)[0] . "::$err";
  
  Debug ("PGP::Exec=$self->{PGPexec} $baseopts $args");
  
  # just to make sure that PGPPATH is exported!
  $ENV{PGPPATH} = $self->{PGPPATH};

 view release on metacpan or  search on metacpan

basiclib/Exporter.pm-txt  view on Meta::CPAN

  goto &heavy_export;
}

sub export_tags {
  require Exporter::Heavy;
  _push_tags((caller)[0], "EXPORT",    \@_);
}

sub export_ok_tags {
  require Exporter::Heavy;
  _push_tags((caller)[0], "EXPORT_OK", \@_);
}

sub import {
  my $pkg = shift;
  my $callpkg = caller($ExportLevel);

 view release on metacpan or  search on metacpan

basiclib/Exporter.pm-txt  view on Meta::CPAN

  goto &heavy_export;
}

sub export_tags {
  require Exporter::Heavy;
  _push_tags((caller)[0], "EXPORT",    \@_);
}

sub export_ok_tags {
  require Exporter::Heavy;
  _push_tags((caller)[0], "EXPORT_OK", \@_);
}

sub import {
  my $pkg = shift;
  my $callpkg = caller($ExportLevel);