#!/usr/bin/perl # # Copyright (c) 2000 - E.L.Willighagen. # # 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. # # Modifications: # # Egon Willighagen # Stein Vråle # Patrick (sidster) use strict; use CGI qw(:standard); # these parameters need configuration # # where is the db info located? # my $universefile = "/home/swserv/universe/db/generic_out.unv"; my $picturedir = "/home/swserv/public_html/images"; # # where are the results located? # #my $gifext = "gif"; my $gifext = "png"; my $htmlgifdir = "/images/"; # note that something like celestial/star03.png is added to it... my $VERSION = 0.2.1; print header; # Print search page print < EOT if ( (scalar @ARGV != 1 ) && (param('NAME') eq '') && (param('ID') eq '') ) { exit(0); } # Parse CGI parameters # Search object ID my $id = $ARGV[0]; if (param('ID') ne '') { $id = param('ID'); } if (!$id) { $id = -1 ;} # Search object name my $search_name = ""; if (param('NAME') ne '') { $search_name = param('NAME'); } # read code2picture mapping my %pictures; if (open(FILE, "$picturedir/default.isr")) { my $picture = ""; my $code = ""; while () { if (/BeginISRefEntry\s*=\s*(.*)/i) { $code = $1; $picture = ""; } elsif (/FileName\s*=\s*(.*)/i) { $picture = $1; } elsif (/EndISRefEntry/i) { if ($picture ne "") { $picture =~ s/(.*?)\..*/$1.$gifext/; $pictures{$code} = $picture; } } } } else { print "An error occured! (pictures)$/"; exit (0); } if (open(FILE, "<$universefile")) { print "$/"; print " $/"; print " $/"; # parse opm file my $isobject = 0; my $isuniv = 0; my $current_id = 0; my %univ_params = (); my %params = (); while () { if (/BeginXSWObject\s*=\s*(.*)/i) { $isobject = 1; $current_id = $1; %params = (); $params{"Name"} = ""; #print "Detected object $current_id$/"; } elsif (/BeginHeader/i) { $isuniv = 1; } elsif (/EndHeader/i) { # print univers info print " $/"; $isuniv = 0; } elsif (/EndXSWObject/i) { $isobject = 0; if ($current_id == $id) { # dump data print " $/"; print " $/"; if ($params{"ImageSet"} ) { # it has an picture print " $/"; } else { print " $/"; } print " $/"; # Object found, no need to search more. last; } } elsif (/BeginEcoData/i) { $isobject = 0; } elsif (/EndEcoData/i) { $isobject = 1; } elsif (/BeginEcoProduct/i) { $isobject = 0; } elsif (/EndEcoProduct/i) { $isobject = 1; } elsif (/BeginWeapon/i) { $isobject = 0; } elsif (/EndWeapon/i) { $isobject = 1; } elsif ( $isobject && ($current_id == $id || $search_name) ) { # do some general parsing of parameters my ($param, $value) = parseLine($_); #print "OBJECT '$param' -> '$value'$/"; if ( $search_name && $param =~ /name/i && $value !~ /$search_name$/i ) { $isobject = 0; next; } else { $id = $current_id; } #print "SETTING $param -> $value$/"; #print " $param -> $value$/"; $params{$param} = $value; #$id = $current_id; } elsif ( $isuniv ) { my ($param, $value) = parseLine($_); #print "UNIV '$param' -> '$value'$/"; $univ_params{$param} = $value; } } print "

" ."" .$univ_params{"Title"} ."
" ."" . $params{"Name"} ."
$/"; print " $/"; print "	No picture
$/"; print " Object ID: " . $current_id . " $/"; if (1==1) { #$params{"SectX"} && $params{"SectY"} && $params{"SectZ"}) print " Sector: " . $params{"SectX"} . " " .$params{"SectY"} . " " . $params{"SectZ"} ." $/"; } if ($params{"CoordX"} && $params{"CoordY"} && $params{"Type"} != 3 && $params{"Type"} != 4 ) { print " X: " . $params{"CoordX"} . " $/"; print " Y: " . $params{"CoordY"} . " $/"; } if ($params{"Empire"}) { print " Empire: " . $params{"Empire"} . " $/"; } print "

$/"; print " $/"; print "$/"; } else { print "An error occured! (db read)"; print "Failed to open $universefile$/"; } sub parseLine { my $line = shift @_; $line =~ /^\s*(.*?)\s*=\s*(.*)\s*/; my $param = $1; my $val = $2; return ($param, $val); }