Term-Query-2.0.orig/0042755000175000017500000000000006400520003012773 5ustar ivanivanTerm-Query-2.0.orig/.version0100644000175000017500000000000506202730015014455 0ustar ivanivan1.17 Term-Query-2.0.orig/CVS/0042755000175000017500000000000006400520003013426 5ustar ivanivanTerm-Query-2.0.orig/CVS/Entries0100644000175000017500000000107206400517707014776 0ustar ivanivan/.version/1.1.1.1/Fri Aug 9 21:39:25 1996// /ChangeLog/1.1.1.1/Fri Aug 9 21:39:25 1996// /Copyright/1.1.1.1/Fri Aug 9 21:39:25 1996// /GNU-LICENSE/1.1.1.1/Fri Aug 9 21:39:25 1996// /Query.pm/1.1.1.1/Fri Aug 9 21:39:25 1996// /Query_Test.pl/1.1.1.1/Fri Aug 9 21:39:25 1996// /Tester.pm/1.1.1.1/Fri Aug 9 21:39:25 1996// /tests/1.1.1.1/Fri Aug 9 21:39:25 1996// /tq/1.1.1.1/Fri Aug 9 21:39:25 1996// /MANIFEST.SKIP/0/Initial MANIFEST.SKIP// /Makefile.PL/0/Initial Makefile.PL// /Makefile/-1.1.1.1/Fri Aug 9 21:39:25 1996// /README/1.2/Tue Aug 26 09:20:07 1997// Term-Query-2.0.orig/CVS/MANIFEST.SKIP,t0100644000175000017500000000000006233173435015566 0ustar ivanivanTerm-Query-2.0.orig/CVS/Makefile.PL,t0100644000175000017500000000000006233173441015637 0ustar ivanivanTerm-Query-2.0.orig/CVS/Repository0100644000175000017500000000003506233173101015530 0ustar ivanivan/usr/cvsroot/perl/Term-Query Term-Query-2.0.orig/ChangeLog0100644000175000017500000000230106202730015014542 0ustar ivanivanSat Sep 30 00:35:29 1995 Alan K. Stebbens * Makefile: Implemented non-version-only installs; added uninstalls; changed the archive names to be prefixed with $(CLASS). Sat Sep 30 00:29:56 1995 Alan K. Stebbens * README: Updated with the new archive names. Fri Sep 29 21:39:07 1995 Alan K. Stebbens * tq: Reorganized. * tq: Added another deref variable test. * tq: Changes for new version. * Query.pm: Fixed bug in define_var -- failed to correctly implement DeMorgan's theorem across a negated "or". * Query.pm: Documented the other module dependencies Wed Sep 27 22:19:29 1995 Alan K. Stebbens * README: Fixed FTP location. * Makefile: Fixed version extraction. * Makefile: Fixed version extraction bug. * Query.pm: Changed package name to Term::Query.pm. Changed the Synopsis in the pod section to reflect this. * Makefile: Added ChangeLog to the SHARFILES list. * Makefile: Updated for versioning and CLASS name. * README: Removed the Log from the Readme and moved it to ChangeLog. * README: Changed the name from Query.pm to Term::Query.pm; changed the @EXPORT to @EXPORT_OK. Term-Query-2.0.orig/Copyright0100644000175000017500000000142006202730015014664 0ustar ivanivan# # Copyright (C) 1995 Alan K. Stebbens # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # Term-Query-2.0.orig/GNU-LICENSE0100644000175000017500000004307006202730015014434 0ustar ivanivan GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. Term-Query-2.0.orig/MANIFEST0100644000175000017500000000133506400517770014142 0ustar ivanivan.version CVS/Entries CVS/MANIFEST.SKIP,t CVS/Makefile.PL,t CVS/Repository ChangeLog Copyright GNU-LICENSE MANIFEST Makefile.PL Query.pm Query_Test.pl README Tester.pm t/.1.out t/.1.ref t/.10.out t/.10.ref t/.11.out t/.11.ref t/.12.out t/.12.ref t/.13.out t/.13.ref t/.14.out t/.14.ref t/.2.out t/.2.ref t/.3.out t/.3.ref t/.4.out t/.4.ref t/.5.out t/.5.ref t/.6.out t/.6.ref t/.7.out t/.7.ref t/.8.out t/.8.ref t/.9.out t/.9.ref t/CVS/Entries t/CVS/Repository t/Defaults.1.out t/Defaults.1.ref t/Defaults.2.out t/Defaults.2.ref t/Defaults.pl t/Defaults.t t/General.pl t/General.t t/Refs.1.ref t/Refs.2.ref t/Refs.3.ref t/Refs.4.ref t/Refs.pl t/Refs.t t/Tables.1.ref t/Tables.2.out t/Tables.2.ref t/Tables.pl t/Tables.t test.pl tests Term-Query-2.0.orig/Makefile.PL0100644000175000017500000000176106251624433014765 0ustar ivanivan# Makefile for Term::Query # # Copyright (C) 1996 Alan K. Stebbens # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # require 5.002; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Term::Query', 'VERSION' => '2.0', 'clean' => { FILES => 'test.out' }, 'dist' => { COMPRESS => 'gzip', SUFFIX => '.gz', }, ); Term-Query-2.0.orig/Query.pm0100644000175000017500000012075306233173562014463 0ustar ivanivan# Term::Query.pm -*- perl -*- # # Copyright (C) 1995 Alan K. Stebbens # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # $Id: Query.pm,v 1.1.1.1 1996/08/09 21:39:25 stebbens Exp $ # Author: Alan K. Stebbens # # # query -- generalized query routine # # query_table -- perform multiple queries (given an array of info) # # query_table_set_defaults # -- set all named variable's to their default values. # # query_table_process # -- process a table of queries # # Note: This module uses the Array::PrintCols module (by the same author). package Term::Query; require 5.001; use Exporter; @ISA = (Exporter); @EXPORT_OK = qw( query query_table query_table_set_defaults query_table_process ); use Carp; use Array::PrintCols; ############### # # $result = query($prompt, $flags, [optional fields]) # # Ask a question, prompting with $prompt (unless STDIN is not tty). # Validate the answer based on $flags below. # # # The following flags indicate the type or attribute of the value # r - an answer is required # Y - the question requires a "yes" or "no", defaulting to "yes" # N - the question requires a "yes" or "no", defaulting to "no" # i - the input is an integer # n - the input is a number (possibly a real number) # H - do *not* treat '?' as a request for help (note, this disables # any help, unless implemented in the "after" subroutine). # # The following flags indicate that the next argument is: # a - a subroutine which is invoked *After* the input is read, but # prior to doing any other checks; if it returns false, the input # is rejected. # b - a subroutine which is invoked *Before* the input is read, which # generally prepares for the input; if it returns false, then no # input is accepted; if it returns undef, an EOF is assumed. # d - the next argument is a Default input, used if the actual input # is the empty string. # h - the next argument is a Help string to print in response to "?" # I - the next argument is the input "method" ref: if it is a scalar # value, then no read is performed and this value is used as if # it has been entered by the user; if it is a CODE ref, then the # sub is invoked to obtain its return value as the input. # J - same as I, except that if the initial value returned by the # next argument reference is unacceptable for any reason, # solicit a new, proper value from STDIN. (Mnemonic: "jump" into # query with an initial value). # k - the next argument is a table reference of allowable keywords # (mnemonic: check a Keywword list). # K - the next argument is a table reference of disallowed keywords # (mnemonic: check against a Keyword list). # m - the next argument is a Match pattern (regexp) # l - the next argument is a maximum Length value # V - the next argument is a variable name or *reference* to receive # the value; if it is a name (a string) and unqualified, it is # qualified at the package level outside of Query.pm. # # The ordering of the arguments must match the ordering of their # corresponding flags. # # The ordering of the flags is also important -- it determines the order in # which the various checks are made. For example, if the flags are # given in this order: 'alm', then the $after sub is invoked first, then the # length check is made, then the $match test is made. # # Of course, the 'b' flag (and the corresponding $before sub) is always # invoked before doing any input. # # Returns undef on EOF. # Otherwise, the result is the input. %query_flags = ( 'a', sub { $after = shift(@_); &add_check("after"); }, 'b', sub { $before = shift(@_); }, 'd', sub { $default = shift(@_); &add_check(qw(default null)); }, 'h', sub { $help = shift(@_); &add_check(qw(help null)); }, 'H', sub { $nohelp++; $check_done{"help"}++;}, # don't do any help 'i', sub { $integer++; &add_check(qw(int null strip default help)); }, 'I', sub { $inref = shift(@_); $inref_flag++; }, 'J', sub { $inref = shift(@_); $inref_flag++; $inref_once++; }, 'k', sub { $keys = shift(@_); ref($keys) eq 'ARRAY' or (croak "query: The k flag needs an array reference argument.\n"); &add_check(qw(key null strip default help)); }, 'K', sub { $notkeys = shift(@_); ref($notkeys) eq 'ARRAY' or (croak "query: The K flag needs an array reference argument.\n"); &add_check(qw(nonkey null strip default help)); }, 'l', sub { $maxlen = shift(@_); &add_check(qw(maxlen null default help)); }, 'm', sub { $match = shift(@_); &add_check(qw(match null default help)); }, 'n', sub { $number++; &add_check(qw(num null strip default help)); }, 'N', sub { $no++; &add_check(qw(yesno null strip default help)); }, 'r', sub { $required++; &add_check(qw(req null default help)); }, 's', sub { $strip++; &add_check(qw(strip null default help)); }, 'V', sub { $variable = shift(@_); ref($variable) eq 'SCALAR' or (ref($variable) eq '' && $variable =~ /^((\w+)?(::|'))?\w+$/) or (croak "query: The V flag needs a variable name or reference.\n"); }, 'Y', sub { $yes++; &add_check(qw(yesno null strip default help)); }, ); $need_arg_codes = 'abdhIkKlmV'; # list of codes which need an argument # This is an array of check "codes", and corresponding anonymous subs # which, when invoked, should return one of the values (undef, '', 1) # indicating how to proceed with the input. # # The sub "add_check", when invoked as part of the flag parsing (see # above), causes the codes below to be inserted into the @checks array, # which is then processed for each input. %check_code = ( 'after', \&check_after, 'default', \&check_default, 'help', \&check_help, 'int', \&check_integer, 'key', \&check_keys, 'maxlen', \&check_length, 'match', \&check_match, 'nonkey', \&check_nonkeys, 'num', \&check_number, 'req', \&check_required, 'strip', \&strip_input, 'yesno', \&check_yesorno, 'null', \&check_null, ); # This variable controls how the keyword matching is done. $Case_sensitive = ''; $Force_Interactive = ''; # set to force interactive behaviour ################################################################################## # # &query($prompt, $flags, @optional_args) # # Returns # # undef EOF on input # # sub query { local( $prompt ) = shift; local( $flags ) = shift; # there may be other arguments local( $help, $required, $default, $match, $maxlen, $keys, $notkeys ); local( $yes, $no, $integer, $number, $strip, $after, $before, $inref ); local( $inref_once, $inref_flag, $variable ); local( $c, $ev, $input ); local( @flags ) = split(//,$flags); local( @checks, $check, $result ); local( %check_done ); # make sure this gets reset foreach $c ( @flags ) { $ev = $query_flags{$c} or (croak "query: Unknown query flag '$c'\n"); &$ev; # set a flag, or get the next argument } &add_check(qw( help null default )); # these checks are done # by default (unless disabled) # setup a default, depending on type $default = $yes ? 'yes' : 'no' if $yes or $no; $help .= "\n" if $help && substr($help,-1) ne "\n"; Query:while (1) { if (length($before)) { &$before or last; # check $before sub first } if ($inref_flag) { # do we have a reference? $input = &deref($inref); $inref_flag = '' if $inref_once; # kill flag if "once" } else { if (-t STDIN or $Force_Interactive) { # interactive? print $prompt; print " " unless substr($prompt, -1) eq ' '; if ($default ne '') { my($def) = &deref($default); print "[$def] "; } } $input = ; print "\n" if !-t STDIN and $Force_Interactive; } # Now process all the check expressions. If any return undef, then # return from this routine with undef. If a null or zero return is # made, then reject the input. Otherwise, it passes. foreach $check ( @checks ) { $result = &$check; # process the check return undef unless defined($result); # was the result undef? # Perform the next test if this one was okay next if $result; # If $inref_flag is set (I flag), don't loop return undef if $inref_flag; # don't try looping on non-interactive input return undef unless -t STDIN or $Force_Interactive; print "Please try again, or enter \"?\" for help.\n"; next Query; # do another query } last Query; # all tests passed } &define_var($variable, $input); # assign a variable (maybe) return $input; # return with input } ############################# # # &deref ($possible_ref) # # If the $possible_ref is a reference, dereference it # correctly. sub deref { my($ref) = shift; my($type) = ref($ref); return $ref if $type eq ''; # not a reference return $$ref if $type eq 'SCALAR'; # a scalar return &$ref if $type eq 'CODE'; # a subroutine return @$ref if $type eq 'ARRAY'; # an array return %$ref if $type eq 'HASH'; # a hashed array return &deref($$ref) if $type eq 'REF'; # recursive reference $ref; # whatever.. } ############################# # # &add_check($code, @precedes) # # Add the check code for $code, after ensuring that all codes # in @precedes have already been done. # # In other words, if a particular check should be done *after* # some other test, place the other check code(s) as one of the # elements in the @precedes array. # # Add_check ensures that no check is scheduled twice. sub add_check { local($code,@precedes) = @_; return if $check_done{$code}; # don't make the same check twice local($c); # ensure predecessors are done first foreach $c (@precedes) { # see if others are done &add_check($c) unless $check_done{$c}; } push(@checks,$check_code{$code}); $check_done{$code}++; } ################################# # # These are the "check" routines. # # They are all called without arguments, and have full access to the # variables of the &query routine. # They all should check $input and return either: # # undef -return from query with undef # '' -fail the input, and force another query # 1 -input is okay, do the next check # &check_after # # If $after is a CODE ref, invoke it to # allow the sub to validate the input. sub check_after { return 1 unless length($after); # default is okay &$after(\$input); # invoke the sub } # &check_default # # If $default is a CODE ref, invoke it to # get the default value, otherwise just use # the value as is. sub check_default { $input = &deref($default) if !length($input); 1; } # # &check_keys # sub check_keys { local( @exact ); if ($Case_sensitive) { @exact = grep($input eq $_, @$keys); } else { @exact = grep(/^\Q$input\E$/i, @$keys); } if ($#exact == 0) { $input = $exact[0]; # it matches -- return the keyword return 1; # yea! } local( @matches ); if ($Case_sensitive) { @matches = grep(/^\Q$input\E/, @$keys); } else { @matches = grep(/^\Q$input\E/i, @$keys); } if ($#matches == 0) { # exactly one match? $input = $matches[0]; return 1; # return success } if ($#matches > 0) { # ambiguous? print "The input \"$input\" is ambiguous; it matches the following:\n"; print_cols \@matches; } else { print "The input \"$input\" fails to match any of the allowed keywords:\n"; print_cols $keys; } ''; # fail the input } # # &check_nonkeys # sub check_nonkeys { local( @matches ); if ($Case_sensitive) { @matches = grep($_ eq $input, @$notkeys); } else { @matches = grep(/^\Q$input\E$/i, @$notkeys); } @matches || return 1; # no matches -- it's okay printf("The input \"%s\" matches a disallowed keyword \"%s\".\n", $input, $matches[0]); return ''; } # # &check_number # sub check_number { if ($input !~ /^(\d+(\.\d*)?|\.\d+)(e\d+)?$/i) { print "Please enter a number, real or integer.\n"; return ''; } $input = 0.0 + $input; # convert to numeric 1; # and it's okay } # # &check_integer # sub check_integer { if ($input !~ /^(\d+|0x[0-9a-f]+)$/i) { print "Please enter an integer number.\n"; return ''; } $input = 0 + $input; # conver to integer 1; } # # &check_yesorno # sub check_yesorno { if ($input !~ /^(y(es?)?|no?)$/i) { print "Please answer with \"yes\" or \"no\".\n"; return ''; } # Coerce input to 'yes' or 'no' # Fixed by markw@temple.dev.wholesale.nbnz.co.nz (Mark Wright) $input = $input =~ /^y(es?)?$/i ? 'yes' : 'no'; } # # &check_match # sub check_match { return 1 if $match eq '' or $input =~ m/$match/; printf "\"%s\" fails to match \"%s\"\n", $input, $match; ''; # fail the input } # # &check_length # sub check_length { return 1 if $maxlen <= 0 or length($input) <= $maxlen; printf "Input is %d characters too long; cannot exceed %d characters.\n", (length($input) - $maxlen), $maxlen; ''; # fail the input } # # &check_required # sub check_required { return 1 if length($input); print "Input is required.\n"; ''; # fail the input } # # &check_null # sub check_null { return undef unless length($input); # a null input is an EOF chomp($input); # trim trailing newline 1; # always succeed } # # &strip_input sub strip_input { $input =~ s/^\s+//; $input =~ s/\s+$//; $input =~ s/\s+/ /g; # squeeze blanks 1; # always ok } # # &check_help # # Check for help trigger '?' sub check_help { $input =~ /^\s*\?\s*$/ || return 1; # if not '?', its okay print ($help || "You are being asked \"$prompt\"\n"); print "Input is required.\n" if $required; printf "The input should be %s.\n",($integer ? 'an integer' : 'a number') if $integer || $number; print "The input should be either \"yes\" or \"no\".\n" if $yes || $no; if ($default) { my($def) = &deref($default); print "If you enter nothing, the default answer will be \"$def\".\n"; } else { print "There is no default input.\n"; } printf "The input cannot exceed %d characters in length.\n", $maxlen if $maxlen; printf "The input must match the pattern \"%s\".\n",$match if $match; if (@$keys) { print "The input must match one of the following keywords:\n"; print_cols $keys, 0, 0, 1; print "The keyword matching is case-sensitive.\n" if $Case_sensitive; } if (@$notkeys) { print "The input cannot match one of the following keywords:\n"; print_cols $notkeys, 0, 0, 1; print "The keyword matching is case-sensitive.\n" if $Case_sensitive; } print "\n"; ''; # cause another query } ############### # # query_table_process \@array, \&flagsub, \&querysub. # # Given an array suitable for query_table, run through the table and # perform &querysub on each query definition, invoking &flagsub on each # flag character. # # The local variables available to the subs are: # $table - the array reference # $flags - all the flags # $flag - the current flag being processed (&flagsub only) # $arg - the argument for the current flag, if appropriate. # $prompt - the prompt for the current query # # When the &querysub is invoked, if it returns UNDEF, then the query # table processing stops immediately, with an UNDEF return. sub query_table_process { local( $table ) = shift; # the query table local( $flagsub ) = shift; # sub to perform on each flag local( $querysub ) = shift; # sub to perform for each query local( $x, $prompt, $flags, $query_args, $argx, $flag, $_, $arg); ref($table) eq 'ARRAY' or (croak "query_table_process: Need an array reference argument.\n"); (ref($flagsub) eq 'CODE' or $flagsub eq '') and (ref($querysub) eq 'CODE' or $querysub eq '') or (croak "query_table_process: Need a code reference argument.\n"); for ($x = 0; $x <= $#$table; $x += 3) { $prompt = $table->[$x]; # get the prompt $flags = $table->[$x+1]; # get the flags $query_args = $table->[$x+2]; # get the arguments (if any) $argx = 0; # initialize arg index foreach $flag ( split(//, $flags) ) { $query_flags{$flag} or (croak "query_table_set_defaults: Unknown query flag: '$flag'\n"); $arg = ''; # set arg to null by default if (index($need_arg_codes, $flag) >= 0) { $arg = $query_args->[$argx++]; # get the next arg } &$flagsub if $flagsub ne ''; # run the flag sub } if ($querysub ne '') { # is there a querysub? &$querysub or return undef; # run the query } } 1; } ############### # # $ok = query_table \@array; # # $ok == undef if EOF returned # == 1 if all queries completed ok # == 0 if not. # # Run multiple queries given "query" entries in the @array. # # The array is organized like this: # # @array = ( prompt1, flags1, [ arglist1, ... ], # prompt2, flags2, [ arglist2, ... ], # ... # promptN, flagsN, [ arglistN, ...] ) # # Note: the query table is a N x 3 array, with the 3rd column being # itself arrays of varying lengths, depending upon the corresponding # flags. # # 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 - Table-driven query routine. =head1 SYNOPSIS =over 17 =item C> C B B B );> =back C<$result = B $I, $I, [ $I ];> C<$I = B \@I;> C \@I;> C<$I = B \@I, \&flagsub, \&querysub;> =head1 DESCRIPTION =head2 B The B 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 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; When C<$Force_Interactive> is a non-null, non-zero value, B will issue prompts, error messages, and ask for additional input even when the input is not interactive. =head2 B The B subroutine performs multiple queries, by invoking B, setting associated variables with the results of each query. Prompts, flags, and other arguments for each query are given in an array, called a I, which is passed to the B subroutine by reference. =head2 B The B subroutine causes any variables named in the given I array to be assigned their corresponding default values, if any. This is a non-interactive subroutine. =head2 B A general interface to processing a I is available with the B subroutine. It accepts a I array, and two subroutine references, a I<&flagsub> and a I<&querysub>. The I<&flagsub> is invoked on each each I character given in the I<$flags> argument of the I (see below). The I<&querysub> is invoked for each query in the I. The B and B subroutines both use B to perform their functions. =head2 I The format of the I array passed to B, B, and B subroutines is: @array = ( $prompt1, $flags1, [ $arglist1, ... ], $prompt2, $flags2, [ $arglist2, ... ], ... $promptN, $flagsN, [ $arglistN, ... ] ); In English, there are three items per query: a I string, a I string, and an array of arguments. Note that the syntax used above uses C<[ ... ]> to denote a Perl 5 anonymous array, not an optional set of arguments. Of course, if there are no arguments for a particular query, the corresponding anonymous array can be the null string or zero. The query table design is such that a query table can be created with a set of variables, their defaults, value constraints, and help strings, and it can be used to both initialize the variables' values and to interactively set their new values. The B subroutine performs the former, while B does the latter. =head2 Flag Characters With typical usage, given I<$prompt> and I<$flags>, B prints I<$prompt> and then waits for input from the user. The handling of the response depends upon the flag characters given in the I<$flags> string. The flag characters indicate the type of input, how to process it, acceptable values, etc. Some flags simply indicate the type or processing of the input, and do not require additional arguments. Other flags require that subsequent arguments to the B subroutine be given. The arguments must be given in the same order as their corresponding flag characters. The ordering of the flags in the I<$flags> argument is important -- it determines the ordering of the tests. For example, if both the B and B flags are given as C<"am">, then this indicates that an I subroutine call should be performed first, followed by a regular expression I test. All tests are applied in the order given in the I<$flags> until a particular test fails. When a test fails, an error message is generated and the input is reattempted, except in the case of the B flag. =head2 Flag Characters Without Arguments =over 5 =item B The input must be an integer. =item B The input must be a number, real or integer. =item B The input is a C<"yes"> or C<"no">, with a default answer of C<"yes">. =item B The input is a C<"yes"> or C<"no">, with a default answer of C<"no">. =item B Some input is I; an empty response will be refused. This option is only meaningful when there is no default input (see the B flag character below). =item B Strip and squeeze the input. Leading and trailing blanks are eliminated, and embedded whitespace is "squeezed" to single blank characters. This flag is implied by the B and B flags. =item B Do not treat input of B as a request for help. This disables automatic help, unless implemented with the I (B flag) subroutine. =back =head2 Flag Characters With Arguments The following flag characters indicate the presence of an argument to B. The arguments must occur in the same order as their corresponding flag characters. For example, if both the B and B flags are given as C<"Vh">, then the first argument must be the variable name, and the next the help string, in that order. =over 5 =item B I<\&after> The next argument is the I subroutine, to be invoked after the input has been solicited. This feature provides for an "open ended" input validation, completely at the control of the user of the Query module. The I subroutine is invoked in this manner: &$after( \$input ); If the I sub returns an C, then query processing stops with an immediate C return value. If the I sub returns a null or zero value, then the input is rejected and resolicted. No error messages are displayed except the "Please try again." message. Since the I sub has the reference to the I<$input> variable, it is free to change the value of input indirectly; ie: $$input = $some_new_value; =item B I<\&before> The next argument is the I subroutine, to be invoked before any input is attempted. If the I sub returns a non-null, non-zero value, the current query will be attempted. If a null or zero value is returned, the current query will be abandoned, with a null return. This feature, used in a I, allows for selective queries to be programmed by using I subs on the optional queries. For example, using the following anonymous sub as the B flag argument: sub { $> == 0; } will cause the corresponding query to only be issued for the C user. The ordering of the B flag in the I<$flags> argument is unimportant, since, by definition, this test is always performed before attempting any input. =item B I<$default> The next argument is the I input. This string is used instead of an empty response from the user. The default value can be a scalar value, a reference to a scalar value, or a reference to a subroutine, which will be invoked for its result only if a default value is needed (no input is given). =item B I<$help_string> The next argument is the I, which is printed in response to an input of "B". In order to enter a B as actual text, it must be prefixed with a backslash: "\". =item B I<\@array> The next argument is a reference to an array of allowable keywords. The input is matched against the array elements in a case-insensitive manner, with unambiguous abbreviations allowed. This flag implies the B flag. The matching can be made case-sensitive by setting the following variable prior to the invocation of B: $Query::Case_sensitive = 1; By default, this variable is null. =item B I<\@array> The next argument is a reference to an array of disallowed keywords In this case, for the input to be unacceptable, it must match exactly, case-insensitive, one of the array elements. This flag implies the B flag. The B option is useful for soliciting new, unique keywords to a growing list. Adding new fields to a database, for example. The matching can be made case-sensitive by setting the C<$Query::Case_sensitive> variable (see above). =item B I<$maxlen> The next argument specifies the maximum length of the input. =item B I<$regular_expression> The next argument specifies a regular expression pattern against which the input will be matched. =item B I<$reference> The next argument is the input: either a simple scalar value, or a I to a value, such as a C variable reference (eg: C<\$somevar>), or a C reference (eg: C). In any case, the resulting value is used as input instead of reading from STDIN. If the input returned by the reference does not match other constraints, additional input is not attempted. An error message is noted, and an C return is taken. This option is handy for applications which have already acquired the input, and wish to use the validation features of C. It is also useful to embed a query definition in a I which does not actually perform a query, but instead does a variable assignment dynamically, using the B reference value. =item B I<$reference> The next argument is the input I, as with the B flag, except that if the input fails any of the constraints, additional input is solicited from the input. In other words, the B flag sets a I only input reference. Think of it as I into the query loop with an initial input. =item B I The next argument is the variable name or reference to receive the validated input as its value. This option, and its corresponding variable name, would normally be present on all entries used with B in order to retain to the values resulting from each query. The value can either be a string representing the variable name, or a reference to a variable, eg: C<\$some_var>. =back =head2 Details The query processing proceeds basically in the same order as defined by the I argument, with some exceptions. For example, the I subroutine is always performed prior to input. There are implicit precedences in the ordering of some of the I tests. Generally, flags have their corresponding tests performed in the same order as the given flags. Some flag tests, however, require that other flags' tests be performed beforehand in order to be effective. For example, when given the B flag and an B flag, stripping the input would only be effective if the strip were done on the input before testing the input against the keyword table. In other words, the B flag has precedence over the B flag. If the user supplies the I string as C<"ks">, the effective ordering would still be C<"sk">. The table below indicates the precedences of the flag tests: Given Flag Flags With Higher Precedence ========== ================================ i (int) s (strip), d (default), h (help) k (key) s (strip), d (default), h (help) K (nonkey) s (strip), d (default), h (help) l (maxlen) d (default), h (help) m (match) d (default), h (help) n (numeric) s (strip), d (default), h (help) N (no) s (strip), d (default), h (help) r (required) d (default), h (help) s (strip) d (default), h (help) Y (yes) s (strip), d (default), h (help) Except for the implied precedence indicated in the table above, the ordering of the flag tests proceeds in the same order as given in the I argument. Excepting the precedences above, query processing proceeds generally as described below. =over 5 =item * If the B flag was given, the "before" subroutine is invoked as a "pre-input" test. If the sub returns a 0, empty string, or undef, the query is abandoned. Otherwise, processing continues. =item * If the B or B flags were given, then input is obtained, without prompting, from the associated reference. If the reference type is C, then it is invoked and the resulting return value is used as the input. Otherwise the reference is evaluated in a scalar context and used as the input. The B flag test is only done once, on the first entry into the input loop. =item * In the absence either the B or B flags, C will issue the given prompt and obtain input from STDIN. If an EOF occurs, an C value will result. =item * The input is examined for "null" input (that is, the empty string), and processing quits in this case. Since most input is obtained from STDIN, a null input indicates an end-of-file (EOF). If the input is not null, a terminating newline is removed, and the input testing continues. At this point, an empty input string does not indicate an EOF. =item * If the B, B, or B flags were given, the input is trimmed of leading and trailing blanks, and all whitespace is "squeezed" to single blanks. =item * If the input is an empty response, and there is a I input (B flag), use it instead. =item * Unless the B flag is given, if the input is the character "B" with nothing else, then print some helpful information. If the user had supplied a I, it is printed, otherwise the message: You are being asked "I<$prompt>" is displayed. Also, some information about the expected response, according to any given flag characters, is displayed. Finally, the user is returned to the prompt, and given another opportunity to enter a response. =item * If input is I (indicated by the B flag), and if the input is empty, produce an error message, and query again. =item * If there was a B flag, the corresponding I subroutine is invoked with the input reference as its argument. If the subroutine returns a non-null, non-zero value, the input succeeds, otherwise it fails. It is up to the I subroutine to display any appropriate error messages. =item * If the query was flagged B or B, match the input against the pattern: /^(y(es?)?|no?)$/i If the match fails, print an error message, and query again. When the match succeeds, replace the input with the complete word C<"yes"> or C<"no">; =item * If an integer response is required (B flagged), check for integer input. If not, print an error, and query again. A successful integer input is returned. =item * If a numeric response is required (B flagged), check for proper numeric input (either integer or real format). Errors produce a warning, and another query. =item * If the query was given a I table (flagged with B), the input is matched against the allowable keyword list. If an exact match is found, the keyword is returned as the input. Failing an exact match, an abbreviation search is performed against the keywords. If a single match is found, it is returned as the input. If no match is found, an error message is produced, and the user is returned to the query to try again. Otherwise, the input was ambiguous, an error noted showing the matches, and the user is queried again. The matching is case-insensitive or not, according to the value of the variable C<$Query::Case_sensitive>, which is nil, by default. The variable may be set by the user to change the matching from case-insensitive to case-sensitive. =item * If the query was given an unacceptable keyword list (flagged with B), the input is compared against the unacceptable keywords. If it matches any keywords exactly, an error is noted, and the query is performed again. The matching is case-insensitive by default. Set the variable C<$Query::Case_sensitive> to a non-null, non-zero value to make the keyword matching case-sensitive. =item * If the query was B flagged with a Perl regular expression pattern, then the input is matched against the pattern. Failures are noted with an error message, and the query reattempted. =item * If the query was B flagged with a maximum input length, the length of the input is checked against the maximum. A length violation is noted with an error message and the user is queried again. =item * If the query has a variable defined with the B flag, the variable is assigned the input string. This is always done last, after and only if all tests are successful. If the variable is a string name and not qualified with a package name (ie: C<$foo::variable>), then the variable is qualified at the level outside of the Query.pm module. =item * Finally, having passed whatever conditions were flagged, the input is returned to the user. =back =head1 EXAMPLE The following are typical usage samples: =over 5 =item * To perform a simple "yes" or "no" query, with "no" as the default answer: $ans = &query("Do you wish to quit? (yn)",'N'); =item * An equivalent alternative is: query "Do you wish to quit? (yn)", 'NV', \$ans; =item * To perform the same query, with some supplied helpful information: $ans = &query("Do you wish to quit? (yn)",'Nh',<<'EOF'); You are being asked if you wish to quit. If you answer "yes", then all changes will be lost. An answer of "no", will allow you to return to continue making changes. EOF =item * To solicit an integer input: $mode = &query("Please enter the file mode:",'idh','644',<<'EOF'); Please enter the 3 digit numeric file mode; if you are unsure of how the file mode is used, please see the man page for "chmod". EOF =item * To solicit one of several keywords: @keys = split(' ','SGI DEC IBM Sun HP Apple'); $vendor = &query('Please enter a vendor:','rkd',\@keys,'SGI'); =item * To solicit a new, unique keyword to be used as a database field name, with a regexp pattern to check it against: @fields = split(' ','Index Vendor Title'); # existing fields $newfield = &query('New field name:','rKm',\@fields,'^\w+$'); =back =head1 ENVIRONMENT =over 5 =item B This variable is used to control the width of output when listing the keyword arrays. If not defined, 80 is used by default. =back =head1 DEPENDENCIES =over 5 =item B Used to produce usage error messages. =item B Used to produce displays of the keyword arrays. =back =head1 FILES None. =head1 AUTHOR Copyright (C) 1995 Alan K. Stebbens This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =head1 DIAGNOSTICS =over 5 =item Input is required. Issued when an empty response is given, and there is no default input. =item Please answer with 'yes' or 'no', or enter '?' for help. Issued for B or B flagged queries, and the input is not reconizeable. =item Please enter an integer number. Printed when non-integer input is given for B flagged queries. =item Please enter a number, real or integer. Printed when non-numeric input is given for B flagged queries. =item The input 'I<$input>' is ambiguous; it matches the following: Issued in response to B flagged queries with input which matches more than one of the allowed keywords. =item The input 'I<$input>' fails to match any of the allowed keywords: Printed when input to a B flagged query does not match any of the keywords. =item The input '%s' matches a disallowed keyword '%s'. Printed when the input matches one of the unacceptable keywords given on a B flagged query. =item '%s' fails to match '%s' This results from input failing to match the regular expression given on a B flagged query. =item Input is %d characters too long; cannot exceed %d characters. The length of the input exceeded the maximum length given with the B flag argument. =item Please try again, or enter '?' for help. =item query: The k flag needs an array reference. The next argument in the argument list to B wasn't an array reference. =item query: The K flag needs an array reference. The next argument in the argumentlist to B wasn't an array reference. =head1 BUGS Term-Query-2.0.orig/Query_Test.pl0100644000175000017500000000117506234066517015457 0ustar ivanivan# Query_Test.pl # $Id$ # Author: Alan K. Stebbens use Term::Query qw( query ); use Tester; # General a test on query with input, and check against the expected # response. # # This is used in the class tests. sub query_test { my $class = shift; my $test = shift; my $inputstring = shift; my $qargs = shift; my $condition = shift; local $_; Tester::run_test_with_input $class, $test, $inputstring, sub { $_ = query @_; exit if /^\s*(exit|quit|abort)\s*$/; printf "Answer = \"%s\"\n",(length($_) ? $_ : defined($_) ? 'NULL' : 'undef'); }, $qargs, $condition; } 1; Term-Query-2.0.orig/README0100644000175000017500000000702306400517707013671 0ustar ivanivanThis is the README file ($Revision: 1.2 $) for Term::Query.pm. Term::Query.pm is a Perl 5 module, which performs generalized queries on various kinds of values. Validation and normalization of input, based on the type, is automated, as is error reporting and re-solicitation of input. Input of '?', unless configured otherwise, provides useful, helpful information, based on the expected input type, even in the absence of a programmer-supplied help string. There is one primary subroutine, called "query", which is passed a prompt and some "flags", optionally followed by addtional arguments, depending upon the particular flags. The flags are single characters which indicate: * input type: integer, real, string, yes-no, keyword, or non-keyword; * default input, in the absence of user input; * help string, to be reported for errors or input of '?'; * input validation, such as regexp matching, maximum length, and "check" subroutine calls; * input handling, such as blank squeezing, and "before" subroutine calls. * name of the variable to be set with the validated input. An accompanying subroutine, query_table, can be passed an array of of arguments which will be interatively passed to query, allowing for easy generation of table-driven query-response input routines. The subroutine query_table_set_defaults can be used on a query table array to cause any mentioned variables to be initialized with any mentioned default values. This is handy for having a single table defining variables, their default values, and the validation criteria for setting new values. The subroutine query_table_process can be used on a query table array to process the array in a complete general fashion. Complete details are provided within the module, in the Perl 5 "pod" format. Traditional man pages are available with the command: pod2man Query.pm | nroff -man - The code was developed and requires Perl5.001m (eg: it uses references), Carp.pm (it diagnoses some misuse of itself) and the PrintArray.pm module (by the same author). There is a Makefile with several useful targets for installing at one or more common locations; there is a "test" target which will perform regression tests against previous "good" output (see the "t" directory). WARNING: The "make test" is currently under development, and does not work. The Query.pm module does work as advertised (except for unreported bugs :^) The Query.pm archive is available under the GNU General License, Version 2, and is located at: http://reality.sgi.com:80/aks/depot/perl/term/Term-Query-2.0.tar.gz as well as your favorite CPAN site (see "http://www.perl.com/CPAN"). Suggestions or improvements are welcome. Copyright (C) 1995-1997 Alan K. Stebbens This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ___________________________________________________________ Alan Stebbens http://reality.sgi.com/aks Term-Query-2.0.orig/Tester.pm0100644000175000017500000001274506234071054014617 0ustar ivanivan# Tester.pm module # $Id$ # # This package is designed to run tests on modules which # perform interactively. package Tester; @ISA = qw( Exporter ); @EXPORT = qw( run_test_with_input run_class_test ); # run_test_with_input $class, $testno, $input, # \&testsub, $testargsref, $condition. 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); pipe(CHILDREAD, TESTWRITE); if (!fork) { open(STDIN, "<&CHILDREAD"); open(STDOUT, ">&CHILDWRITE"); select(STDOUT); $| = 1; open(STDERR, ">&STDOUT"); select(STDERR); $| = 1; close CHILDREAD; close CHILDWRITE; select(STDOUT); $| = 1; # Finally, after all that -- run the actual test subroutine my $sub = eval 'sub { package main; &{$_[0]}(@{$_[1]}); }'; $_ = &$sub($testsub, $testargs); # The condition must be evaluated here, in the child # process -- since it may involve variables which have # been set in the child (but not the parent) if ($condition) { my $sub = eval 'sub { package main; ref($_[0]) eq "CODE" ? &{$_[0]} : eval $_[0]; }'; &$sub($condition) or print "Condition failed\n"; } close STDOUT; close STDIN; exit; } close CHILDREAD; close CHILDWRITE; # Generate the output print TESTWRITE $inputstring."\n"; close TESTWRITE; # will cause an EOF my @output; while () { # Now get the results push(@output, $_); print if $Details > 1; } close TESTREAD; $SIG{'PIPE'} = 'DEFAULT'; # normal pipe stuff # If reference output doesn't exist, generate it from our # current input my $testdir = -d "t" ? "t" : -d "../t" ? "../t" : -d "../../t" ? "../../t" : die "Can't find 't'!\n"; my $testref = "$testdir/$class.$test.ref"; my $testout = "$testdir/$class.$test.out"; my @Details = (); if (! -f $testref) { push(@Details,"Generated reference output.") if $Details > 1; open(NEWREF,">$testref"); print NEWREF @output; close NEWREF; } if (open(OUT,">$testout")) { print OUT @output; close OUT; } else { die "Cannot open output file: $testout: $!\n"; } open(REF,$testref) or die "Can't open '$testref': $!\n"; my $notok = ''; my $refout; for ($i = 0; $i <= $#output; $i++) { length($refout = ) || last; $notok++ if $output[$i] =~ /condition failed/i; next if $output[$i] eq $refout; $notok++; if ($Details) { push(@Details, sprintf("line %d: \"%s\"", $i, $output[$i])); push(@Details, sprintf("should be: \"%s\"", $refout)); } last; } if ( $i <= $#output) { $notok++; push(@Details, "reference output has less lines.") if $Details; } elsif ( !eof(REF) ) { $notok++; push(@Details, "reference output has more lines.") if $Details; } close REF; if ($notok) { print "not ok\n"; } else { print "ok\n"; unlink $testout; } print "\t".join("\n\t", @Details)."\n" if @Details; undef @Details; } # Run a class of tests # Just like the Perl tests # run_test_class class_name; # # * The file testdir/$class.pl must exist # * The subroutine &$class_Tests will be invoked. sub run_class_test { my $class = shift; my $testdir = -d "t" ? "t" : -d "../t" ? "../t" : -d "../../t" ? "../../t" : die "Can't find 't'!\n"; my $testmodule = "$testdir/$class.pl"; my $failed; if ( ! -f $testmodule ) { print STDERR "No such test for class: $class.\n"; return; } select(STDOUT); $| = 1; print substr($class.('.' x 15),0,15); if (!(open(STDIN,"-|"))) { open(STDIN,"/dev/null"); open(STDERR,">&STDOUT"); select(STDERR); $| = 1; select(STDOUT); $| = 1; do $testmodule; # execute the test code exit; } my( $range, $begin, $end ); my( $test, $status ); $range = ; # get the test range if ($range =~ /^(\d+)\.\.(\d+)/) { ($begin, $end) = ($1, $2); } else { # Non-standard test output -- print it, and exit. do { print "! $_\n"; } while ($_ = ); return; } @Test{$begin .. $end} = ($begin .. $end); while () { chomp; if (s/^(\d+)\.+((?:not )?ok)\s*//) { ($test, $status) = ($1, $2); $Test{$test} = $status; if ($status eq 'not ok') { $Test{$test} .= ": ".$_ if length; $failed++; } } elsif ($test) { $Test{$test} .= "\n".$_; } else { print "! $_\n"; } } close STDIN; if ($failed) { my @failed = grep($Test{$_} =~ /not/, keys %Test); my @msgs = @Test{@failed}; if ($#failed == $[) { printf "Test %s failed %s", $failed[0], $Test{$failed[0]}; } else { my $last = pop @failed; printf "Tests %s and %s failed", join(", ", @failed), $last; push(@failed, $last); } foreach (@msgs) { s/not ok[:,\s;]*//; } @msgs = grep(/./,@msgs); if (@msgs) { printf ":\n\t".join("\n\t", @msgs)."\n" if @msgs; } else { print ".\n"; } foreach $test (@failed) { $testout = "$testdir/$class.$test.out"; next unless -f $testout; open(OUT,$testout) or next; print "Test $test results:\n"; while () { print "\t".$_; } close OUT; } exit unless $KeepGoing; } else { print "ok\n"; } } 1; Term-Query-2.0.orig/t/0042755000175000017500000000000006400520003013236 5ustar ivanivanTerm-Query-2.0.orig/t/.1.out0100644000175000017500000000034106400512474014213 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 223. Use of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "foo bar" Term-Query-2.0.orig/t/.1.ref0100644000175000017500000000002306202730015014146 0ustar ivanivanAnswer = "foo bar" Term-Query-2.0.orig/t/.10.out0100644000175000017500000000026106400512475014275 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "2.828" Condition failed Term-Query-2.0.orig/t/.10.ref0100644000175000017500000000004206202730016014230 0ustar ivanivanAnswer = "2.828" Condition failed Term-Query-2.0.orig/t/.11.out0100644000175000017500000000041006400512475014272 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. "input" fails to match "^(SGI|HP|Sun|DEC)$" Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Term-Query-2.0.orig/t/.11.ref0100644000175000017500000000007506202730016014237 0ustar ivanivan"input" fails to match "^(SGI|HP|Sun|DEC)$" Answer = "undef" Term-Query-2.0.orig/t/.12.out0100644000175000017500000000045706400512475014306 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. The input "input" fails to match any of the allowed keywords: SGI HP Sun DEC IBM Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Term-Query-2.0.orig/t/.12.ref0100644000175000017500000000014306202730016014234 0ustar ivanivanThe input "input" fails to match any of the allowed keywords: SGI HP Sun DEC IBM Answer = "undef" Term-Query-2.0.orig/t/.13.out0100644000175000017500000000045706400512475014307 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. The input "input" fails to match any of the allowed keywords: SGI HP Sun DEC IBM Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Term-Query-2.0.orig/t/.13.ref0100644000175000017500000000014306202730016014235 0ustar ivanivanThe input "input" fails to match any of the allowed keywords: SGI HP Sun DEC IBM Answer = "undef" Term-Query-2.0.orig/t/.14.out0100644000175000017500000000024006400512475014276 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "input" Term-Query-2.0.orig/t/.14.ref0100644000175000017500000000002106202730016014231 0ustar ivanivanAnswer = "input" Term-Query-2.0.orig/t/.2.out0100644000175000017500000000024006400512474014212 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "snafu" Term-Query-2.0.orig/t/.2.ref0100644000175000017500000000002106202730015014145 0ustar ivanivanAnswer = "snafu" Term-Query-2.0.orig/t/.3.out0100644000175000017500000000041706400512474014221 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Please answer with "yes" or "no". Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Condition failed Term-Query-2.0.orig/t/.3.ref0100644000175000017500000000010406202730015014150 0ustar ivanivanPlease answer with "yes" or "no". Answer = "undef" Condition failed Term-Query-2.0.orig/t/.4.out0100644000175000017500000000041706400512474014222 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Please answer with "yes" or "no". Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Condition failed Term-Query-2.0.orig/t/.4.ref0100644000175000017500000000010406202730015014151 0ustar ivanivanPlease answer with "yes" or "no". Answer = "undef" Condition failed Term-Query-2.0.orig/t/.5.out0100644000175000017500000000037406400512474014225 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Please enter an integer number. Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Term-Query-2.0.orig/t/.5.ref0100644000175000017500000000006106202730015014154 0ustar ivanivanPlease enter an integer number. Answer = "undef" Term-Query-2.0.orig/t/.6.out0100644000175000017500000000023506400512474014222 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "no" Term-Query-2.0.orig/t/.6.ref0100644000175000017500000000001606202730015014155 0ustar ivanivanAnswer = "no" Term-Query-2.0.orig/t/.7.out0100644000175000017500000000024106400512475014221 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 674, chunk 1. Answer = "3.1415" Term-Query-2.0.orig/t/.7.ref0100644000175000017500000000002206202730015014153 0ustar ivanivanAnswer = "3.1415" Term-Query-2.0.orig/t/.8.out0100644000175000017500000000040406400512475014223 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Please enter a number, real or integer. Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Term-Query-2.0.orig/t/.8.ref0100644000175000017500000000007106202730016014161 0ustar ivanivanPlease enter a number, real or integer. Answer = "undef" Term-Query-2.0.orig/t/.9.out0100644000175000017500000000042506400512475014227 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Please enter a number, real or integer. Use of uninitialized value at Query_Test.pl line 24, chunk 1. Use of uninitialized value at Query_Test.pl line 25, chunk 1. Answer = "undef" Condition failed Term-Query-2.0.orig/t/.9.ref0100644000175000017500000000011206202730016014156 0ustar ivanivanPlease enter a number, real or integer. Answer = "undef" Condition failed Term-Query-2.0.orig/t/CVS/0042755000175000017500000000000006400520003013671 5ustar ivanivanTerm-Query-2.0.orig/t/CVS/Entries0100644000175000017500000000205306233173104015232 0ustar ivanivan/.1.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.10.out/1.1.1.1/Fri Aug 9 21:39:26 1996// /.10.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.11.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.12.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.13.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.14.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.2.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.3.out/1.1.1.1/Fri Aug 9 21:39:25 1996// /.3.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.4.out/1.1.1.1/Fri Aug 9 21:39:25 1996// /.4.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.5.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.6.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.7.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /.8.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /.9.out/1.1.1.1/Fri Aug 9 21:39:26 1996// /.9.ref/1.1.1.1/Fri Aug 9 21:39:26 1996// /Defaults.1.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /Defaults.2.ref/1.1.1.1/Fri Aug 9 21:39:25 1996// /Defaults.pl/1.1.1.1/Fri Aug 9 21:39:25 1996// /General.pl/1.1.1.1/Fri Aug 9 21:39:25 1996// /Refs.pl/1.1.1.1/Fri Aug 9 21:39:25 1996// /Tables.pl/1.1.1.1/Fri Aug 9 21:39:25 1996// Term-Query-2.0.orig/t/CVS/Repository0100644000175000017500000000004506233205114015774 0ustar ivanivan/usr/cvsroot/perl/Term-Query/testdir Term-Query-2.0.orig/t/Defaults.1.out0100644000175000017500000000012006400512474015676 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Answer = "right" Term-Query-2.0.orig/t/Defaults.1.ref0100644000175000017500000000002106202730015015634 0ustar ivanivanAnswer = "right" Term-Query-2.0.orig/t/Defaults.2.out0100644000175000017500000000012006400512474015677 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Answer = "right" Term-Query-2.0.orig/t/Defaults.2.ref0100644000175000017500000000002106202730015015635 0ustar ivanivanAnswer = "right" Term-Query-2.0.orig/t/Defaults.pl0100644000175000017500000000054206202730015015344 0ustar ivanivan#!/usr/local/bin/perl unshift(@INC, '.', '..'); require 'Query_Test.pl'; $Class = 'Defaults'; print "1..2\n"; $aVar = 'wrong'; &query_test( $Class, 1, '', ['Setup aVar','rdIV', 'right', "\n", 'aVar'], '$\'aVar eq "right"'); $aVar = 'bad stuff'; &query_test( $Class, 2, '', ['Setup aVar','rdIV', 'right', "\n", \$aVar], '$aVar eq "right"'); 1; Term-Query-2.0.orig/t/Defaults.t0100644000175000017500000000000006202730015022775 1Term-Query-2.0.orig/t/Defaults.plustar ivanivanTerm-Query-2.0.orig/t/General.pl0100644000175000017500000000323106233205227015156 0ustar ivanivan#!/usr/local/bin/perl unshift(@INC, '.', '..'); require 'Query_Test.pl'; @keywords = qw( SGI HP Sun DEC IBM ); @fields = qw( Index Title Vendor ); print "1..14\n"; &query_test( $Class, 1, 'foo bar', ['Enter anything:'] ); &query_test( $Class, 2, 'snafu', ['Enter a required value:','r'] ); &query_test( $Class, 3, "foo", ['Enter a yes or no:','Y'], "/y/" ); &query_test( $Class, 4, "foo\nn", ['Enter a yes or no:','Y'], "/n/" ); &query_test( $Class, 5, "bad\n88", ['Enter an integer:','ridh', 5, 'This is some help for an int query.'] ); &query_test( $Class, 6, '', ['Enter a yes or no:','N'] ); &query_test( $Class, 7, '', ['Enter a number:','nrd', 3.1415] ); &query_test( $Class, 8, "bad\n99.9", ['Enter a number:','nrd', 3.1415] ); &query_test( $Class, 9, "bad", ['Enter a number:','nrd', 3.1415], "/3\\.1415/" ); &query_test( $Class, 10, '2.828', ['Enter a number:','nrd', 3.1415], "/2\\.828/" ); &query_test( $Class, 11, 'input', ['Enter a matching keyword:','rmdh', '^(SGI|HP|Sun|DEC)$', # match pattern ' 'SGI', # default 'Answer one of SGI, HP, Sun, or DEC.'] ); # help string &query_test( $Class, 12, 'input', ['Enter a keyword:','rdkh', 'SGI', # default \@keywords, # keyword table 'Enter a vendor keyword.'] ); # helpstring $Query::Case_sensitive = 1; &query_test( $Class, 13, 'input', ['Enter a keyword (case-sensitive):','rdkh', 'SGI', # default \@keywords, # keyword table 'Enter a case-sensitive vendor keyword.'] ); # helpstring $Query::Case_sensitive = ''; &query_test( $Class, 14, 'input', ['Enter a new keyword:','rKh', \@fields, # anti-keyword list 'Enter a new field name.'] ); 1; Term-Query-2.0.orig/t/General.t0100644000175000017500000000000006233205227022417 1Term-Query-2.0.orig/t/General.plustar ivanivanTerm-Query-2.0.orig/t/Refs.1.ref0100644000175000017500000000036206234071064015003 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. The input "Index" matches a disallowed keyword "Index". Use of uninitialized value at Query_Test.pl line 24. Use of uninitialized value at Query_Test.pl line 25. Answer = "undef" Term-Query-2.0.orig/t/Refs.2.ref0100644000175000017500000000012506234071064015001 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Answer = "Good stuff" Term-Query-2.0.orig/t/Refs.3.ref0100644000175000017500000000012506234071064015002 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Answer = "Good stuff" Term-Query-2.0.orig/t/Refs.4.ref0100644000175000017500000000011506234071065015003 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Answer = "no" Term-Query-2.0.orig/t/Refs.pl0100644000175000017500000000132206202730015014471 0ustar ivanivan#!/usr/local/bin/perl unshift(@INC, '.', '..'); require 'Query_Test.pl'; $Class = 'Refs'; @keywords = qw(SGI HP Sun DEC IBM); @fields = qw(Index Title Vendor); print "1..4\n"; $foo = $fields[0]; # this should fail &query_test( $Class, 1, '', ['Ignored prompt', 'rKIV', \@fields, \$foo, 'bar'] ); $foo = 'Good stuff'; $bar = 'Bad stuff'; &query_test( $Class, 2, '', ['Ignored prompt', 'rKIV', \@fields, \$foo, 'bar'], '$bar eq "Good stuff"' ); $foo = 'Good stuff'; $bar = 'Bad Stuff'; &query_test( $Class, 3, '', ['Ignored prompt', 'rKIV', \@fields, \$foo, \$bar], '$bar eq "Good stuff"' ); $ans = 'Bad news'; &query_test( $Class, 4, "", ["Do you wish to quit?", 'NV', \$ans], '$ans =~ /no/' ); 1; Term-Query-2.0.orig/t/Refs.t0100644000175000017500000000000006202730015021255 1Term-Query-2.0.orig/t/Refs.plustar ivanivanTerm-Query-2.0.orig/t/Tables.1.ref0100644000175000017500000000016606233205135015315 0ustar ivanivan $int1 = "4" $int2 = "5" $num3 = "3.1415" $yn4 = "3.1415" $yn5 = "3.1415" $key6 = "IBM" $nonkey7 = "IBM" Term-Query-2.0.orig/t/Tables.2.out0100644000175000017500000000157306400512476015361 0ustar ivanivanUse of uninitialized value at blib/lib/Term/Query.pm line 242. Use of uninitialized value at blib/lib/Term/Query.pm line 242, chunk 1. Use of uninitialized value at blib/lib/Term/Query.pm line 242, chunk 2. Use of uninitialized value at blib/lib/Term/Query.pm line 242, chunk 3. Use of uninitialized value at blib/lib/Term/Query.pm line 242, chunk 4. Use of uninitialized value at blib/lib/Term/Query.pm line 242, chunk 5. The input "IBM" fails to match any of the allowed keywords: Use of uninitialized value at /usr/share/lib/perl5/site_perl/Array/PrintCols.pm line 58, chunk 6. query_table returned 1 $int1 = "4" $int2 = "5" $num3 = "3.1415" $yn4 = "yes" $yn5 = "no" Use of uninitialized value at t/Tables.t line 28, chunk 6. $key6 = "" Use of uninitialized value at t/Tables.t line 28, chunk 6. $nonkey7 = "" Term-Query-2.0.orig/t/Tables.2.ref0100644000175000017500000000027406234066764015334 0ustar ivanivanThe input "IBM" fails to match any of the allowed keywords: query_table returned 1 $int1 = "4" $int2 = "5" $num3 = "3.1415" $yn4 = "yes" $yn5 = "no" $key6 = "" $nonkey7 = "" Term-Query-2.0.orig/t/Tables.pl0100644000175000017500000000201406234066713015017 0ustar ivanivan#!/usr/local/bin/perl unshift(@INC, '.', '..'); use Tester; use Term::Query qw(query_table_set_defaults query_table); $Class = 'Tables'; @qtbl = ( 'Integer 1', 'rVidh', [ 'int1', 4, 'Asking for integer 1', ] , 'Integer 2', 'Vid', [ 'int2', 5, ], 'Number 3', 'Vndh', [ 'num3', 3.1415, 'Asking for a number', ], 'Yes or No 4','VYh', [ 'yn4', "Asking yes or no", ], 'No or Yes 5','VNh', [ 'yn5', "Asking no or yes", ], 'Keyword 6', 'rVkdh', [ 'key6', \@keywords, 'IBM', 'Asking for a keyword', ], 'Nonkey 7', 'VrKh', [ 'nonkey7', \@fields, 'Asking for a new keyword', ], ); sub show_vars { foreach $var ( qw( int1 int2 num3 yn4 yn5 key6 nonkey7 ) ) { $val = $$var; print " \$$var = \"$val\"\n"; } } print "1..2\n"; Tester::run_test_with_input $Class, 1, '', sub { query_table_set_defaults \@qtbl; show_vars; }; Tester::run_test_with_input $Class, 2, "\n\n\n\n\n\n\n", sub { $ok = query_table \@qtbl; print "query_table returned $ok\n"; show_vars; }; Term-Query-2.0.orig/t/Tables.t0100644000175000017500000000000006234066713022117 1Term-Query-2.0.orig/t/Tables.plustar ivanivanTerm-Query-2.0.orig/test.pl0100755000175000017500000000424706233174757014345 0ustar ivanivan#!/usr/local/bin/perl # # Test driver for Term::Query.pm # use Term::Query qw( query query_table query_table_set_defaults ); use Tester; require "Query_Test.pl"; @ARGV = ('all') unless @ARGV; $Term::Query::Force_Interactive = 1; # force interactive behaviour while ($_ = shift) { if (!index('-debug', $_)) { $Debug++; } elsif (!index('-details', $_)) { $Details++; } elsif (!index('-keep', $_)) { $KeepGoing++; } elsif (!index('-output', $_)) { $ShowOutput++; } elsif (!index('-help',$_)) { &usage; } else { $a = $_; run_class_test 'General' if grep(/^-?$a/i, qw( general all)); run_class_test 'Refs' if grep(/^-?$a/i, qw( refs references all)); run_class_test 'Defaults' if grep(/^-?$a/i, qw( defaults all )); run_class_test 'Tables' if grep(/^-?$a/i, qw( tables all )); run_class_test 'Subs' if grep(/^-?$a/i, qw( subs all )); } } exit; sub usage { print STDERR <