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"
]
}
2024 the Authors,
published under the ![Sensei's Library [Welcome to Sensei's Library!]](../../images/stone-hello.png)