# This is part of ypp-sc-tools, a set of third-party tools for assisting # players of Yohoho Puzzle Pirates. # # Copyright (C) 2009 Ian Jackson # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # # Yohoho and Puzzle Pirates are probably trademarks of Three Rings and # are used without permission. This program is not endorsed or # sponsored by Three Rings. package CommodsScrape; use strict qw(vars); use warnings; use DBI; use POSIX; use Commods; BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); @EXPORT = qw(yppedia_chart_parse); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } sub yppedia_chart_parse ($$ $$$$ $) { my ($fh, $debugfh, $conv_nxy, $on_archlabel, $on_island, $on_league, $on_incomprehensible) = @_; my ($x,$y, $arch,$island,$sizecol,$solid,$dirn); my $nn= sub { return $conv_nxy->($x,$y) }; # We don't even bother with tag soup; instead we do line-oriented parsing. while (<$fh>) { s/\<--.*--\>//g; s/^\s*//; chomp; s/\s+$//; s/\s+/ /g; s/\<\/?(?:b|em)\>//g; s/\{\{(?:chart\ style|Chart league difficulty)\|[^{}]*\}\}//gi; next unless m/\{\{/; # only interested in chart template stuff if (($x,$y,$arch) = m/^\{\{ chart\ label \|(\d+)\|(\d+)\| .* (?: \<(?: big|center )\>)* \'+ (?: \[\[ | \{\{ ) [^][\']* \| ([^][\'|]+)\ archipelago (?: \]\] | \}\} ) \'+ (?: \<\/(?: big|center )\>)* \}\}$/xi) { printf $debugfh "%2d,%-2d arch %s\n", $x,$y,$arch; $on_archlabel->($x,$y,$arch); } elsif (m/^\{\{ chart\ label \|\d+\|\d+\| \ \'+ \[\[ .* \b ocean \]\]/xi) { } elsif (($x,$y,$island,$sizecol) = m/^\{\{ chart\ island\ icon \|(\d+)\|(\d+)\| ([^| ][^|]*[^| ]) \| [^|]* \| (\w+) \| .*\}\}$/xi) { my $n= $nn->(); printf $debugfh "%2d,%-2d island %s\n", $x,$y,$island; $on_island->($n, $island, $sizecol); } elsif (($solid,$x,$y,$dirn) = m/^\{\{ chart\ league((?:\ solid)?) \|(\d+)\|(\d+)\| \.?([-\/\\o])\.? \| .*\}\}$/xi) { next if $dirn eq 'o'; printf $debugfh "%2d,%-2d league %-6s %s\n", $x,$y, $solid?'solid':'dotted', $dirn; my ($bx,$by) = ($x,$y); if ($dirn eq '-') { $bx+=2; } elsif ($dirn eq '\\') { $bx++; $by++; } elsif ($dirn eq '/') { $x++; $by++; } else { die "$dirn ?"; } my $na= $nn->(); my $nb= $conv_nxy->($bx,$by); $on_league->($na,$nb,$solid); } elsif ( m/^\{\{ chart\ head \}\}$/xi ) { next; } else { $on_incomprehensible->($.,$_); } } } 1;