#---------------------------------------------------------------------
+-------------
# ARCHIVE.PL
#
# Upon execution it looks for the archive.ini in the local director
+y or argv0 directory
# It reads in the ini file and determins by it how to archive the d
+irectory.
#
#---------------------------------------------------------------------
+-------------
# Use this to archive program directorys and know what has changed
# Then zip the directory up.
#---------------------------------------------------------------------
+-------------
# Version info
# B 0.1 Basic functionality BETA
#---------------------------------------------------------------------
+-------------
#Force my on all varables
use strict;
#Date manipulation program
#Get package in PPM install TimeDate
use Date::Format;
#Base install
#Base level win32 perl process controller
use Win32;
use Win32::Process ;
#Base install
#Used to get command line options
use Getopt::Long;
#Used for recursion PPM install File::Tools
use File::Recurse;
#Base install
#Used for the cwd() fucntion
use Cwd;
#FindBin base install
#Used to get local path to executiable
use FindBin;
#Varables
my %options; #Stores the options from ini file in pl dir
my %ini; #stores ini specifications
my $dir = cwd(); #Get current dirctory
my $zip_name; #Name of the zip file
my $ini_arg; #Path to ini if specified in command line
my $opt_recurse; #Recurse subdirectorys and archive them
my $opt_unatt; #Unattended mode
my $opt_make; #Make archive.ini
my $opt_help; #Show help screen
my $opt_log; #Write results to log
my $opt_arcall; #Force archiving all
my $opt_genmake; #Generate make based on options.ini and genmak
+e_make sub
my $no_chg; #Status flag for no change
my @diffrence; #Hold comparison directory info
my $make_ver = "1.2"; #Holds the make version used to detect change
+s in archive.ini specifications
#Clean directory / to \. for some reason, cwd uses UNIX style seperato
+rs...
$dir =~ tr{/}{\\};
#Get the arguments
GetOptions(
"rec:s" => \$opt_recurse, #Recures sub files
"unatt" => \$opt_unatt, #Batch mode
"make" => \$opt_make, #Makes an ini file
"genmake" => \$opt_genmake, #Autogenerates a make ini file
"log:s" => \$opt_log, #Logging enable
"help" => \$opt_help #Display Help Screen
);
#Banner
print "Archive version beta B 0.1 10/29/2002 by Fred Grass\n";
#Get the options from options.ini in the base program directory
get_options();
#Check for argument directory passed in.
if(defined($ARGV[0])) {
$dir = $ARGV[0];
}
#Redirects stdout to a log file
if (defined($opt_log)) {
#Check to see if any argument was passed
if ($opt_log eq "") {
#If argument specifyed but nothing in string assume c:\
$opt_log = "c:\\";
}
#Remove trailing \
if ($opt_log =~ /\\$/) {
$opt_log = substr($opt_log,0,length($opt_log) - 1);
}
#Check to see if a file or directory is supplied
if ($opt_log !~ /\./) {
$opt_log .= "\\" . time2str("%Y%m%d", time) . "log";
}
#Redirect the output
open (logfile, ">>" . $opt_log );
#Redirect stdout to logfile.
(*STDOUT) = (*logfile);
#Prit the log date tiime
print "\nLog Date/Time :" . time2str("%m/%d/%Y %H:%M", time
+) . "\n";
}
#Makes the ini file
if (defined($opt_make)) {
#Starts the interactive make subroutiene
make_ini();
#Force exit program
exit 0;
}
#Generates a make ini file
if (defined($opt_genmake)) {
#Starts the command line automated make
genmake_ini();
#Force exit program
exit 0;
}
#Check for help
if (defined($opt_help)) {
#Show help screen
help();
#Force exit program
exit 0;
}
#Check for recursion
if (defined($opt_recurse)) {
#Check for options
if ($opt_recurse eq "arcall") {
$opt_arcall = " ";
}
#Loop through the dirctorys
recurse {
tr{/}{\\};
if(/archive.ini/) {
#Turn off sys_commentss and add a the recurse sys_comments
+.
$ini{"sys_comments"} = "Recursive arcive from $dir";
#Setup the argumetn to process arc
$ini_arg = $_;
#Get the dir part
m/(.*)archive\.ini/;
$dir = $1;
#Main archve processing
process_arc();
#Line break aftewards.
print "\n";
}
} $dir;
#Force exit program
exit 0;
}
#If all else fails run the program in no arg mode
#Main archve processing
process_arc();
#---------------------------------------------------------------------
+-------------
# PROCESS_ARC
#
# Archives a directory.
#
#---------------------------------------------------------------------
+-------------
sub process_arc {
#Initilze changes
$no_chg = 0;
#Finds and gets ini lines
get_ini();
#Print archive info
print "Archve Source :" . $ini{"archive_source"} . "\n";
print "Archve Destination :" . $ini{"archive_destination"} . "\
+n";
#Generate compairson list
make_comp();
#If arch all specified then force archive with no changes
if (defined($opt_arcall)) {
$no_chg = 0;
print "Forced archiving even if no changes.\n";
}
#If there are changes archive else abort archive
if (!$no_chg) {
#Makes the directories
make_dest();
#Makes the archive information text file
make_arc_txt();
#Runs pkzip25 to archive
run_zip();
print "Completed!\n";
} else {
print "Archive aborted because of no change\n";
}
#De init
%ini = ();
}
#---------------------------------------------------------------------
+-------------
# GETINI
#
# Finds the ini and reads the file into @ini_lines
#
#---------------------------------------------------------------------
+-------------
sub get_ini {
#Varables
my $inipath;
my $element;
my $value;
#Check for argument if exists use else look for archive.ini
if ( $ini_arg ne "" ) {
$inipath = $ini_arg;
} else {
$inipath = $dir . "\\archive.ini";
}
#Check for existance of ini file
if (!-e$inipath) {
die "Error, ini not found program execution halted!\nfor help
+type archive -help\n";
}
#Open and save compelte file in array
open (infile, $inipath) or die "Can't open $inipath! $!";
#Store entire file in a set
foreach (<infile>) {
chomp;
($element, $value ) = split(/\|/);
$ini{$element} = $value;
}
#De-Init
close(infile);
#Check make version
if ($ini{make_ver} ne $make_ver) {
if (!defined($opt_unatt)) {
#Force remake of ini when version changes
make_ini();
#Show message
print "Inifile recreated.\n";
#Exit the program
exit 0;
} else {
print "Unattended mode\n Attemping to guess ini setup.\n";
#Guess subdir options
if (defined($ini{"no_subdir"})) {
$ini{"zip_options"} = "";
}
#Guess comments on or off
if (defined($ini{"no_comment"})) {
$ini{"comments"} = "off";
}
}
}
#Used to start or stop procesing of subdirecectorys
if($ini{zip_options} =~ /-rec/ and $ini{zip_options} =~ /-path/) {
#If zip_options have -rec and -path in it then turn on subdire
+ctorys by undefing no_subdir
$ini{"no_subdir"} = undef;
} else {
#Else define it by putting a space in it.
$ini{"no_subdir"} = " ";
}
}
#---------------------------------------------------------------------
+-------------
# GET_OPTIONS
#
# Used to read in options from options.ini in the same directory as
+ archive.pl
# I use this for -genmake so I can automate archive.ini configurati
+on
#
#---------------------------------------------------------------------
+-------------
sub get_options {
#Varables
my $pldir = $FindBin::Bin; #Gets the path to program
#Clean up pldir
$pldir =~ s/\//\\/g;
#Get options if exist
if (-e $pldir . "\\options.ini") {
#Open input options.ini
open(INPUT,$pldir . "\\options.ini");
#Loop through file
while(<INPUT>) {
#Get rid of cr/lf
chomp;
#Get information out
m/(.*)\|(.*)/;
#Store information
$options{$1} = $2;
}
#Close file
close(INPUT);
} else {
#Force genmake off
if (defined($opt_genmake)) {
#Show error
print "Can't generate a make with no options.ini.\n";
#Exit program
exit 0;
}
}
}
#---------------------------------------------------------------------
+-------------
# MAKE_COMP
#
# Reads in filelist.txt and compares to current files to generate
# a change report.
#
#---------------------------------------------------------------------
+-------------
sub make_comp {
#Varables
my @current; #Holds new directory info
my @old; #Holds old directory info
my @greplist; #used for grep
my $writetime; #used for time
my $filename; #used for file name
my $changes = 0; #Counts changes
my $input; #Holds my stdin
#Run through subdirectories getting file names
recurse {
#Get rid of forward slashes
tr{/}{\\};
#Take the base directory off the file name
$filename = substr($_,length($dir) + 1);
#Eliminate archive files and directories
if (!-d$filename and !/archive.ini/ and !/archive.txt/) {
#Check for recursion
if (defined($ini{"no_subdir"})) {
#if recursing off eliminate filenames with a \
if ($filename !~ /\\/) {
#Get the file date time
$writetime = time2str('%Y%m%d%H%M',(stat($_))[9]);
#Push file info into @current
push @current, $filename . "|" . $writetime ;
}
} else {
#Include subdirectorys in processing
#Get the file date time
$writetime = time2str('%Y%m%d%H%M',(stat($_))[9]);
#Push file info into @current
push @current, $filename . "|" . $writetime ;
}
}
} $dir;
#Check for existance of filelist.txt
if (-e$ini{"archive_destination"} . "\\filelist.txt") {
#Open compare file in archive destination and store it in old
open(COMPFILE, $ini{"archive_destination"} . "\\filelist.txt")
+ or die "Can't open file $!";
#Loop thorugh compare file
foreach (<COMPFILE>) {
#Get rid of cr/lf
chomp;
#Push info into hold
push @old, $_;
}
#Close the file
close(COMPFILE);
}
#If direcory dose not exist then make it
if (!-e $ini{"archive_destination"}) {
#Create the dirctory
mkdir $ini{"archive_destination"};
}
#Open filelist.txt for witing
open(COMPFILE, ">" . $ini{"archive_destination"} . "\\filelist.txt
+") or die "Can't open file $!";
#Loop though the current directory contents
foreach (@current) {
#Write out current file list to the file
print COMPFILE $_ . "\n";
#Parse the record in to individual data fields
($filename, $writetime) = split(/\|/);
#Fix search problem
$filename =~ s/\\/./;
#Grep old for the current file
@greplist = grep(/$filename/,@old);
#Reget arguments
($filename, $writetime) = split(/\|/);
#Put formatting into date time
$writetime =~ s/(....)(..)(..)(..)(..)/$2\/$3\/$1 $4:$5/;
#If grep found it check it
if (defined($greplist[0])) {
#Check for equals
if ($greplist[0] eq $_) {
#Push No Change on diffrence
push @diffrence, "No Change :" . $writetime . " " . $
+filename ;
}
#Check for greater than
if ($greplist[0] gt $_) {
#Increment the changes counter
$changes ++;
#Push Latest change on diffrence
push @diffrence, "Latest :" . $writetime . " " . $file
+name ;
}
#Check for less than
if ($greplist[0] lt $_) {
#Increment the changes counter
$changes ++;
#Push Latest change on diffrence
push @diffrence, "Latest :" . $writetime . " " . $
+filename ;
}
} else {
#Increment the changes counter
$changes ++;
#Not found by grep then its a new file
#Push New File change on diffrence
push @diffrence, "New File :" . $writetime . " " . $file
+name ;
}
}
#Check for missing files
foreach (@old) {
#Parse the record in to individual data fields
($filename, $writetime) = split(/\|/);
#Fix search problem
$filename =~ s/\\/./;
#Grep old for the current file
@greplist = grep(/$filename/,@current);
#Reget arguments
($filename, $writetime) = split(/\|/);
#Put formatting into date time
$writetime =~ s/(....)(..)(..)(..)(..)/$2\/$3\/$1 $4:$5/;
#If grep found it check it
if (!defined($greplist[0])) {
#Dont up change count here for deleted files
#Push Missing change on diffrence
push @diffrence, "Missing :" . $writetime . " " . $file
+name ;
}
}
#Close the compare file
close(COMPFILE);
#Check for changes
if ($changes eq 0) {
if (!defined($opt_unatt)) {
print "There has been no changes since last archive.\nArch
+ive anyway? ";
#Check of no
if (stdin_question() =~ /n/i) {
$no_chg = 1;
}
} else {
$no_chg = 1;
}
}
#Return the diffrence
return @diffrence;
}
#---------------------------------------------------------------------
+-------------
# MAKE_DEST
#
# Checks for existance and Makes subdirectory archive structure.
#
#---------------------------------------------------------------------
+-------------
sub make_dest {
#Append YyyyyMmm to the path for year date
$ini{"archive_destination_ym"} = $ini{"archive_destination"} . "\\
+" . time2str("Y%YM%m", time) . "\\" ;
#Make base destination
if (!-e$ini{"archive_destination"}) {
#Make the base dir
mkdir($ini{"archive_destination"});
}
#Make year month dir
if (!-e$ini{"archive_destination_ym"}) {
#Make the base dir + Y2002M10 formatting
mkdir($ini{"archive_destination_ym"});
}
#Generates the zip name for the archive.txt
$zip_name = $ini{"archive_destination_ym"} . "\\" . time2str("D%dT
+%H%M", time);
}
#---------------------------------------------------------------------
+-------------
# MAKE_ARC_TXT
#
# Creates archive.txt and stores archive information in it.
# Gets comments and sys_comments if needed.
#
#---------------------------------------------------------------------
+-------------
sub make_arc_txt {
#Varables
my $flag = 0;
#Check for history file existance
if (!-e$ini{"archive_destination_ym"} . "\\history.txt") {
$flag = 1;
}
#Opens arcive.txt and writes archive informatin in t.
open(OUTFILE, ">" .$ini{"archive_source"} . "\\archive.txt") or di
+e "Can't write archive.txt! $!";
#Open history and write to it
open(HISTORY, ">>" .$ini{"archive_destination_ym"} . "\\history.tx
+t") or die "Can't write history.txt! $!";
#Write out archvive.txt header
print OUTFILE "Archive Date/Time :" . time2str("%m/%d/%Y %H
+:%M", time) . "\n";
print OUTFILE "Archve Source :" . $ini{"archive_source
+"} . "\n";
print OUTFILE "Archve Destination :" . $ini{"archive_destin
+ation"} . "\n";
print OUTFILE "Archve Destination w/YM :" . $ini{"archive_desti
+nation_ym"} . "\n";
print OUTFILE "Archve Zip Name :" . $zip_name . "\n";
#Print out history header
if ($flag) {
#Print history header if file doesn't exist
print HISTORY "History Start for " . time2str("Y%YM%m", time)
+. "\n";
}
#Write out the archive zip name
print HISTORY "Archve Zip Name :" . $zip_name . "\n";
#Prompts for comments if no_sys_comments is not in ini
if ($ini{"comments"} eq "on" and !defined($ini{"sys_comments"})) {
#Write out comments headers
print OUTFILE "Comments :\n";
print HISTORY "Comments :\n";
#Write out screen entry
print "Enter sys_comments please. Enter ctrl-z on a blank line
+ to end.\n";
#Get input until ctl-Z
foreach (<STDIN>) {
#Prit the lines to history and archive.txt
print OUTFILE $_;
print HISTORY $_;
}
}
#Writes out a predefined sys_comments
if (defined($ini{"sys_comments"})) {
print OUTFILE "sys_comments :\n";
print OUTFILE $ini{"sys_comments"} . "\n";
}
#Write out comparison
print "\nChecking files for diffrences.\n";
print OUTFILE "Files changes.\n";
#Print out history headers
if ($flag) {
#If new file do main header
print HISTORY "All files . :\n";
} else {
#If old file do addendum header
print HISTORY "Files that have changed. :\n";
}
#Loop through comparisons
foreach (@diffrence) {
#Get rid of cr/lf
chomp;
#Show the diffrences
print "$_ \n";
#Write diffrenceds to archive.txt
print OUTFILE "$_ \n";
#Only put changed file in history
if (!/No Change/ or $flag) {
#Write out history text
print HISTORY "$_ \n";
}
}
#Close the files
close(HISTORY);
close(OUTFILE);
}
#---------------------------------------------------------------------
+-------------
# RUN_ZIP
#
# Runs pkzip25 to make a zip file
# Recode this section for the compression style you want
#---------------------------------------------------------------------
+-------------
sub run_zip {
#Varables
my $zipdir = "c:\\windows\\"; #Set the location to pkzi
+p25
my $ProcessObj;
#Check for subdir switch
if (!defined($ini{"zip_options"})) {
#Default to none
$ini{"zip_options"} = "";
}
#Check for zip_wildcard if not defined make it *.*
if (!defined($ini{"zip_wildcard"})) {
#Default to none
$ini{"zip_wildcard"} = "*.*";
}
#Show zip command
print $zipdir . "pkzip25 -add " . $ini{"zip_options"} . ' "' . $zi
+p_name . '" "' . $ini{"archive_source"} . "\\" . $ini{"zip_wildcard
+"} . '"'. "\n" ;
#Start the process
Win32::Process::Create($ProcessObj,
$zipdir . "pkzip25.exe",
"pkzip25 -add " . $ini{"zip_options"} . ' "
+' . $zip_name . '" "' . $ini{"archive_source"} . "\\" . $ini{"zip_w
+ildcard"} . '"',
0,
CREATE_DEFAULT_ERROR_MODE,
".") || die "Zip didn't run!";
#Wait for process to complete
$ProcessObj->Wait(INFINITE);
}
#---------------------------------------------------------------------
+-------------
# HELP
#
# Prints out help insturctions
#
#---------------------------------------------------------------------
+-------------
sub help {
#Varables
my $input;
print "Working directory can be passed in to achive in the followi
+ng way\n";
print "archive c:\\t\\ \n Allways putt a slash on the end\n";
print "Recursion: Used to archives all subdirectories under the di
+rectory.\n";
print "Optional arguments force archive of all .\n";
print "Example below.\n\n";
print "archive -rec[=arcall=\n\n";
print "Also on above listed you can use -unatt to go into un atten
+ded mode\n\n";
print "Also on above listed you can use -log to write out to a log
+.\n";
print "You can specify the exact file, the directory, or or nothin
+g.\n";
print "If dont specify any thing it will put the logs in c:\yyyymm
+dd.log name.\n";
print "If you just supply the directory it will put a file in that
+ directory\n";
print "with the name yyyymmdd.log\n";
print "If you specify the exact file the information will be appen
+ded to it.\n";
print "Example's below.\n\n";
print "archive -log\t\t\tWrites out to c:\\yyyymmdd.log\n";
print "archive -log=c:\\log.txt\t\tWrites out to the exact file.\n
+";
print "archive -log=c:\\archive\t\tPuts a file in the directory yy
+yymmdd.log\n\n";
print "Make: Used to make achive.ini file for you.\n";
print "With no argument it makes an ini in the current directory.\
+n";
print "You can also specify the directory to make the file in.\n";
print "Or you can specify the exact file.\n";
print "Example below.\n\n";
print "archive -make\n";
print "Generate Make: Used to auto generate achive.ini\n";
print "Example below.\n\n";
print "archive -genmake\n";
}
#---------------------------------------------------------------------
+-------------
# GENMAKE_INI
#
# Writes out an archive.ini file based on %options from get_options
# This is where you add you own code for your setup.
# Right now the only options that I have coded for is arc_dir
# This points to the base directory to archive to. ex.
# arc_dir|h:\fgrass\
#
#---------------------------------------------------------------------
+-------------
sub genmake_ini {
#Varables
my $path = substr($dir,7); #Get everthign but c:\dev\
#Check to see if genmake is valid
if (!$dir =~ /c\:\\dev\\/) {
print "Not in c\:\\dev\\! Can't auto generate\n";
exit 0;
}
#Create the out file
open (OUTFILE, ">archive.ini") or die "Can't write archive.ini! $!
+";
print OUTFILE "make_ver|$make_ver\n";
print OUTFILE "archive_source|" . $dir . "\n";
print OUTFILE "archive_destination|" . $options{"arc_dir"} . $path
+ . "\n";
print OUTFILE "comments|on\n";
#Close the OUTFILE
close(OUTFILE);
print "make_ver|$make_ver\n";
print "archive_source|" . $dir . "\n";
print "archive_destination|" . $options{"arc_dir"} . $path . "\n";
print "comments|on\n";
print "Make auto generated successfully!!\n";
}
#---------------------------------------------------------------------
+-------------
# MAKE_INI
#
# Writes out an archive.ini file
#
#---------------------------------------------------------------------
+-------------
#
# INI file specification
#
# archive_source|c:\myprog #Specifies input Dire
+ctory.
# archive_destination|c:\archive\myprog #Specifys output dir
+ectory
# comments|on or off #Turns off promptin
+g for sys_commentss
# zip_options|0 #Specifies zip optio
+ns
# zip_wildcard|value #Specifies zip wild
+card
# sys_comments|text #System use only for
+ batch mode
#
#---------------------------------------------------------------------
+-------------
sub make_ini {
#Varables
my $ini_file;
my $ret_val;
my $skip;
#Set the ini file name up
$ini_file = $dir . "archive.ini";
#Remove trailing \
if ($ini_file =~ /\\$/) {
$ini_file = substr($ini_file,0,length($dir) - 1);
}
print "\nMakeing ini file " . $ini_file . "\n";
print "Answer the following questions.\n";
print "Do not end a directory name in \\\n";
print "Use lower case only\n\n";
#Create the out file
open (OUTFILE, ">" .$ini_file) or die "Can't write $ini_file! $!";
#Write out make version
print OUTFILE "make_ver|$make_ver\n";
#Arhive Source
$skip = 1;
if (defined($ini{archive_source})) {
print "Is $ini{archive_source} the archive source? ";
if (stdin_question() =~ /yes/) {
print OUTFILE "archive_source|" . $ini{archive_source} . "
+\n";
$skip = 0;
}
}
#Used for non default actions with an existing ini file
if ($skip) {
if ($ini_file !~ /\\/) {
print "Is $dir the archive source? ";
if (stdin_question() =~ /yes/) {
print OUTFILE "archive_source|" . $dir . "\n";
} else {
print "Enter archive source : ";
print OUTFILE "archive_source|" . <stdin>;
}
} else {
print "Enter archive source : ";
print OUTFILE "archive_destination|" . <stdin>;
}
}
#Archive Destination
$skip = 1;
if (defined($ini{archive_destination})) {
print "Is $ini{archive_destination} the archive destination? "
+;
if (stdin_question() =~ /yes/) {
print OUTFILE "archive_destination|" . $ini{archive_destin
+ation} . "\n";
$skip = 0;
}
}
#Used for non default actions with an existing ini file
if ($skip) {
print "Enter archive destination : ";
print OUTFILE "archive_destination|" . <stdin>;
}
#Archive Comments
$skip = 1;
if (defined($ini{comments})) {
print "Do you want leave comments $ini{comments}? ";
if (stdin_question() =~ /yes/) {
print OUTFILE "comments|" . $ini{comments} . "\n";
$skip = 0;
}
}
#Used for non default actions with an existing ini file
if ($skip) {
print "Comments On? ";
$ret_val = stdin_question("on,off","(on or off) :",1);
print OUTFILE "comments|$ret_val\n";
}
#Zip comments
$skip = 1;
if (defined($ini{zip_options})) {
print "Do you wish to leave zip options $ini{zip_options}? ";
if (stdin_question() =~ /yes/) {
print OUTFILE "zip_options|" . $ini{zip_options} . "\n";
$skip = 0;
}
}
#Used for non default actions with an existing ini file
if ($skip) {
print "Do you wish to supply Zip options? ";
if (stdin_question() =~ /yes/) {
print "Do you wish to zip subdirectories or manually enter
+ options? ";
$ret_val = stdin_question("subdir,manual,none","(subdir, m
+anual, none) :");
#Subirectories on
if ($ret_val =~ /subdir/) {
print OUTFILE "zip_options|-rec -path\n";
}
#Manual optoins
if ($ret_val =~ /manual/) {
print OUTFILE "zip_options|" . <stdin>;
}
}
}
#Archive Zip Wildcard.
$skip = 1;
if (defined($ini{zip_wildcard})) {
print "Do you wish to leave zip wildcard $ini{zip_wildcard}? "
+;
if (stdin_question() =~ /yes/) {
print OUTFILE "zip_wildcard|" . $ini{zip_wildcard} . "\n";
$skip = 0;
}
}
#Used for non default actions with an existing ini file
if ($skip) {
print "If answer is no wild cards will be *.*\n";
print "Do you wish to specify the wild card for zip? ";
if (stdin_question() =~ /yes/) {
print "Specify wild cards seperated by space: ";
print OUTFILE "zip_wildcard|" . <stdin>;
}
}
#Close the OUTFILE
close(OUTFILE);
}
#---------------------------------------------------------------------
+-------------
# STDIN_QUESTION
#
# If no arguments assume yes and no answers. returns a y or n
#
# $options Holds the list of valid options.
# $text Hold the text to be displayed.
# $full_match Tests for full mathc
#
#---------------------------------------------------------------------
+-------------
sub stdin_question {
#Get arguments
my ($options,$text,$match) = @_; #Get passed in var
#Varables
my $input;
my $flag = 0;
my @valid_options;
#Check for defintion of options
if (!defined($options)) {
$options = "yes,no";
}
#Check for defintion of text
if (!defined($text)) {
$text = "(yes or no) :";
}
#Check for defination of match
if (!defined($match)) {
$match = 0;
}
#Put options in an arry
@valid_options = split/,/, $options;
#While no match loop
while ($flag ne 1) {
#Print out std text
print $text;
#Read and chomp stdin
$input = <stdin>;
chomp $input;
#Loop through arry for match
foreach (@valid_options) {
#Test forback match
if (/$input/i) {
#Test for full match to compare on length
if ($match eq 1) {
if (length($_) eq length($input)) {
$flag = 1;
}
} else {
$flag = 1;
}
}
}
}
#Return answer
return lc $input;
}
|
