#!/usr/bin/perl
#
# Replacement for Windows "briefcase"
# Will sync files one way from sync directory
# to "briefcase" directory (hardcoded below)
#
use strict;
use warnings;
use File::Find;
use File::Copy;
use Tk;
use Win32::API;
use Win32::WinError qw( ERROR_NO_MORE_FILES );
# Make sure we see console output
$|=1;
# Get Win32 directory listing functions
my ($find_first_file, $find_nxt_file, $find_close) = import_win32();
# Global variables for "briefcase" and
# the directory to sync it to
# ( TODO: make these into data fields and save as defaults later )
my $brief_dir = "C:\\Briefcase";
my $sync_dir = "O:";
# Make this big enough for directory names
my $chk_wid = 40;
my $mw = MainWindow->new;
$mw->title("Sync Briefcase");
my $frame = $mw->Frame;
$frame
->Label( -text=>"Sync from $sync_dir to $brief_dir" )->pack;
# Get list of subdirectories
my @dirs = get_dirs( $brief_dir );
# Keep track of which subdirectories are selected
my %sync;
# Just view needed changes or actually copy
$frame->Checkbutton(
-text=>"Do the copying",
-variable=>\my $do_copy,
)->pack;
# Default to checked
$do_copy = 1;
# Create a checkbox for every directory
my $all_dirs = 1;
for my $dir (@dirs) {
$frame->Checkbutton(
-anchor=>"w",
-text=>$dir,
-width=>$chk_wid,
-variable=>\$sync{$dir},
-command => sub { $all_dirs = 0 if $sync{$dir} },
)->pack;
}
# One checkbox to select all directories
$frame->Checkbutton(
-anchor=>"w",
-text=>"All directories",
-width=>$chk_wid,
-variable=>\$all_dirs,
)->pack;
$frame
->Button( -text=>"Sync",-command=>\&sync_dirs )
->pack;
# For status messages
my $msg = $frame
->Message( -width => '80c', -textvariable => \my $message )->pack;
$frame->pack;
MainLoop;
# Get list of directories in a directory
sub get_dirs {
my $dir = shift;
chdir $dir or die "Dir $dir: $!";
return grep -d, glob("*");
}
# Sync a list of directories
sub sync_dirs {
my @dirs = $all_dirs ? @dirs : grep $sync{$_}, @dirs;
sync_dir($_) for @dirs;
dsp_msg( "Done!" );
}
# Sync the files from a remote to a local directory
sub sync_dir {
my $dir = shift;
dsp_msg( "Getting file info for $dir" );
my $lcl_dir = "$brief_dir\\$dir";
my $rem_dir = "$sync_dir\\$dir";
my $lcl_stat = dir_list( $lcl_dir );
my $rem_stat = dir_list( $rem_dir );
my %seen;
my (@copy_files, @create_files, @del_files);
dsp_msg( "Comparing files in $dir" );
for my $file ( sort keys %$lcl_stat ) {
my $stat = $lcl_stat->{$file};
if ( !exists $rem_stat->{$file} ) {
print "Delete file $file\n";
push @del_files, $file;
} elsif ( $stat ne $rem_stat->{$file} ) {
print "Copy file $file\n";
push @copy_files, $file;
}
$seen{$file}++;
}
for my $file ( grep !$seen{$_}, sort keys %$rem_stat ) {
print "Create file $file\n";
push @create_files, $file;
}
if ($do_copy) {
dsp_msg( "Synching $dir" );
chdir $rem_dir or die "Can't cd to $rem_dir: $!";
chdir $lcl_dir or die "Can't cd to $lcl_dir: $!";
unlink or warn "Error deleting file $_: $^E"
for sort @copy_files, @del_files;
my %sub_dirs;
for my $file ( sort @copy_files, @create_files ) {
print "Copying $file\n";
if ( $file =~ /^(.*)\\/ ) {
my $sub_dir = $1;
if ( ! $sub_dirs{$sub_dir} ) {
# Create non-existant sub-directories
# '-d' is on local directory, so speed should be ok,
# If it's a problem, then we should save directory
# info from the Win32 API calls and work from that
# BUG HERE: need to create one directory level at a time
# if file is more than one level deep.
if ( ! -d $sub_dir ) {
mkdir $sub_dir or die "Can't create $sub_dir: $^E";
}
$sub_dirs{$sub_dir}++;
}
}
copy( "$rem_dir\\$file", $file ) or warn "Error copying $file: $
+^E";
}
# Remove empty directories
# (this is "good enough" for me, I synch files, not
# neccessarily directory structures)
finddepth( sub { rmdir }, "." );
}
}
# Display message in both the message window
# and on the console
sub dsp_msg {
my $msg_txt = shift;
print "$msg_txt\n";
# Wipe out previous message to avoid odd redraw effects
$message = " " x (3 * length($msg_txt));
$msg->idletasks;
$message = $msg_txt;
$msg->idletasks;
}
# Import Windows Directory Listing functions
sub import_win32 {
Win32::API::Struct->typedef( 'FILETIME', qw(
DWORD LowDateTime;
DWORD HighDateTime;
));
Win32::API::Struct->typedef( 'WIN32_FIND_DATA', qw(
DWORD dwFileAttributes;
FILETIME ftCreationTime;
FILETIME ftLastAccessTime;
FILETIME ftLastWriteTime;
DWORD nFileSizeHigh;
DWORD nFileSizeLow;
DWORD dwReserved0;
DWORD dwReserved1;
TCHAR tFileName[260];
TCHAR tAlternateFileName[14];
));
my $first_file = Win32::API->new('kernel32', 'FindFirstFile', 'PS',
+'N');
if ( !defined($first_file) ) {
die "Can't import FindFirstFile: $^E";
}
my $nxt_file = Win32::API->new('kernel32', 'FindNextFile', 'NS', 'I'
+);
if ( !defined($nxt_file) ) {
die "Can't import FindNextFile: $^E";
}
my $close_file = Win32::API->new('kernel32', 'FindClose', 'N', 'I');
if ( !defined($close_file) ) {
die "Can't import FindClose: $^E";
}
return $first_file, $nxt_file;
}
# Get directory listing of files and their
# size and modification times from Windows API
sub dir_list {
my @dirs = my $top_dir = shift;
my %filestat;
my $data = Win32::API::Struct->new( 'WIN32_FIND_DATA' );
while( my $dir = shift @dirs ) {
( my $rel_dir = $dir ) =~ s/^\Q$top_dir\E\\?//;
$rel_dir .= "\\" if $rel_dir;
my $h = $find_first_file->Call( "$dir\\*", $data );
if ( defined($h) and $h > 0 ) {
DIRLOOP: {
my $file = $data->{tFileName};
if ( $file !~ /^\.\.?$/ ) {
# Check if file is really a directory
if ( $data->{dwFileAttributes} & 16 ) {
push @dirs, "$dir\\$file";
} else {
$filestat{ $rel_dir . $file } =
$data->{ftLastWriteTime}->{HighDateTime} . '-' .
$data->{ftLastWriteTime}->{LowDateTime} . '-' .
$data->{nFileSizeHigh} . '-' .
$data->{nFileSizeLow};
}
}
redo DIRLOOP if $find_nxt_file->Call( $h, $data );
}
} else {
die "Error reading $dir: $^E";
}
}
}
die "Error reading $top_dir: $^E\n" unless $^E + 0 == ERROR_NO_MORE_
+FILES;
$find_close->Call( $h ) if defined($h);
return \%filestat;
}
|