#!c:\Perl\bin\perl.exe

# Auto-maintain a constantly-fresh FTP mirror of N files from a GUI list.
# See POD at EOF for full description.

use Tk;
use File::Copy;
use Net::FTP;
use strict;
use warnings;
require Tk::pane;

use vars qw(
  $mw
  $mw
  %file_frames
  %frame_label_entry
  $intranet_path
  $ftp_host
  $ftp_server_path
  $ftp_user
  $ftp_password
  $log_file_name
  $header
  $minutes
  $label_width $entry_width $button_width
  $txt_file_basename $ftp_file_basename
  $ftp_not_copy_flag
  @ftp_file_list );

######################
# Begin stuff the user ought to configure
######################

# Dual-use path: 1) For outgoing copy and log file; 2) or
# temporary file-copy prior to outgoing FTP upload.
$intranet_path = 'K:/Outgoing/bedplates/';

# Internet URL for outgoing FTP upload.
$ftp_host        = "192.168.0.1";
$ftp_user        = "foo";
$ftp_password    = 'bar';
$ftp_server_path = '/foo/bar/';

# So remote user can tell if this script died via FTP.
$log_file_name = 'gus_ftp_mirror_log.txt';

# What to write to this script's own log file. Also the Tk title.
$header = 'Track Ongoing Tests Via FTP';

# The interval at which to check files. Fifteen minutes should do.
$minutes = 15;

# Whether to upload by FTP rather than just copy files.
$ftp_not_copy_flag = 0;

# Defaults to fill the entry widgets when built.
$txt_file_basename = 'specimen.log';
$ftp_file_basename = '_log.txt';

# Just to avoid 'uninitialized' warning from other package.
$configure_defaults::txt_file_basename_old = $txt_file_basename;
$configure_defaults::ftp_file_basename_old = $ftp_file_basename;

# List of supported file patterns
my @filetypes = (
  [ 'Log files',  '.log', 'TEXT' ], [ 'Data files', '.dat', 'TEXT' ],
  [ 'Text files', '.txt', 'TEXT' ]
);

######################
# End stuff the user ought to configure
######################

my $check_flag = 0;
my $feedback   =
  'Hints: 1) Browse files to track; 2) Name twin copy on the FTP server; 3) Click a button.';

######################
# Begin GUI stuff
######################

$label_width  = 12;
$entry_width  = 32;
$button_width = 45;    # Keeps pane from shrinking in X axis.

# First declare the main GUI frame and all her daughters.

$mw = MainWindow->new( -title => $header );

# Begin MENU BAR
$mw->configure( -menu => my $menubar = $mw->Menu );

# Begin MENU CONFIG
my $menu_config = $menubar->cascade( -label => '~Config' );
$menu_config->command(
  -label   => "Configure defaults",
  -command => sub { configure_defaults::start_MainLoop() }
);

# Begin MENU HELP
my $menu_help = $menubar->cascade( -label => '~Help' );
$menu_help->command(
  -label   => "About",
  -command => sub { menu_help_about::start_MainLoop() }
);

# Start out with a frame for selecting the number of specimens (MTS stations)
# which are to be monitored.

my $frame_setup_1 = $mw->Frame(
  -relief      => 'sunken',
  -borderwidth => 5 )->pack(
  -side        => 'top',
  -expand      => 1,
  -fill        => 'x'
);
$frame_setup_1->Label(
  -width => $label_width,
  -text  => " Header string: " )->pack( -side => 'left' );
$frame_setup_1->Scrolled(
  'Entry', -textvariable => \$header,
  -width      => $entry_width,
  -background => "white",
  -foreground => 'blue',
  -relief     => 'sunken',
  -font       => 'courier' )->pack(
  -side       => 'left',
  -expand     => 1,
  -fill       => 'x'
);

my $frame_setup_2 = $mw->Frame(
  -relief      => 'sunken',
  -borderwidth => 5 )->pack(
  -side        => 'top',
  -expand      => 1,
  -fill        => 'x'
);
$frame_setup_2->Label(
  -width => $label_width,
  -text  => " File qty: " )->pack( -side => 'left' );
my $setup_scale = $frame_setup_2->Scale(
  -from   => 1,
  -to     => 12,
  -orient => 'horizontal' )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);

my $frame_setup_3 = $mw->Frame(
  -relief      => 'sunken',
  -borderwidth => 5 )->pack(
  -side        => 'top',
  -expand      => 1,
  -fill        => 'x'
);
$frame_setup_3->Button(
  -text             => ' Continue ',
  -command          => \&pack_frame_pane,
  -background       => 'gray',
  -activebackground => 'blue',
  -relief           => 'raised',
  )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);
$frame_setup_3->Button(
  -text             => ' Quit ',
  -command          => \&quit_MainLoop,
  -background       => 'gray',
  -activebackground => 'green',
  -relief           => 'raised',
  )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);

# Have a separate, main frame for after the setup frame.

my $frame_files = $mw->Frame(
  -relief      => 'sunken',
  -borderwidth => 5
);

my $frame_pane = $frame_files->Scrolled(
  'Pane', -scrollbars => 'w',
  -sticky => 'new' )->pack(
  -side   => 'top',
  -expand => 1,
  -fill   => 'both'
);

# Non-expanding frame for buttons and feedback below expanding files pane.
my $frame_btm = $mw->Frame(
  -relief      => 'flat',
  -borderwidth => 5
);

my $frame_fdbk = $frame_btm->Frame(
  -relief      => 'flat',
  -borderwidth => 5 )->pack(
  -side        => 'bottom',
  -expand      => 1,
  -fill        => 'x'
);
$frame_fdbk->Label(
  -width => $label_width,
  -text  => 'Feedback:' )->pack( -side => 'left' );
$frame_fdbk->Scrolled(
  'Entry', -textvariable => \$feedback,
  -width      => $entry_width,
  -background => "white",
  -foreground => 'blue',
  -relief     => 'sunken',
  -font       => 'courier' )->pack(
  -side       => 'left',
  -expand     => 1,
  -fill       => 'x'
);

my $frame_btns = $frame_btm->Frame(
  -relief      => 'flat',
  -borderwidth => 5 )->pack(
  -side        => 'bottom',
  -expand      => 1,
  -fill        => 'x'
);
$frame_btns->Label(
  -width => $label_width,
  -text  => "Action:" )->pack( -side => 'left' );
$frame_btns->Button(
  -width            => $button_width,
  -text             => ' Start Checking ',
  -command          => \&begin_checking,
  -background       => 'gray',
  -activebackground => 'red',
  -relief           => 'raised',
  )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);
$frame_btns->Button(
  -width            => $button_width,
  -text             => ' Pause ',
  -command          => \&pause_checking,
  -background       => 'gray',
  -activebackground => 'blue',
  -relief           => 'raised',
  )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);
$frame_btns->Button(
  -width            => $button_width,
  -text             => ' Quit ',
  -command          => \&quit_MainLoop,
  -background       => 'gray',
  -activebackground => 'green',
  -relief           => 'raised',
  )->pack(
  -side   => 'left',
  -expand => 1,
  -fill   => 'x'
);

my $path_widget_count = 0;    # For unique widget names, use int and inc.

sub add_path_widget {
    $path_widget_count++;
    my $this_widget_id = $path_widget_count;    # Avoid later interpolation.
    $file_frames{"txt_file_$this_widget_id"}        = $txt_file_basename;
    $file_frames{"txt_file_status_$this_widget_id"} = 'foobar';
    $file_frames{"ftp_file_$this_widget_id"}        = $ftp_file_basename;

    # Create a new frame for each file to monitor.
    $file_frames{"frame_$this_widget_id"} = $frame_pane->Frame(
      -relief      => 'flat',
      -borderwidth => 5 )->pack(
      -side        => 'top',
      -expand      => 1,
      -fill        => 'x'
    );
    $file_frames{"frame_$this_widget_id"}->Label(
      -width => $label_width,
      -text  => "Sorce file $this_widget_id:" )->pack( -side => 'left' );

    # The file to monitor is entered here.
    $file_frames{"frame_$this_widget_id"}->Scrolled(
      'Entry',
      -textvariable => \$file_frames{"txt_file_$this_widget_id"},
      -width        => $entry_width,
      -background   => "white",
      -foreground   => 'blue',
      -relief       => 'sunken',
      -font         => 'courier' )->pack(
      -side         => 'left',
      -expand       => 1,
      -fill         => 'x'
    );

    # Button to browse for entry widget above.
    $file_frames{"frame_$this_widget_id"}->Button(
      -text    => ' Browse ',
      -command => sub {
          $file_frames{ 'txt_file_' . $this_widget_id } =
          $mw->getOpenFile( -filetypes => \@filetypes );
      },
      -background       => 'gray',
      -activebackground => 'red',
      -relief           => 'raised',
      )->pack( -side    => 'left',
      -expand           => 1,
      -fill             => 'x'
    );

    $file_frames{"frame_$this_widget_id"}->Label(
      -width => $label_width,
      -text  => "FTP twin $this_widget_id:" )->pack( -side => 'left' );

    # The file to monitor likely has a default name in a unique directory.
    # Enter here how to name that file meaningfully in the FTP directory.
    # Example 1: 'specimen.log' might be 'bedplate_9_log.txt'
    # Example 2: 'specimen.dat' might be 'bedplate_9_dat.txt'
    $file_frames{"frame_$this_widget_id"}->Scrolled(
      'Entry',
      -textvariable => \$file_frames{"ftp_file_$this_widget_id"},
      -width        => $entry_width,
      -background   => "white",
      -foreground   => 'blue',
      -relief       => 'sunken',
      -font         => 'courier' )->pack(
      -side         => 'left',
      -expand       => 1,
      -fill         => 'x'
    );

    # Button to browse for entry widget above.
    $file_frames{"frame_$this_widget_id"}->Button(
      -text    => ' Same ',
      -command => sub {
          $file_frames{"ftp_file_$this_widget_id"} = $file_frames{"txt_file_$this_widget_id"};
          $file_frames{"ftp_file_$this_widget_id"} =~ s/^.*[\\|\/]//;
      },
      -background       => 'gray',
      -activebackground => 'red',
      -relief           => 'raised',
      )->pack( -side    => 'left',
      -expand           => 1,
      -fill             => 'x'
    );
}

sub delete_path_widget {
    if ( $path_widget_count > 1 ) {
        $file_frames{"frame_$path_widget_count"}->destroy()
          if Tk::Exists( $file_frames{"frame_$path_widget_count"} );
        foreach my $key( 'frame_', 'ftp_file_', 'txt_file_', 'txt_file_status_',, ) {
            delete( $file_frames{ $key . $path_widget_count } );
        }
        $path_widget_count--;
        $feedback = "Row $path_widget_count has been removed.";
    }
    else { $feedback = "Oops! Can't remove only remaining row."; }

}

sub create_path_widgets {
    for ( my $i = 1 ; $i <= $setup_scale->get() ; $i++ ) {

        # Each file to be tracked has a path on the PC running MPT,
        # its mod date there, and an alias-name on the FTP server.
        add_path_widget();
    }
}

# After the setup frame, pack the main frame.
sub pack_frame_pane {
    $mw->title(" $header");    # In case two instances are running.
    $frame_setup_1->packForget();
    $frame_setup_2->packForget();
    $frame_setup_3->packForget();
    create_path_widgets();     # Separate frame for each pair of files.
    $menu_config->command(
      -label   => "Add bottom row",
      -command => sub { add_path_widget() unless $check_flag }
    );
    $menu_config->command(
      -label   => "Remove bottom row",
      -command => sub { delete_path_widget() unless $check_flag }
    );

    repack_frame_pane();    # To avoid duplication. Is called two places.

    # Does not expand so as to avoid fat gray border when dragging main window.
    $frame_btm->pack( -side => 'bottom' );
}

sub repack_frame_pane {

    # Expands so file rows can scroll more than two high.
    $frame_files->pack(
      -side   => 'top',
      -expand => 1,
      -fill   => 'both'
    );
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    menu_help_about::quit_MainLoop();
    configure_defaults::quit_MainLoop();
    $mw->destroy() if Tk::Exists($mw);
}

sub begin_checking {
    $feedback = "Begin checking every $minutes minutes as of " . update_DTG();

    # Proceed only if local/intranet directory is valid. Else complain.
    if ( opendir LOG_DIR, "$intranet_path" ) {
        closedir LOG_DIR;
        $frame_files->packForget();    # So user can't change while running.
        $check_flag = 1;
    }
    else {
        $feedback   = "Oops! Configuration for intranet path '$intranet_path' is invalid.";
        $check_flag = 0;
    }
}

sub pause_checking {
    $feedback   = "Checking paused since " . update_DTG();
    $check_flag = 0;
    repack_frame_pane();
}

sub keep_watch { check_status() if $check_flag }

$mw->repeat( 1000 * 60 * $minutes, \&keep_watch );

MainLoop;

######################
# End GUI stuff
######################

# Pop up a dialog box for the user to select a file to open
sub browse_file_dialog {
    my $filename = $mw->getOpenFile( -filetypes => \@filetypes );
    if ( defined $filename and $filename ne '' ) {
        addPage($filename);
    }
}

# Upload a list of files via FTP.
sub put_ftp_files {
    my ( $ftp_file_list_ref, ) = @_;
    if ( my $ftp = Net::FTP->new($ftp_host) ) {
        print "Logging in to '$ftp_host' as user '$ftp_user'.\n";
        $ftp->login( $ftp_user, $ftp_password ) or die "\tOops! Could not login";
        $ftp->pasv();
        print "Changing directory to '$ftp_server_path'\n";
        $ftp->cwd($ftp_server_path) or print "\tOops! Could not cwd $ftp_server_path";
        $ftp->binary;    # Because Perl is like Unix and will strip CRLF.

        foreach my $file(@$ftp_file_list_ref) {
            print "Uploading file: $file.\n";
            $ftp->put($file) or print "\tOops! Could not put $file via FTP\n";
            print "Deleting local copy of file: $file.\n";
            unlink($file);    # Once uploaded, toss local copy.
        }
        $ftp->close();
    }
    else { print "\tOops! Could not connect.\n"; }
}

sub check_status {

    # So local user can tell if this script has hung or not.
    $feedback = "Last checked files on " . update_DTG();

    # So remote FTP client user can tell if this script has been killed.
    my $log_file_path = $intranet_path . $log_file_name;
    open LOG_FILE, ">>$log_file_path";
    print LOG_FILE "$header -- $feedback \n";

    for ( my $i = 1 ; $i <= $path_widget_count ; $i++ ) {

        # Test for inappropriate file name entries. Skip row if so.
        if ( ( $file_frames{"txt_file_$i"} !~ m/[A-Z|a-z|0-|_]/ )
          || ( $file_frames{"ftp_file_$i"} !~ m/[A-Z|a-z|0-9|_]/ )
          || ( $file_frames{"txt_file_$i"} =~ m/[\*|\?|!]/ )
          || ( $file_frames{"ftp_file_$i"} =~ m/[\*|\?|!]/ ) )
        {
            print LOG_FILE "Skipping row $i due to blank or invalid entry on ", update_DTG(), ".\n";
            $feedback = "Oops! Row $i contains a blank or invalid entry.";
            next;
        }

        # Test for non-absolute or hidden path entries.
        if ( ( $file_frames{"txt_file_$i"} =~ m/^\./ )
          || ( $file_frames{"ftp_file_$i"} =~ m/^\./ ) )
        {
            print LOG_FILE "Skipping row $i due to relative path entry on ", update_DTG(), ".\n";
            $feedback = "Oops! Row $i contains a relative path entry.";
            next;
        }

        # Finally, check if file really exists.
        if ( open THIS_FILE, '<' . $file_frames{"txt_file_$i"} ) {
            close THIS_FILE;
        }
        else {
            print LOG_FILE "Skipping row $i because file '", $file_frames{"txt_file_$i"},
              "' would not open on ", update_DTG(), ".\n";
            $feedback =
              "Oops! File '" . $file_frames{"txt_file_$i"} . "' from row $i would not open and may not exist.";
            next;
        }

        # Get status of MTS file being monitored.
        my @file_status = stat( $file_frames{"txt_file_$i"} );
        if ( $file_status[7] ne $file_frames{"txt_file_status_$i"} ) {
            my $outgoing_file = $intranet_path . $file_frames{"ftp_file_$i"};

            # Even if uploading via FTP, still write the outgoing file to local filesystem
            # so that all may be sent by FTP as a list. Not FTP'd one-at-a time as when
            # writing to a directory.
            print LOG_FILE "\n\tCopying file ", $file_frames{"txt_file_$i"}, " to $outgoing_file.";
            copy( $file_frames{"txt_file_$i"}, $intranet_path . $file_frames{"ftp_file_$i"} )
              or print LOG_FILE "\nOops! Could not copy ", $file_frames{"txt_file_$i"}, ".";
            push ( @ftp_file_list, "$outgoing_file" );   # Keep list for possible FTP ex-post-facto.
        }
        $file_frames{"txt_file_status_$i"} = $file_status[7];
    }

    # If user is not behind own firewall with direct file-system path to outgoing FTP directory,
    # upload instead via FTP from this script. But don't want to do for single files, as above. So
    # instead send them up in a bunch.
    if ( ( $#ftp_file_list > -1 ) && ($ftp_not_copy_flag) ) {
        put_ftp_files( \@ftp_file_list );    # Upload the files.
    }
    @ftp_file_list = ();    # Tidy up after.
    close LOG_FILE;
}

# Return Date Time Group in ISO 8601 approved fashion.
sub update_DTG {
    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    my $DTG =
      sprintf( "%04d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec );
    return ("$DTG");
}

#####################
# Begin Menu Help About Package
#####################

# This is a separate package for convenient use as a template.

package menu_help_about;
BEGIN {}

use Tk;
use strict;
no strict "refs";

# Declare variables for strict.
use vars qw( $mw_about );

sub start_MainLoop {
    $mw_about = MainWindow->new( -title => 'About' );
    my $text =
      $mw_about->Label( -text => "FTP Mirror" . "\nRelease 2004-02-15\n"
      . "\nCopyright 2004, Gan Uesli Starling" . "\n" . "\nTrailing Edge Technologies"
      . "\nhttp://starling.us/tet" . "\nemail gan\@starling.us" . "\n" )->pack();
    my $bn_okay = $mw_about->Button(
      -width            => 8,
      -relief           => 'raised',
      -foreground       => 'blue',
      -activebackground => 'green',
      -command          => \&quit_MainLoop,
      -text             => 'Okay' )->pack( -side => 'top' );
    MainLoop;
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {
    $mw_about->destroy() if Tk::Exists($mw_about);
}

END {}

#####################
# End Menu Help About Package
#####################

#####################
# Begin Configure Defaults Package
#####################

# This is a separate package for convenience.

package configure_defaults;
BEGIN {}

use Tk;
use strict;
use warnings;

# Declare variables for strict.
use vars qw(
  $mw_configure_defaults
  %frame_label_entry
  %frame_label_radio
  $txt_file_basename_old
  $ftp_file_basename_old
  @upload_methods );

# Automate the build of a lable & entry wiget set inside a frame.
sub mk_frame_label_entry {
    my ( $foo, $parent_frame, $label_text, $text_var_ref ) = @_;

    $frame_label_entry{"frame_$foo"} = $parent_frame->Frame(
      -relief      => 'flat',
      -borderwidth => 5 )->pack(
      -side        => 'top',
      -expand      => 1,
      -fill        => 'x'
    );
    $frame_label_entry{"label_$foo"} = $frame_label_entry{"frame_$foo"}->Label(
      -width => $main::label_width,
      -text  => " $label_text " )->pack( -side => 'left' );
    $frame_label_entry{"entry_$foo"} = $frame_label_entry{"frame_$foo"}->Scrolled(
      'Entry', -textvariable => $text_var_ref,
      -width      => $main::entry_width,
      -background => "white",
      -foreground => 'blue',
      -relief     => 'sunken',
      -font       => 'courier' )->pack(
      -side       => 'left',
      -expand     => 1,
      -fill       => 'x'
    );
}

# Automate the build of a lable & radiobutton wiget set inside a frame.
sub mk_frame_label_radio {
    my ( $foo, $parent_frame, $label_text, $text_array_ref, $cmd_ref ) = @_;

    $frame_label_radio{"frame_$foo"} = $parent_frame->Frame(
      -relief      => 'flat',
      -borderwidth => 5 )->pack(
      -side        => 'top',
      -expand      => 1,
      -fill        => 'x'
    );
    $frame_label_radio{"label_$foo"} = $frame_label_radio{"frame_$foo"}->Label(
      -width => $main::label_width,
      -text  => " $label_text " )->pack( -side => 'left' );

    # Make N radio buttons.
    foreach my $text(@$text_array_ref) {
        $frame_label_radio{"radio_$text"} = $frame_label_radio{"frame_$foo"}->Radiobutton(
          -text     => $text,
          -value    => $text,
          -variable => \$frame_label_radio{'selection'},
          -command  => $cmd_ref )->pack(
          -side     => 'left',
          -expand   => 1,
          -fill     => 'x'
        );
    }    # End of foreach.
}

# Set the radiobutton to match current method.
sub get_current_upload_method {
    if ($main::ftp_not_copy_flag) {
        $frame_label_radio{"radio_$upload_methods[1]"}->select();
    }
    else { $frame_label_radio{"radio_$upload_methods[0]"}->select(); }
}

# Change the upload method to agree with changed radiobutton.
sub set_new_upload_method {
    if ( $frame_label_radio{'selection'} eq $upload_methods[0] ) {
        $main::ftp_not_copy_flag = 0;
    }
    else { $main::ftp_not_copy_flag = 1 }

    # Adjust FTP-related widgets to active or not.
    set_ftp_entry_state( 'host', 'ftp_path', 'user', 'pw' );
}

# Adjust FTP-related widgets to active or not depending on current upload mode.
sub set_ftp_entry_state {
    foreach my $key(@_) {
        if ($main::ftp_not_copy_flag) {
            $frame_label_entry{"entry_$key"}->configure(
              -state      => 'normal',
              -background => 'white'
            );
        }
        else {
            $frame_label_entry{"entry_$key"}->configure(
              -state      => 'disabled',
              -background => 'gray'
            );
        }
    }
}

sub start_MainLoop {
    print "\n\n\n";    # Debugging aid for use with T-Pad.
    $txt_file_basename_old = $main::txt_file_basename;    # To know if changed.
    $ftp_file_basename_old = $main::ftp_file_basename;    # To know if changed.
    @upload_methods        =
      ( 'Copy to FTP directory', 'Upload via FTP' );      # Using array allows rest to auto-track.

    $mw_configure_defaults = MainWindow->new( -title => ' Configure Defaults' );

    # Make a framed lable/entry for each default that user may configure.
    mk_frame_label_entry( 'host', $mw_configure_defaults, 'FTP host:', \$main::ftp_host );
    mk_frame_label_entry( 'ftp_path', $mw_configure_defaults, 'FTP path:',
      \$main::ftp_server_path );
    mk_frame_label_entry( 'user', $mw_configure_defaults, 'FTP user:', \$main::ftp_user );
    mk_frame_label_entry( 'pw', $mw_configure_defaults, 'Password:', \$main::ftp_password );
    $frame_label_entry{'entry_pw'}->configure( -show => '*' );    # Obfuscate the FTP password.

    mk_frame_label_radio( 'txt_or_ftp', $mw_configure_defaults, 'Upload via:', \@upload_methods,
      \&set_new_upload_method );
    get_current_upload_method();    # Set radiobutton to be current on opening.

    mk_frame_label_entry( 'local_path', $mw_configure_defaults, 'Intranet path:',
      \$main::intranet_path );
    mk_frame_label_entry( 'log',    $mw_configure_defaults, 'Log name:', \$main::log_file_name );
    mk_frame_label_entry( 'header', $mw_configure_defaults, 'Header:',   \$main::header );
    mk_frame_label_entry( 'mins',   $mw_configure_defaults, 'Minutes:',  \$main::minutes );
    mk_frame_label_entry( 'txt', $mw_configure_defaults, 'TXT filename:',
      \$main::txt_file_basename );
    mk_frame_label_entry( 'ftp', $mw_configure_defaults, 'FTP filename:',
      \$main::ftp_file_basename );

    $mw_configure_defaults->Button(
      -width            => 8,
      -relief           => 'raised',
      -foreground       => 'blue',
      -activebackground => 'green',
      -command          => \&quit_MainLoop,
      -text             => 'Okay' )->pack( -side => 'top' );
    MainLoop;

    # Adjust FTP-related widgets to active or not.
    set_ftp_entry_state( 'host', 'ftp_path', 'user', 'pw' );
}

# Close down the Perl/Tk GUI
sub quit_MainLoop {

    # Apply config changes to main package.
    my $i = 1;
    while ( defined $main::file_frames{"txt_file_$i"} ) {

        # Update file base name in widget.
        $main::file_frames{"txt_file_$i"} =~ s/\Q$txt_file_basename_old\E/$main::txt_file_basename/;

        # Update file base name in widget.
        $main::file_frames{"ftp_file_$i"} =~ s/\Q$ftp_file_basename_old\E/$main::ftp_file_basename/;
        $i++;
    }
    $main::mw->configure( -title => $main::header );
    $mw_configure_defaults->destroy() if Tk::Exists($mw_configure_defaults);
}

END {}

#####################
# End Configure Defaults Package
#####################

__END__

=head1 NAME

Auto-refreshing FTP-mirror utility.

=head1 SYNOPSIS

perl gus_ftp_mirror.pl

=head1 GENERAL PURPOSE

Auto-maintain a constantly-fresh FTP mirror of one or more files from a list.

=head1 SPECIFIC PURPOSE

Fatigue and durability testing is peformed by computer-controlled servohydraulic test stands that run 24/7. Often they run unobserved during 3rd shift and on weekends. The author needed to obtain their status remotely. Corporate IT policy restricted the firewall such that only FTP and SMTP availed for the purpose. I have scripts for both of these. This is the one for FTP. It works by maintaining an ever-fresh mirror of each test rig's status and log files on the corporate FTP server.


=head1 HOW TO USE

=item Step Zero

Configure this script with your own defaults, the ones which you want to be true nearly all of the time. Find this near the top between the lines clearly labled: B<Begin/End stuff the user ought to configure>.

=item Step One

Run this script on whatever PC has the files you want to mirror.

=item Step Two

The start-up window allows you to session-configure two things right away: B<(1)> The header which you may want to be different if two or more instances of this script run on the same PC; B<(2)> The minimum number of files that you expect to mirror. Then continue.

=item Step Two

The start-up window will close and a new one will open with one or more rows (however many you chose at startup). At left on each row, type or browse to the file which you want mirrored. At right on each row, type a name for the mirrored file (or click B<Same>).

=item Step Three (optional)

If you need more rows, pull down the B<Configure> menu and select B<New bottom row>. If you want to depart from the built-in configs, from that same menue click B<Configure defaults>.

=item Step Four

Click at will the appropriate button to start or pause the mirroring process. Every N minutes the script will check on files in the left hand column. If any have changed, those will be mirrored to the FTP server under its alias-name from the right hand column. The reason for this aliasing is that on the source PC default named files are segregated in different paths, whereas on the FTP server they must share the same default path.

=head1 PREREQUISITES

=item Win32 OS

This script runs on Win32 [replace my use of Active State's openFileDialog() to fix that].

=item MultiPuprose TestWare software by MTS.

Not really requisite. It's just that I mostly configured defaults for use with that. You can undo them quite easily.

=head1 SEE ALSO

Perl script C<gus_mpt_ftp_get.pl> for use in concert to download files. Perl script C<gus_mpt_ftp_put.pl> for use in concert or as an alternative.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>

=head1 COPYRIGHT

Copyright (c) 2004, Gan Uesli Starling. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 SCRIPT CATEGORIES

Misc

=cut