sgf_rename

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use IO::File;
   6
   7 for my $sgf (@ARGV) {
   8      my %sgf;
   9      my $fh = new IO::File $sgf, 'r'
  10           or warn "Unable to open $sgf for reading: $!"
  11                and next;
  12      while (<$fh>) {
  13           chomp;
  14           my ($field,$value) = $_ =~ /^([A-Z]{2})\[([^\]]+)\]/;
  15           next unless defined $field;
  16           if ($field =~ /^[WB]R$/) {
  17                $value =~ s/\s+dan/d/;
  18                $value =~ s/\s+pro/p/;
  19                $value =~ s/\s+kyu/k/;
  20           }
  21           $sgf{$field} = $value;
  22      }
  23      undef $fh;
  24      my $new_file = join('_',
  25                          map {s{/}{}g;
  26                               s/\s+/_/g;
  27                               s/,/_/g;
  28                               s/[_-]+/_/g;
  29                               s/^_//;
  30                               s/_$//;
  31                               lc($_);
  32                          }
  33                          map{defined $_?($_):()}
  34                          (@sgf{qw(EV RO PB BR)},'v',
  35                           @sgf{qw(PW WR DT RE)}
  36                          )
  37                         ).'.sgf';
  38      print "Renaming $sgf to $new_file\n";
  39      next if $sgf eq $new_file;
  40      warn "$new_file already exists" and next if -e $new_file;
  41      rename($sgf,$new_file);
  42      my $psgz = $sgf;
  43      $psgz =~ s/\.sgf/.ps.gz/;
  44      if (-e $psgz) {
  45           my $new_psgz = $new_file;
  46           $new_psgz =~ s/\.sgf/.ps.gz/;
  47           rename($psgz,$new_psgz);
  48      }
  49 }