Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Win32 Directory Sync/Briefcase

by runrig (Abbot)
on Nov 08, 2005 at 23:56 UTC ( #506942=sourcecode: print w/ replies, xml ) Need Help??

Category: Win32 Stuff
Author/Contact Info runrig
Description: I needed a replacement for Windows "briefcase" directories, and only needed to sync from a remote directory to a local directory (never the other way as MS briefcases let you do). Should work recursively on sub-directories, but not very tested in that regard (update: I believe there is a bug in this regard when more than one level of sub-directory needs to be created, and no files exist in the higher level). Perl's file stat (and thus '-s' and '-M') are very slow over a VPN connection, so I needed to use the Windows API for getting that information. Also, a real MS briefcase uses a hidden database file which, if corrupted, trashes your briefcase...which I have been bitten by more than once. Thanks to ikegami and others for pointing me in the right direction.

Updated: Check for error when getting directory handle.

Updated: Check for error when reading directory.

#!/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;
}


Comment on Win32 Directory Sync/Briefcase
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://506942]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (16)
As of 2015-07-07 20:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls