inforenamer.pl

Perl script to rename sgf files.

For example the sgf file a.sgf containing

(;DT[2016-12-29 19:01:34]KM[6.5]PB[NN]PC[Tygem]PW[Magist]RE[W+R]...

would be renamed 2016-12-29 19:01:34~NN~Magist.sgf by the command

perl inforenamer.pl -j ~ a.sgf DT PB PW

unless ~ is expanded as your home directory path, in which case its

perl inforenamer.pl -j '~' a.sgf DT PB PW

One issue is that the sgf tag format for date is "YYYY-MM-DD", which does not distinguish games played at different times on the same day. However some servers put the hours, minutes and seconds in there too.

 use strict;
 use warnings;
 use File::Basename;
 use File::Find;
 use Getopt::Std;

 start();

 sub start {
   my %opts;
   getopts('rj:', \%opts);
   if (@ARGV) {
     my $filename = shift @ARGV;
     my @files;
     if (-d $filename) { # oops $filename as a variable name is obsolete
       @files = $opts{r} ? reclistfolder($filename) : listfolder($filename);
     } else {
       push @files, $filename;
     }
     my @tags = @ARGV;
     if (@tags) {
       my $joiner = exists $opts{j} ? $opts{j} : message(0);
       renamefile($_, $joiner, process_sgf($_, {}, @tags), @tags) for @files;
     } else {
       print message(1);
     }
   } else {
     print message(2);
   }
 }

 sub process_sgf {
   my ($in, $taginfo, @tags) = @_;
   my $sgf = readfile($in);
   $sgf =~ s/\R//g;

   map { $taginfo->{$_} = gettag($sgf, $_, $in) } grep { !/^WN$/ } @tags;

   for (@tags) {
     if (/^WN$/) {
       my $data = gettag($sgf, 'RE', $in);
       if ($data eq '0') { # a drawn result
         $taginfo->{WN} = message(3);
       } else {
         addwinner($_, $taginfo, $data, $in) for 'B', 'W';
         gracefulexit(4, $in) unless exists $taginfo->{WN};
       }
     }
   }

   return $taginfo;
 }

 sub renamefile {
   my ($file, $joiner, $taginfo, @tags) = @_;
   my ($name, $path, $suffix) = fileparse($file, qr/\..*/); # $name is not used
   my $newname = join '', $path, join($joiner, map { $taginfo->{$_} } @tags), $suffix;
   if (-e $newname && $newname ne $file) {
     print message(5, $file, $newname);
   } else {
     print message(6, $file, $newname) unless rename $file, $newname;
   }
 }

 sub addwinner {
   my ($tag, $taginfo, $data, $in) = @_;
   if ($data =~ /$tag\+/) {
     if (exists $taginfo->{"P$tag"}) {
       $taginfo->{WN} = $taginfo->{"P$tag"};
     } else {
       gracefulexit(7, "P$tag", $in);
     }
   }
 }

 sub readfile {
   my $filename = shift;
   my $string = do {
     local $/;
     open my $fh, '<', $filename or gracefulexit(8, $filename);
     <$fh>;
   };
   return $string;
 }

 sub gettag {
   my ($sgf, $tag, $in) = @_;
   if ($sgf =~ /$tag\[(.*?)(?<!\\)]/) { # skip escaped closing bracket
     return $1;
   } else {
     return 19 if $tag eq 'SZ';
   }
   gracefulexit(7, $tag, $in);
 }

 sub reclistfolder {
   my @files;
   find(
      sub {
       push @files, $File::Find::name unless -d || /^\./
     },
     shift
   );
   return @files;
 }

 sub listfolder {
   my $dir = shift;
   opendir(DIR, $dir) or gracefulexit(9, $!);

   my @files = map { "$dir/$_" } grep {
     !/^\./          # does not begin with a full stop
     && -f "$dir/$_" # and is a file
   } readdir(DIR);

   closedir(DIR);
   return @files;
 }

 sub gracefulexit {
   print message(@_);
   exit;
 }

 sub message {
   my $messagenumber = shift;
   return sprintf messagelist()->[$messagenumber], @_;
 }

 sub messagelist {
   [
   ':', # 0
   "please supply at least one tag\n",
   "usage : perl inforenamer.pl [OPTIONS] [filename or foldername] [tags]\nOPTIONS : \n-r = recursively rename\n-j String = use String to separate tag values in filename\n\n[tags] is a list of sgf tags separated by spaces, plus the optional WN for winner\ne.g. perl inforenamer.pl -r -j ' ' thisfolderandallitssubfolders WN PB PW\n",
   'draw',
   "tag RE in unexpected format in %s\n",
   "could not rename %s - %s already exists\n", # 5
   "could not rename %s to %s\n",
   "missing tag %s in %s\n",
   "cannot open file %s\n",
   "%s"
   ]
 }