#---------------------------------------------------------------------
+-------------
#    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;
}
[download]