#!/usr/local/bin/perl
# Fix short file names in a windows backup
# Usage: sfn-fix /mnt/windows C: [orig-mdir-output]
#
# Create the list of file names like this:
# (Edit /etc/mtools.conf if necessary to set up the drives)
# sudo mdir -a -/ C: > /mnt/windows/sfn.txt
# sudo mdir -a -/ D: > /mnt/windows2/sfn.txt
#

use strict;
use warnings;

sub parse_mdir($\%\%);
sub sfn_generate($);

$| = 1;

(my $myname = $0) =~ s|(.*/)*||;	# strip path component from name
my $Usage = "Usage: $myname /mnt/windows C: [orig-mdir-output] \n";
# Check two or three arguments:
die $Usage if ((@ARGV < 2) || (@ARGV > 3));

my $root = $ARGV[0];
die $Usage unless -d $root;
my $drive = $ARGV[1];
die $Usage unless $drive =~ /^[a-zA-Z]:/;
my $old = "";
if (@ARGV == 3) {
  $old = $ARGV[2];
} else {
  $old = "$root/sfn.txt";
}
die $Usage unless -f $old;

my $mdir = "sudo /usr/bin/mdir -/";

my %old_lfn = (); # Original sfn->lfn map
my %old_sfn = (); # Original lfn->sfn map
my %cur_lfn = (); # Current sfn->lfn map
my %cur_sfn = (); # Current lfn->sfn map

open(MDIR, $old) or die "Can't open $old: $!\n";
parse_mdir(\*MDIR, %old_lfn, %old_sfn);
close(MDIR);

open(MDIR, "$mdir $drive|") or die "Can't run $mdir: $!\n";
parse_mdir(\*MDIR, %cur_lfn, %cur_sfn);
close(MDIR);


# prefix.ext short file bases that have already been processed
# (or can't be processed because there are too many files):
my %done = ();
my ($printed, $base, $ext, @todo, $pp, $i);

FILE:
foreach my $dir (sort keys %old_lfn) {
  %done = ();
  $printed = 0;
  $pp = "";
  foreach my $lfn (sort keys %{$old_sfn{$dir}}) {
    $old = $old_sfn{$dir}{$lfn};
    # Check if file still exists:
    next unless defined($cur_sfn{$dir}{$lfn});
    # Skip if old and new sfns are the same:
    next if ($cur_sfn{$dir}{$lfn} eq $old_sfn{$dir}{$lfn});
    # Skip if this prefix has already been processed:
    $base = sfn_generate($lfn);
    next if $done{$base}++;
    @todo = ();
    # Count how many files currently have this prefix:
    foreach my $l (sort keys %{$cur_sfn{$dir}}) {
      push(@todo, $l) if (sfn_generate($l) eq $base);
    }
    next if (@todo > 9); # Too many files with this prefix.ext

    print "\n$dir:\n" unless $printed++;

    # Check that all the required names (old_sfn)
    # are of the form prefix~N.ext
    # (otherwise we can't fix them).
    ($base, $ext) = ($base =~ /^(.*)\.(.*)$/);
    foreach my $l (@todo) {
      next unless defined($old_sfn{$dir}{$l});
      if ($old_sfn{$dir}{$l} !~ /^\Q$base\E\~\d\.$ext$/) {
	print "!!! $l --> $old_sfn{$dir}{$l} can't be done (patt=$base~\\d\\.$ext)!\n";
	next FILE;
      }
    }

    # Fix the @todo files so that they have the right short names
    # but keep the same long file names:
    # (1) Move the files to a spare prefix
    # (2) Create 9 dummy files (so that ~1 to ~9 are accessable)
    # (3) For each file with an old sfn, delete the appropriate dummy
    #     and move the file to its original lfn (so it gets the right sfn)
    # (4) Delete remaining dummy files
    # (5) Move remaining @todo files back to their original lfn

    if ($pp eq "") {
      $pp = "aa";
      $pp++ while (grep { /^$pp/ } keys %{$cur_lfn{$dir}});
      print "Spare Prefix = <$pp>\n";
    }

    chdir "$root/$dir" or die "Can't chdir to $root/$dir: $!\n";

    # (1) Move files to spare prefix:
    foreach my $file (@todo) {
      rename $file, "$pp-$file"
	or warn "rename $file => $pp-$file failed: $!\n";
    }
    # (2) Create dummy files:
    foreach my $i (1..9) {
      open(DUMMY, ">$base.$ext-dummy-file-$i")
	or warn "Can't create $base.$ext-dummy-file-$i: $!\n";
      close(DUMMY);
    }
    # (3) Delete a dummy and move a file back to give
    # file the right sfn:
    foreach my $file (@todo) {
      next unless defined($old_sfn{$dir}{$file});
      $old_sfn{$dir}{$file} =~ /^\Q$base\E\~(\d)\.$ext$/
	or warn "Short name $old_sfn{$dir}{$file} of $file doesn't match $base~?.$ext!\n";
      $i = $1;
      unlink("$base.$ext-dummy-file-$i")
	or warn "unlink $base.$ext-dummy-file-$i failed: $!\n";
      print "$file: $cur_sfn{$dir}{$file} -> $old_sfn{$dir}{$file}\n";
      rename("$pp-$file", $file); # Should slot in to right sfn
    }
    # (4) Delete any remaining dummy files
    foreach my $i (1..9) {
      unlink "$base.$ext-dummy-file-$i";
    }
    # (5) Move any remaining @todo files back to original name:
    foreach my $file (@todo) {
      rename "$pp-$file", $file;
    }
  }
}





# Create the six character short file name prefix plus the three character
# extension (if any) from a long file name:
sub sfn_generate($) {
  local ($_) = @_;
  my ($pre, $ext);
  # Convert to lower case:
  tr/A-Z/a-z/;
  # Delete spaces:
  s/\s+//g;
  # Initial/trailing periods:
  s/^\.//;
  s/\.$//;
  # Delete all but last period:
  1 while (s/\.(.*)\./$1\./);
  # Translate illegal chars to "_":
  s/[\+\,\;\=\[\]]/_/g;
  if (/^(.+)\.(.+)$/) {
    $pre = substr($1, 0, 6);
    $ext = substr($2, 0, 3);
  } else {
    $pre = substr($_, 0, 6);
    $ext = "";
  }
  return("$pre.$ext");
}



sub parse_mdir($\%\%) {
  my ($fh, $sfn_lfn, $lfn_sfn) = @_;
  local $_;
  my $dir = "";
  my ($sfn, $lfn, $pre, $ext);
  while (<$fh>) {
    next if /^ Volume/;
    next if /^$/;
    next if /^\s*\d+ files?\s+[0-9 ]+bytes?$/;
    next if /^\.\.?\s+<DIR>/;
    if (/^Directory for [A-Z]:(.*)$/) {
      $dir = $1;
      next;
    }
    # Skip lines with no LFN:
    next unless /^\S{4,6}\~\d{1,3} /;
    if (!/^(.{8} .{3})(\s+\d+| <DIR>    ) \d\d-\d\d-\d\d\d\d  ( |\d)\d:\d\d  (\S.*)$/) {
      die "Unrecognised mdir line:\n$_";
    }
    $sfn = $1;
    $lfn = $4;
    $sfn =~ tr/A-Z/a-z/;
    # Check for extension and remove blanks in $sfn:
    $sfn =~ s/^(.{8}) (.{3})$/$1\.$2/ or die "Bad sfn in:\n$_";
    $sfn =~ s/ +//g;
#print "$dir/$lfn --> $sfn\n";
    $$lfn_sfn{$dir}{$lfn} = $sfn;
    $$sfn_lfn{$dir}{$sfn} = $lfn;
  }
}



exit (0);