view release on metacpan or  search on metacpan

Query.pm  view on Meta::CPAN

# $var can be a reference to a variable, or it can be a string name.
# If it is the latter and not already qualified, it will be
# qualified at the package level outside of the Query.pm module.
#

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];
    }
    $pkg = 'main' unless $pkg ne '';	# default package
    $var = "${pkg}::${var}";		# qualify the variable's scope
  }
  $$var = &deref($ref);			# assign a deref'ed value
  1;					# always return good stuff

Tester.pm  view on Meta::CPAN

sub run_test_with_input {
    my $class = shift;
    my $test = shift;
    my $inputstring = shift;
    my $testsub = shift;
    my $testargs = shift;
    my $condition = shift;

    if (!ref($testsub) and $testsub !~ /::/) {
	my $pkg = (caller)[0];
	my $i;
	for ($i = 1; $pkg = (caller)[0]; $i++) {
	    last unless $pkg eq 'Tester';
	}
	$testsub =~ s/^/$pkg::/;	# qualify the sub
    }

    select(STDOUT); $| = 1;
    printf STDOUT "%d.......", $test;

    $SIG{'PIPE'} = 'IGNORE';	# don't let pipe errors hurt us
    pipe(TESTREAD, CHILDWRITE);