yarrg/CommodsScrape.pm

   1 # This is part of ypp-sc-tools, a set of third-party tools for assisting
   2 # players of Yohoho Puzzle Pirates.
   3 #
   4 # Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 #
  19 # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
  20 # are used without permission.  This program is not endorsed or
  21 # sponsored by Three Rings.
  22
  23 package CommodsScrape;
  24
  25 use strict qw(vars);
  26 use warnings;
  27
  28 use DBI;
  29 use POSIX;
  30
  31 use Commods;
  32
  33 BEGIN {
  34     use Exporter ();
  35     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  36     $VERSION     = 1.00;
  37     @ISA         = qw(Exporter);
  38     @EXPORT      = qw(yppedia_chart_parse);
  39     %EXPORT_TAGS = ( );
  40
  41     @EXPORT_OK   = qw();
  42 }
  43
  44 sub yppedia_chart_parse ($$ $$$$ $) {
  45     my ($fh, $debugfh,
  46         $conv_nxy, $on_archlabel, $on_island, $on_league,
  47         $on_incomprehensible) = @_;
  48
  49     my ($x,$y, $arch,$island,$sizecol,$solid,$dirn);
  50     my $nn= sub { return $conv_nxy->($x,$y) };
  51
  52     # We don't even bother with tag soup; instead we do line-oriented parsing.
  53     while (<$fh>) {
  54         s/\<--.*--\>//g;
  55         s/^\s*//; chomp; s/\s+$//; s/\s+/ /g;
  56         s/\<\/?(?:b|em)\>//g;
  57         s/\{\{(?:chart\ style|Chart league difficulty)\|[^{}]*\}\}//gi;
  58         s/^\{\{testing\}\}//;
  59         next unless m/\{\{/; # only interested in chart template stuff
  60
  61         if (($x,$y,$arch) =
  62             m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .*
  63                     (?: \<(?: big|center )\>)* \'+
  64                     (?: \[\[ | \{\{ )
  65                     [^][\']* \| ([^][\'|]+)\ archipelago
  66                     (?: \]\] | \}\} )
  67                     \'+ (?: \<\/(?: big|center )\>)* \}\}$/xi) {
  68             printf $debugfh "%2d,%-2d arch %s\n", $x,$y,$arch;
  69             $on_archlabel->($x,$y,$arch);
  70         } elsif (m/^\{\{ chart\ label \|\d+\|\d+\|
  71                  \<big\> \'+ \[\[ .* \b ocean \]\]/xi) {
  72         } elsif (($x,$y,$island,$sizecol) =
  73             m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\|
  74                     ([^| ][^|]*[^| ]) \| [^|]* \| (\w+) \| .*\}\}$/xi) {
  75             my $n= $nn->();
  76             printf $debugfh "%2d,%-2d island %s\n", $x,$y,$island;
  77             $on_island->($n, $island, $sizecol);
  78         } elsif (($solid,$x,$y,$dirn) =
  79             m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\|
  80                     \.?([-\/\\o])\.? \| .*\}\}$/xi) {
  81             next if $dirn eq 'o';
  82
  83             printf $debugfh "%2d,%-2d league %-6s %s\n", $x,$y,
  84                 $solid?'solid':'dotted', $dirn;
  85
  86             my ($bx,$by) = ($x,$y);
  87             if ($dirn eq '-') { $bx+=2; }
  88             elsif ($dirn eq '\\') { $bx++; $by++; }
  89             elsif ($dirn eq '/') { $x++; $by++; }
  90             else { die "$dirn ?"; }
  91
  92             my $na= $nn->();
  93             my $nb= $conv_nxy->($bx,$by);
  94             $on_league->($na,$nb,$solid);
  95         } elsif (
  96             m/^\{\{ chart\ head \}\}$/xi
  97                  ) {
  98             next;
  99         } else {
 100             $on_incomprehensible->($.,$_);
 101         }
 102     }
 103 }
 104
 105 1;