view release on metacpan or  search on metacpan

Query.pm  view on Meta::CPAN

# Of course, this routine is more useful if the flags contain the 'V'
# flag, and the arglist has a correspoinding variable name.
#

sub query_table {
  local( $table ) = shift;
  local( @args );

  query_table_process $table, 	# process the query table
    sub {			# flagsub
      push(@args, $arg) if index($need_arg_codes, $flag) >= 0;
    },
    sub {			# querysub
      defined(query $prompt, $flags, @args) or return undef;
      @args = ();		# reset the args array
      1;
    };
  1;
}

###############
#
# query_table_set_defaults \@array;
#
# Given an array suitable for query_table, run through the table and
# initialize any variables mentioned with the provided defaults, if any.
#
# This routine is suitable for preinitializing variables using the
# same query table as would be used to query for their values.
#

sub query_table_set_defaults {
  local( $table ) = shift;		# the query table
  local( $var, $def );

  query_table_process $table, 
    sub {				# flag sub
      $var = $arg if $flag eq 'V';	# look for the variable arg
      $def = $arg if $flag eq 'd';	# look for the default arg
    }, 
    sub { &define_var($var, $def); };	# define a variable (maybe)
  1;
}

#######################
#
# define_var $var, $ref
#
# Define $var outside of this package.
#
# $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
}

1;

__END__


=head1 NAME

B<Term::Query> - Table-driven query routine.

=head1 SYNOPSIS

=over 17

=item C<use B<Term::Query>>

C<qw( B<query> B<query_table> B<query_table_set_defaults> B<query_table_process> );>

=back

C<$result = B<query> $I<prompt>, $I<flags>, [ $I<optional_args> ];>

C<$I<ok> = B<query_table> \@I<array>;>

C<B<query_table_set_defaults> \@I<array>;>

C<$I<ok> = B<query_table_process> \@I<array>, \&flagsub, \&querysub;>

=head1 DESCRIPTION

=head2 B<query>

The B<query> subroutine fulfills the need for a generalized
question-response subroutine, with programmatic defaulting, validation,
condition and error checking.

Given I<$prompt> and I<$flags>, and possibly additional arguments,
depending upon the characters in I<$flags>, B<query> issues a prompt to
STDOUT and solicits input from STDIN.  The input is validated against a
set of test criteria as configured by the characters in I<$flags>; if
any of the tests fail, an error message is noted, and the query is
reattempted.

When STDIN is not a tty (not interactive), prompts are not issued, and
errors cause a return rather than attempting to obtain more input.
This non-interactive behaviour can be disabled by setting the variable
C<$Foce_Interactive> as below:

    $Term::Query::Force_Interactive = 1;