#!/usr/bin/perl ###print "Content-type: text/html\n\nData
";### ## ## goban.pl ## CGI-script that interprets tags. ## Inspired by Nick Wedd (nick@maproom.co.uk) ## See my web page at http://www.dse.nl/~toni/go/goban2sgf/ ## for more information. ## ## Copyright (C) 1999 Toni Cornelissen (toni@dse.nl) ## ## 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 2 ## 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, write to the Free Software ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ## #include some subroutines require 'cgi-utils.pl'; require 'tc-utils.pl'; require 'go-utils.pl'; ## default parameters $edges = ""; ## the edges $labels = ""; ## the labels $size = 0; ## the size of the gif's $size_x = $size; $size_y = $size_x; $images = "http://www.weddslist.com/g/"; ## the location of the images ## Nick changed this 2002-12-19. Toni's images have mixed case filenames which ## did not work with the Unix server that the script is now on. $pl = "B"; ## the first to play ## parse the query %param = &get_query(); ## check if the browser accepts gifs if ($ENV{'HTTP_ACCEPT'} !~ /image\/gif/) { ## no gifs are accepted, ## so redirect the browser to the url # print "location: $param{'url'}\n\n"; # exit; } ## no gifs ## overwrite the defaults with the parameters $edges = $param{'edges'} || $edges; $labels = $param{'labels'} || $labels; $sizep = $param{'size'} || $size; $size = $sizep; if ( $size<0 ) { $size = - $size; } $sizex = $size; $sizex = $param{'sizex'} || $sizex; $sizey = $sizex; $sizey = $param{'sizey'} || $sizey; $images = $param{'images'} || $images; $pl = $param{'pl'} || $pl; if (defined $param{'alt'}) { $alt = $param{'alt'}; } if (defined $param{'border'}) { $border = $param{'border'}; } ## read the page ###print "URL: $param{'url'}
\n";### *IN = &OpenURL($param{'url'}); while () { $page .= $_ } ## remove the extra newline from dos files $page =~ s/\r//gs; ## add a base tag ## if the page doesn't contain a base tag if ($page =~ /)/i) { ## the base tag doesn't contain a href if ($page !~ /]*href\s*=/i) { ## insert the href in the base tag $page =~ s||\n|i) { ## no head tag, put the head tag on top of the page $page = "\n" . $page; } } ## no head tag ## find the goban tags $startgoban = '<(?:!--)?\s*goban\s*(.*?)\s*(?:--)?>\s*'; $endgoban = '\s*<(?:!--)?\s*/goban\s*(?:--)?>'; while ($page =~ m|$startgoban(.*?)$endgoban|is) { my $goattr = $1; ###print "attr: $goattr
\n";### my $goban = $2; ## overwrite values with the parameters of the goban $l_edges = &find_attribute('edges', $goattr, $edges ); $l_labels = &find_attribute('labels', $goattr, $labels ); $l_size = &find_attribute('size', $goattr, 0); $l_sizex = $l_size; $l_sizey = $l_size; $l_sizex = &find_attribute('sizex', $goattr, $l_sizex) || $sizex; $l_sizey = &find_attribute('sizey', $goattr, $l_sizey) || $sizey; $l_images = &find_attribute('images', $goattr, $images); $l_pl = &find_attribute('pl', $goattr, $pl ); $l_alt0 = &find_attribute('alt', $goattr, (defined $alt ? $alt : "0")); $l_alt1 = &find_attribute('alt', $goattr, (defined $alt ? $alt : "1")); if ($l_alt0 == $l_alt1) { $alt0 = "alt=" . $l_alt1; } else { $alt0 = ""; } $l_border0 = &find_attribute('border', $goattr, (defined $border ? $border : "0")); $l_border1 = &find_attribute('border', $goattr, (defined $border ? $border : "1")); if ($l_border0 == $l_border1) { $border0 = "border=" . $l_border1; } else { $border0 = "" } $use_images = "http://weddslist.com/g/"; if ( $sizep > 0 ) { $use_images = "http://weddslist.com/g/$size/"; } if ( $sizep == 0 ) { $use_images = $l_images; } ## the goban code for gifs $goban = &board2html($use_images, &make_board(&clean_board($goban), "width=" . $l_sizey, "height=" . $l_sizex, "edge=" . $l_edges, "label=" . $l_labels, "pl=" . $l_pl, ## PL altered to pl 2003-07-09 $alt0, $border0)); ## subsitute $page =~ s|$startgoban(.*?)$endgoban|$goban|is; } ## find goban tags ## output print "Content-type: text/html\n\n$page"; exit; sub find_attribute { ## retreives attributes from a string my $key = shift; my $attr = shift; my $ret = shift; ## default ## quoted (" or ') if ($attr =~ /$key\s*=\s*("|')(.*?)\1/is) { $ret = $2; } ## unquoted, ends with a space of end of line elsif ($attr =~ /$key\s*=\s*(.*?)(\s|$)/i) { $ret = $1; } ## no parameter found, ## the default value was not overwritten ###print "$key: $ret
\n";### $ret; } ## find_param