#!c:\gus_perl\gus_flextest_backup.pl # Version date: 2005-04-12 # See POD at EOF for full description. # 121 lines of code & 26 comment lines. print "\n" x 1; use strict; use warnings; use File::Copy; use File::Path; use Sys::Hostname; ###################### # Begin user options # ###################### # Destination network directory for backup files. # A new, dated subdir will be written there each run. my $backup_path = 'S:/Proposed/RDLab/Validation Lab/Internal VL/flextest_config_and_calibration_backups'; #################### # End user options # #################### my $days_interval = 1 / 24; my $hostname = hostname(); my $backup_subdir = $hostname . '_' . update_DTG(); $backup_subdir =~ s/ /_/g; my $out_path = "$backup_path/$backup_subdir"; my $backup_cnt = 0; my $date_marker_path = 'C:\date_interval.txt'; # Read date marker file for epoch seconds. If interval # has passed, flag high and reset file. sub get_time_interval { my ($file_path, $days_interval) = @_; my $secs_interval = 60 * 60 * 24 * $days_interval; if ( open DATE, "<$file_path" ) { my @lines = ; if ( time - $lines[-1] > $secs_interval ) { new_time_interval($file_path); return 1; } else { return 0 } } else { return 1 } } # Used inside of &get_time_interval to reset date marker file. sub new_time_interval { my ($file_path) = @_; if ( open DATE, ">$file_path" ) { print DATE "# I am a time marker in epoch seconds for backup scheduling. \n"; print DATE time; } else { print "Oops! Could not write to file '$file_path': $!"} } # Return Date Time Group in ISO 8601 approved fashion. # Example: my $DGT = update_DTG 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"); } # Backup files inside an MTS directory. sub backup_files { my ( $in_path, $out_path, $extn ) = @_; if ( opendir IN, $in_path ) { my @files = grep { /.*\.$extn$/ } readdir(IN); closedir IN; foreach my $file ( @files ) { if ( copy "$in_path/$file", "$out_path/$file" ) { print "Copied to backup: $file \n"; ++$backup_cnt; } else { print "\tOops! Copy failed to $out_path \n"; } } } else { print "Oops! Could not open '$in_path'\n" unless $in_path =~ /rchive/ } } # Backup an MTS directory if it exists. sub backup_mts { my ($mts_dir) = @_; if ( opendir MTS, $mts_dir ) { closedir MTS; if ( opendir OUT, $out_path ) { closedir OUT; print "Backing up MTS files to '$out_path'.\n"; if ( $mts_dir =~ /Ts2/i ) { # When run from the Tri-Ax backup_files("$mts_dir", $out_path, 'cal'); backup_files("$mts_dir/config", $out_path, 'tcc'); } else { # When run from other MTS machines. backup_files("$mts_dir/calib", $out_path, 'scf'); backup_files("$mts_dir/config", $out_path, 'cfg'); backup_files("$mts_dir/config/Archive", $out_path, 'cfg'); backup_files("$mts_dir/config/archive", $out_path, 'cfg'); } } else { print "Could not open '$out_path': $! \n"; } } } sub perform_backup { if ( opendir BACKUP, $backup_path ) { # Limit number of backups to three.# Limit number of backups to three. my @backup_dirs = grep {/^$hostname/} readdir(BACKUP); closedir BACKUP; while (3 < scalar @backup_dirs) { my $file_path = "$backup_path/" . shift @backup_dirs; rmtree $file_path; } if ( mkdir $out_path ) { # Whichever kind of system this is, back up config & calib backup_mts('C:/ftiim'); backup_mts('C:/ftgt'); backup_mts('C:/ftiis'); backup_mts('C:/tsiis'); # MTS A & B backup_mts('C:/Ts2'); # The Triax } else { print "Oops! Could not create directory '$out_path': $! \n"; } sleep 15; } else { print "Oops! Could not find '$backup_path': $! \n"; } } if ( get_time_interval( $date_marker_path, $days_interval ) ) { perform_backup(); print "Files backed up = $backup_cnt. \n"; } else { print "Interval of $days_interval has not yet passed since last backup.\n" } __END__ =head1 NAME Backup utility for use with MTS FlexTest machines =head1 VERSION Release date = 2005-04-12 =head1 SYNOPSIS perl B> =head1 DESCRIPTION A backup utility for MTS FlexTest servocontrollers used in fatigue and durability testing. Run either as standalone or trigger remotely via the B> method of the XML-RPC server/client pair B> and B> by same author. Copies from the MTS FlexTest B> and B> directories to a designated network drive. =head1 AUTHOR Gan Uesli Starling > =head1 COPYRIGHT Copyright (c) 2005, 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 Networking =cut