view release on metacpan or  search on metacpan

lib/SelfLoader.pm  view on Meta::CPAN

    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
    delete $Cache{$AUTOLOAD};
    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

t/cgi-application-plugin-sentry.t  view on Meta::CPAN

use Mojo::File;
# curfile missing in Mojolicious@^8. The dependency shall not be updated for
# the time being. For this reason `curfile` is duplicated for now.
# use lib curfile->sibling('lib')->to_string;
# See https://github.com/mojolicious/mojo/blob/4093223cae00eb516e38f2226749d2963597cca3/lib/Mojo/File.pm#L36
use lib Mojo::File->new(Cwd::realpath((caller)[1]))->sibling('lib')->to_string;

use CGI;
use Capture::Tiny qw(capture);
use Mock::Mojo::UserAgent;
use Mojo::Util 'dumper';

 view release on metacpan or  search on metacpan

lib/Shell/Autobox.pm  view on Meta::CPAN

# https://metacpan.org/pod/version#How-to-declare()-a-dotted-decimal-version
use version; our $VERSION = version->declare('v2.0.1');

sub import {
    my $class  = shift;
    my $caller = (caller)[0];

    for my $program (@_) {
        my $sub = sub {
            my ($input, @args) = @_;
            my @command = ($program, @args);

 view release on metacpan or  search on metacpan

lib/Shell/POSIX/Select.pm  view on Meta::CPAN

} # import

sub export {	# appropriated from Switch.pm
	my $subname = sub_name();

	# $offset = (caller)[2]+1;
	my $pkg = shift;
	no strict 'refs';
# All exports are scalard vars,  so strip sigils and poke in package name
	foreach ( map {  s/^\$//; $_ } @_ ) {	# must change $Reply to Reply, etc.
		*{"${pkg}::$_"} =

 view release on metacpan or  search on metacpan

lib/Esjis.pm  view on Meta::CPAN

        elsif (defined $_[1]) {
            return $_[1] . '::' . $name;
        }
        else {
            return (caller)[0] . '::' . $name;
        }
    }

    sub qualify_to_ref ($;$) {
        if (defined $_[1]) {
            no strict qw(refs);
            return \*{ qualify $_[0], $_[1] };
        }
        else {
            no strict qw(refs);
            return \*{ qualify $_[0], (caller)[0] };
        }
    }
}

# P.714 29.2.39. flock

 view release on metacpan or  search on metacpan

lib/Solstice/List.pm  view on Meta::CPAN

        # $a and $b are package variables, so we want to copy $a and $b 
        # into the namespace of the caller. Since we're doing this work 
        # for every sort call, we had to make a block based sort instead 
        # of a usersub sort, and so we had to explicitely call our sorting 
        # subroutine reference.  
        my $calling_package = (caller)[0];
        { 
            no strict 'refs'; ## no critic
            @new_data = CORE::sort { ${"${calling_package}::a"} = $a; ${"${calling_package}::b"} = $b; &$sort_ref($a, $b); } @{$self->{'_list'}->_getDataArray()};
        }
    }

 view release on metacpan or  search on metacpan

lib/Sort/Fields.pm  view on Meta::CPAN

use Carp;

sub make_fieldsort {
	my $selfname;
	if ((caller)[0] eq 'Sort::Fields') {
		($selfname) = (caller 1)[3] =~ /([^:]*)$/;
	} else {
		$selfname = 'make_fieldsort'
	};
	unless (@_) {

 view release on metacpan or  search on metacpan

lib/Sort/Versions.pm  view on Meta::CPAN

    }
    @A <=> @B;
}

sub versions () {
    my $callerpkg = (caller)[0];
    my $caller_a = "${callerpkg}::a";
    my $caller_b = "${callerpkg}::b";
    no strict 'refs';
    return versioncmp($$caller_a, $$caller_b);
}

 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/Squatting.pm  view on Meta::CPAN

# No longer have to :  use base 'Squatting';
# Simply saying     :  use Squatting;
#   will muck with the calling packages @ISA.
sub import {
  my $m = shift;
  my $p = (caller)[0];

  if ($m ne 'Squatting') {
    return $m->load_components(grep /::/, @_);
  }

 view release on metacpan or  search on metacpan

lib/Stem/Msg.pm  view on Meta::CPAN

	require Data::Dumper ;

	my $dump = '' ;
	$label ||= 'UNKNOWN' ;

	my( $file_name, $line_num ) = (caller)[1,2] ;

	$dump .= <<LABEL ;

>>>>
MSG Dump at Line $line_num in $file_name

 view release on metacpan or  search on metacpan

test.t  view on Meta::CPAN

    if ($@) {
	chomp $@;
	$@ =~ s/ at \S+ line \d+\.?\z//;
	$got = "die: $@";
    }
    my $from_line = (caller)[2];
    ok $got eq $want,
	qq{line $from_line\n# wanted [$want]\n# got    [$got]};
}

$testsub = \&shell_quote;

 view release on metacpan or  search on metacpan

lib/Sub/Multi.pm  view on Meta::CPAN

=cut

sub add_multi {
    my ($class, $name, $sub) = @_;
    my $pkg = ((caller)[0]);
    no strict 'refs';
    my $subs = ${$pkg."::SUB_MULTI_REGISTRY"} ||= [];
    push @$subs, $sub;
    no warnings 'redefine';
    *{$pkg."::$name"} = $class->new(@$subs);

 view release on metacpan or  search on metacpan

lib/Switch/Back.pm  view on Meta::CPAN

            # Implement "given" as a (trivial) "if" block...
            $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

            # At what line should the "given" end???
            my $end_line = (caller)[2] + $GIVEN =~ tr/\n//;

            # Append the trailing code (at the right line number)...
            $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
        }

lib/Switch/Back.pm  view on Meta::CPAN

        # Implement the "when" as an "if"...
        $REPLACEMENT_CODE = qq{if(1){local \$Switch::Back::when_value = ($EXPR); if(1){if (\$Switch::Back::when_value) $BLOCK }}};

        # At what line should the "when" end???
        my $end_line = (caller)[2] + $WHEN =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
    }

lib/Switch/Back.pm  view on Meta::CPAN

        # Build the implementation of the "default"...
        my $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

        # At what line should the "default" end???
        my $end_line = (caller)[2] + $matched{DEFAULT} =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        ${$source_ref} = "$REPLACEMENT_CODE\n#line $end_line\n$matched{TRAILING_CODE}";
    }

 view release on metacpan or  search on metacpan

lib/Switch/Right.pm  view on Meta::CPAN

            # Implement "given" as a (trivial) "if" block...
            $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

            # At what line should the "given" end???
            my $end_line = (caller)[2] + $GIVEN =~ tr/\n//;

            # Append the trailing code (at the right line number)...
            $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
        }

lib/Switch/Right.pm  view on Meta::CPAN

        $REPLACEMENT_CODE = qq{if(1)\{local \$Switch::Right::when_value = }
                          . qq{smartmatch($given_junc \$_, $JUNC scalar($EXPR));}
                          . qq{if(1){if (\$Switch::Right::when_value) $BLOCK }\}};

        # At what line should the "when" end???
        my $end_line = (caller)[2] + $WHEN =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
    }

lib/Switch/Right.pm  view on Meta::CPAN

        # Build the implementation of the "default"...
        my $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

        # At what line should the "default" end???
        my $end_line = (caller)[2] + $matched{DEFAULT} =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        ${$source_ref} = "$REPLACEMENT_CODE\n#line $end_line\n$matched{TRAILING_CODE}";
    }

 view release on metacpan or  search on metacpan

Switch.pm  view on Meta::CPAN

my ($Perl5, $Perl6) = (0,0);

sub import
{
	$fallthrough = grep /\bfallthrough\b/, @_;
	$offset = (caller)[2]+1;
	filter_add({}) unless @_>1 && $_[1] eq 'noimport';
	my $pkg = caller;
	no strict 'refs';
	for ( qw( on_defined on_exists ) )
	{

Switch.pm  view on Meta::CPAN

}

sub filter
{
	my($self) = @_ ;
	local $Switch::file = (caller)[1];

	my $status = 1;
	$status = filter_read(1_000_000);
	return $status if $status<0;
    	$_ = filter_blocks($_,$offset);

 view release on metacpan or  search on metacpan

lib/System/Sub.pm  view on Meta::CPAN

    goto &Carp::carp
}

sub import
{
    my $pkg = (caller)[0];
    shift;

    my $common_options;
    $common_options = shift if @_ && ref($_[0]) eq 'ARRAY';

 view release on metacpan or  search on metacpan

t/validate.t  view on Meta::CPAN

);


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

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

  my $res = validate \%validations, $schema, $input;

 view release on metacpan or  search on metacpan

lib/Tak/STDIONode.pm  view on Meta::CPAN

        and ref($m) ne 'Method::Generate::Accessor') {
      # old fashioned way time.
      *{_getglob("${new_name}::ISA")} = [ $superclass ];
      $Moo::MAKERS{$new_name} = {is_class => 1};
      $me->apply_roles_to_package($new_name, @roles);
      _set_loaded($new_name, (caller)[1]);
      return $new_name;
    }
  
    $me->SUPER::create_class_with_roles($superclass, @roles);
  

lib/Tak/STDIONode.pm  view on Meta::CPAN

  
    $Moo::MAKERS{$new_name} = {is_class => 1};
  
    $me->_handle_constructor($new_name, $_) for @roles;
  
    _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);
    _set_loaded(ref $new, (caller)[1]);
  
    my $apply_defaults = $APPLY_DEFAULTS{ref $new} ||= do {
      my %attrs = map { @{$INFO{$_}{attributes}||[]} } @roles;
  
      if ($INC{'Moo.pm'}

lib/Tak/STDIONode.pm  view on Meta::CPAN

    if (!exists $opts{version}) {
      $opts{version}
        = exists $^H{strictures_enable} ? delete $^H{strictures_enable}
        : int $VERSION;
    }
    $opts{file} = (caller)[1];
    $class->_enable(\%opts);
  }
  
  sub _enable {
    my ($class, $opts) = @_;

lib/Tak/STDIONode.pm  view on Meta::CPAN

    );
    no warnings 'once';
  
  except when called from a file which matches:
  
    (caller)[1] =~ /^(?:t|xt|lib|blib)[\\\/]/
  
  and when either C<.git>, C<.svn>, or C<.hg> is present in the current directory
  (with the intention of only forcing extra tests on the author side) -- or when
  C<.git>, C<.svn>, or C<.hg> is present two directories up along with
  C<dist.ini> (which would indicate we are in a C<dzil test> operation, via

 view release on metacpan or  search on metacpan

t/00_base.t  view on Meta::CPAN

    my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
    push @$conf, (COMPILE_PERL => $compile_perl) if $compile_perl;
    push @$conf, (STREAM => 1) if $use_stream;
    my $obj  = shift || $module->new(@$conf); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    Taint::Runtime::taint(\$str) if test_taint;

    my $fh;

 view release on metacpan or  search on metacpan

t/02_cache.t  view on Meta::CPAN

    my $vars = shift || {};
    my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
    push @$conf, (INCLUDE_PATH => $test_dir);
    my $obj  = shift || $module->new(@$conf); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    Taint::Runtime::taint(\$str) if test_taint;

    $obj->process_simple($str, $vars, \$out);

 view release on metacpan or  search on metacpan

lib/Template/Magic.pm  view on Meta::CPAN

   ; $$s{text_handlers}   ||= $s->DEFAULT_TEXT_HANDLERS
                              || $$s{output_handlers}
   ; $$s{zone_handlers}   ||= $s->DEFAULT_ZONE_HANDLERS
   ; $$s{value_handlers}  ||= $s->DEFAULT_VALUE_HANDLERS
   ; $$s{post_handlers}   ||= $s->DEFAULT_POST_HANDLERS
   ; $$s{lookups}         ||= [ (caller)[0] ]
   ; $$s{options}         ||= $s->DEFAULT_OPTIONS
   ; $$s{options}           = { map { /^(no_)*(.+)$/
                                    ; $2 => $1 ? 0 : 1
                                    }
                                    @{$$s{options}}

 view release on metacpan or  search on metacpan

t/00_base.t  view on Meta::CPAN

    my $test = shift;
    my $vars = shift || {};
    my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
    my $obj  = shift || Template->new(@$conf); # new object each time
    my $out  = '';
    my $line = (caller)[2];
    delete $vars->{'tt_config'};

    $obj->process(\$str, $vars, \$out);
    my $ok = ref($test) ? $out =~ $test : $out eq $test;
    if ($ok) {

 view release on metacpan or  search on metacpan

lib/Template/Plex.pm  view on Meta::CPAN

		}
		else{
			DEBUG and Log::OK::TRACE and log_trace __PACKAGE__." class load called for $path";
			#called on package
      my $dummy=[];
      $dummy->[Template::Plex::meta_]={file=>(caller)[1]}; 
      bless $dummy, "Template::Plex";
      $opts{caller}=$dummy;

			$template=Template::Plex::Internal->new(\&Template::Plex::Internal::_prepare_template, $path, $vars, %opts);

 view release on metacpan or  search on metacpan

lib/TemplateRex.pm  view on Meta::CPAN

  my %conf_hsh = __PACKAGE__->get_defaults();

  %conf_hsh = (%conf_hsh, %arg_hsh);
  
  # Set package for embedded function to caller unless otherwise specified.
  unless ( $conf_hsh{'func_package'} ) { $conf_hsh{'func_package'} = (caller)[0] }

  # The object data structure
  my $self = bless {
                        'temp'      => {},
                        'temp_tree' => {},

 view release on metacpan or  search on metacpan

lib/Term/Menus.pm  view on Meta::CPAN

}

sub Menu
{
#print "MENUCALLER=",(caller)[0]," and ",__PACKAGE__,"\n";<STDIN>;
#print "MENUCALLER=",caller,"\n";
   my $MenuUnit_hash_ref=$_[0];
#print "WHAT IS THIS=",&Data::Dump::Streamer::Dump($MenuUnit_hash_ref)->Out(),"\n";
   $MenuUnit_hash_ref->{Name}=&pw($MenuUnit_hash_ref);
   my $select_many=0;

lib/Term/Menus.pm  view on Meta::CPAN

   my $Persists= (defined $_[9]) ? $_[9] : {};
   my $parent_menu= (defined $_[10]) ? $_[10] : '';
   my $no_wantarray=0;

   if ((defined $_[11] && $_[11]) ||
         ((caller)[0] ne __PACKAGE__ && !wantarray)) {
      $no_wantarray=1;
   }
   if (defined $_[12] && $_[12]) {
      return '','','','','','','','','','','',$_[12];
   }

 view release on metacpan or  search on metacpan

Query.pm  view on Meta::CPAN

sub define_var {
  my( $var ) = shift;			# the variable name
  my( $ref ) = shift;			# the value to define
  return 1 unless length($var);		# don't work with nulls
  if (!(ref($var) or $var =~ /::/)) { 	# variable already qualified?
    my( $pkg, $file ) = (caller)[0,1];	# get caller info
    my( $i );
    # Walk the stack until we get the first level outside of Query.pm
    for ($i = 1; $file =~ /Query\.pm/; $i++) {
      ($pkg, $file) = (caller $i)[0,1];
    }

 view release on metacpan or  search on metacpan

Sample.pm  view on Meta::CPAN

		my $self = shift if(substr($_[0],0,6) eq 'Term::');
		my $sample = shift; # || $_;
		my %args = @_;
		my $type = $args{type};
		if(ref($sample) ne "ARRAY" && ($type eq "basic" || $type eq "avg" || $type eq "average")) {
			print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		} 
		elsif(ref($sample) ne "HASH" && ($type eq "analysis" || $type eq "overview" || $type eq "details")) {
			print "Error: Invalid analysis data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		if(ref($sample) eq "ARRAY") {
			if(!$type || $type eq 'basic') {
				for my $key (0..$#{$sample}) {

Sample.pm  view on Meta::CPAN

					print "\n";
				}
				
			}
		} else {
			print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;				
		}
	}
	
	sub to_string {
		my $self = shift if(substr($_[0],0,6) eq 'Term::');
		my $sample = shift;
		if(ref($sample) ne "ARRAY") {
			print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;				
		}

		my $str;
		$str.=$sample->[$_]->{key} for (0..$#{$sample});

Sample.pm  view on Meta::CPAN

		my $sample1 = shift;
		my $sample2 = shift;
		my %args = @_;
		my $v = $args{verbose} || 0;
		if(ref($sample1) ne "HASH" || ref($sample2) ne "HASH") {
			print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}: Both arguments must be HASH refrences from analyze().\n";
			return undef;				
		}
		
		my $diff = 0; 
		my $count = 0;

Sample.pm  view on Meta::CPAN

					$out->[$key]->{delay} += ($sample->[$key]->{delay}/$x);
					$out->[$key]->{inter} += ($sample->[$key]->{inter}/$x);
				}
			}
		} else {
			print "Error: Invalid data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		
		return $out;
	}    

Sample.pm  view on Meta::CPAN

	sub save {
		my $self = shift if(substr($_[0],0,6) eq 'Term::');
		my $sample = shift;
		my $file = shift;  
		if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH") {
			print "Error: Invalid save data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		} 
	
		open(F, ">$file");
		

Sample.pm  view on Meta::CPAN

	
	sub load {
		my $self = shift if(substr($_[0],0,6) eq 'Term::');
		my $file = shift; 
		if(!(-f $file)) {
			print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		
		open(F, $file);
		my @lines = <F>;

Sample.pm  view on Meta::CPAN

			for my $key (0..$db{index_size}) {
				($sample->[$key]->{key},$sample->[$key]->{delay},$sample->[$key]->{inter}) = 
					split /\:\:/, $db{"index$key"};
			}
		} else {
			print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		
		return $sample;
	}
		  
	sub analyze {
		my $self = shift if(substr($_[0],0,6) eq 'Term::');
		my $sample = shift;
		if(ref($sample) ne "ARRAY") {
			print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		} 
		
		my $delay = 0;
		my $inter = 0;

Sample.pm  view on Meta::CPAN

		my %args = @_;
		
		my ($key,$sample);
		while(($key,$sample) = each %args) {
			if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
				print "Error: Invalid sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
				return undef;
			}
			if(!exists $self->{samples}->{$key}) {
				$self->{samples}->{$key} = $sample;
			} else {

Sample.pm  view on Meta::CPAN

	
	sub remove {
		my $self = shift;
		my $key = shift;
		if(!exists $self->{samples}->{$key} && !$self->{silent}) {
			print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		delete $self->{samples}->{$key};
		return $self;
	}
	
	sub get {
		my $self = shift;
		my $key = shift;
		if(!exists $self->{samples}->{$key} && !$self->{silent}) {
			print "Error: Key `$key' does not exist in set at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		return $self->{samples}->{$key};
	}

Sample.pm  view on Meta::CPAN

		my $self = shift;
		my $match = shift;
		my $term = $self->{term};
		my $v = shift || 0;
		if(ref($match) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
			print "Error: Invalid sample data type at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		}
		
		my $test = ($self->{type} eq 'sample')?$term->analyze($match):$match;
		my @diffs = ();
		my ($key,$sample);
		while(($key,$sample) = each %{$self->{samples}}) {
			if(ref($sample) ne (($self->{type} eq 'sample')?"ARRAY":"HASH") && !$self->{silent}) {
				print "Error: Corrupted sample data type for key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
				return undef;
			}
			my $analysis = ($self->{type} eq 'sample')?$term->analyze($sample):$sample;
			my $i=++$#diffs;
			$diffs[$i] = { diff => $term->diff($analysis, $test), key => $key };  

Sample.pm  view on Meta::CPAN

		
		my ($key,$sample);
		while(($key,$sample) = each %{$self->{samples}}) {
			print F "_____KEY_____=$key\n";
			if(ref($sample) ne "ARRAY" && ref($sample) ne "HASH" && !$self->{silent}) {
				print "Error: Corrupted data type key `$key' at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
				return undef;
			} 
		
			if(ref($sample) eq "HASH") {
				print F "type=hash\n";

Sample.pm  view on Meta::CPAN

	
	sub load {
		my $self = shift;
		my $file = shift; 
		if(!(-f $file) && !$self->{silent}) {
			print "Error: File $file doesn't exist at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
			return undef;
		} 
		
		return $self if(!(-f $file) && $self->{silent});
		

Sample.pm  view on Meta::CPAN

				for my $x (0..$db{index_size}) {
					($self->{samples}->{$key}->[$x]->{key},$self->{samples}->{$key}->[$x]->{delay},$self->{samples}->{$key}->[$x]->{inter}) = 
						split /\:\:/, $db{"index$x"};
				}
			} else {
				print "Error: Invalid file type in file $file at @{[(caller)[1]]} line @{[(caller)[2]]}\n";
				return undef;
			}
		}
			
		return $self;

 view release on metacpan or  search on metacpan

lib/Test/CVE.pm  view on Meta::CPAN

    my %attr = @_;
    my $tb = __PACKAGE__->builder;

    # By default skip this test is not in a development env
    if (!exists $attr{author} and
	 ((caller)[1] =~ m{(?:^|/)xt/[^/]+\.t$} or
	  $ENV{AUTHOR_TESTING}                  or
	  -d ".git" && $^X =~ m{/perl$})) {
	$attr{author}++;
	}
    unless ($attr{author}) {

 view release on metacpan or  search on metacpan

lib/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; }