get_sgf

   1 #! /usr/bin/perl
   2 # get_sgf downloads sgf from gobase, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2006 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 495 2006-08-10 08:02:01Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 get_sgf - downloads sgf and ps.gz from gobase
  18
  19 =head1 SYNOPSIS
  20
  21  [options]
  22
  23  Options:
  24   --debug, -d debugging level (Default 0)
  25   --help, -h display this help
  26   --man, -m display manual
  27
  28 =head1 OPTIONS
  29
  30 =over
  31
  32 =item B<--figures>
  33
  34 Figures to make, defaults to '%100'
  35
  36 =item B<--mode>
  37
  38 Mode to use, defaults to 'ps'
  39
  40 =item B<--extra>
  41
  42 Other parameters; defaults to 'paper=letter;size=420'
  43
  44 =item B<--debug, -d>
  45
  46 Debug verbosity. (Default 0)
  47
  48 =item B<--help, -h>
  49
  50 Display brief useage information.
  51
  52 =item B<--man, -m>
  53
  54 Display this manual.
  55
  56 =back
  57
  58 =head1 EXAMPLES
  59
  60
  61 =cut
  62
  63
  64 use vars qw($DEBUG);
  65
  66 use IO::File;
  67 use WWW::Mechanize;
  68 use File::Temp qw(tempdir);
  69 use Cwd;
  70 use URI;
  71
  72 my %options = (debug           => 0,
  73                help            => 0,
  74                man             => 0,
  75                figures         => '%100',
  76                mode            => 'ps',
  77                paper           => 'letter',
  78                scale           => '420',
  79               );
  80
  81 GetOptions(\%options,
  82            'figures=s','mode=s','extra=s',
  83            'username=s','password=s',
  84            'paper=s','scale=s',
  85            'debug|d+','help|h|?','man|m');
  86
  87 pod2usage() if $options{help};
  88 pod2usage({verbose=>2}) if $options{man};
  89
  90 $DEBUG = $options{debug};
  91
  92
  93 if (-r "$ENV{HOME}/.get_sgf") {
  94      my $sgf_fh = IO::File->new("$ENV{HOME}/.get_sgf") or
  95           die "Unable to open .get_sgf for reading";
  96      local $/;
  97      my $sgf_file = <$sgf_fh>;
  98      ($options{username},$options{password}) = $sgf_file =~ /^(\w+)\:(\w+)$/;
  99      close $sgf_fh;
 100 }
 101
 102 my $olddir = getcwd();
 103
 104 #my $tmpdir = tempdir(CLEANUP=>1);
 105 #chdir($tmpdir);
 106
 107 # /games/japan/titles/kisei/31/game-01.sgf
 108
 109
 110 my $m = WWW::Mechanize->new();
 111 $m->credentials($options{username},$options{password});
 112 my $base = 'http://gobase.org/online/sgf2misc/?fname=/games/japan/titles/kisei/31/game-01.sgf';
 113 for my $url (@ARGV) {
 114      # strip of leading stuff
 115      $url =~ s/[^=]+=//;
 116      $url =~ s{(?:http://)?(?:gobase\.org)?}{};
 117      $url = qq(/$url) unless $url =~ m{^/};
 118      my $fname = $url;
 119      my $uri = URI->new($base);
 120      $uri->query_form(mode    => $options{mode},
 121                       fname   => $fname,
 122                      );
 123      $m->get("http://gobase.org$fname");
 124      $m->save_content('temp.sgf');
 125      $m->get($uri->as_string);
 126      $m->follow_link(text_regex=>qr/PostScript/);
 127      $m->form_number(2);
 128      $m->select('scale',$options{scale});
 129      $m->field('fig',$options{figures});
 130      $m->select('paper',$options{paper});
 131      $m->submit();
 132      my $content;
 133      my $state;
 134      my $sleep;
 135  VALID_LOOP: {
 136           do {
 137                $state = $m->clone;
 138                $m->follow_link(url_regex=>qr/\.ps\.gz/);
 139                if ($m->content =~ /^\%\!PS/){
 140                     $m->save_content('temp.ps');
 141                     last VALID_LOOP;
 142                }
 143                $sleep = 240+int(rand()*120);
 144                print STDERR "Failure to download content, waiting $sleep seconds\n";
 145                $m = $state;
 146           } while (sleep $sleep);
 147      }
 148      system('gzip','temp.ps');
 149      system("$ENV{HOME}/bin/sgf_rename",'temp.sgf');
 150 }
 151
 152 __END__