Mercurial > hg > reproctool-df
view reproctool.cgi @ 8:ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
author | df |
---|---|
date | Sun, 25 Jan 2009 14:40:37 +0000 |
parents | e30154411e63 |
children | 257e748cd08e |
line wrap: on
line source
#!/usr/bin/perl -T use warnings; use strict; use CGI; use DBI; use XML::DOM; # Settings my $img_http_path = '/itemimgs'; my $cgi = new CGI; print $cgi->header(-type => 'text/html', -pragma => 'no-cache', -expires => '-365d'); # Generate the first page, where eve-central mineral prices are prefilled. # TODO: depending on the traffic, cache these eve-central prices. my $str_items; if (! ($str_items = $cgi->param('items')) ) { my $min; my $eveCentralURL = 'http://eve-central.com/api/evemon'; my $xmlParser = XML::DOM::Parser->new(); my $xmlDoc = $xmlParser->parsefile($eveCentralURL); # What evenutally will be printed. my $inputPage = <<END; <html> <body> <form action="/cgi-bin/reproctool/reproctool.cgi" method="post"> <textarea rows="5" cols="80" name="items"></textarea> <table border="0" cellspacing="4"> <tr> END # Lists the name of the minerals. foreach $min ($xmlDoc->getElementsByTagName('mineral')) { $inputPage .= sprintf( " <td>%s</td>\n", $min->getElementsByTagName('name')->item(0)->getFirstChild->getNodeValue ); } $inputPage .= <<END; </tr> <tr> END foreach $min ($xmlDoc->getElementsByTagName('mineral')) { $inputPage .= sprintf( " <td><input type=\"text\" name=\"%s\" size=\"5\" value=\"%.2f\" /></td>\n", $min->getElementsByTagName('name')->item(0)->getFirstChild->getNodeValue, $min->getElementsByTagName('price')->item(0)->getFirstChild->getNodeValue ); } $inputPage .= <<END; </tr> </table> <input type="submit" /> </form> </body> </html> END print $inputPage; exit 0; } # Inputs my $cols = $cgi->param('cols') || 4; # Load mineral prices (names are generated above, but i feel # it's safe to assume they wont change that often). my $trit = $cgi->param('Tritanium') || die('No trit price'); my $pyer = $cgi->param('Pyerite') || die('No pyer price'); my $mexa = $cgi->param('Mexallon') || die('No mexa price'); my $isog = $cgi->param('Isogen') || die('No isog price'); my $nocx = $cgi->param('Nocxium') || die('No nocx price'); my $zydr = $cgi->param('Zydrine') || die('No zydr price'); my $mega = $cgi->param('Megacyte') || die('No mega price'); my $morp = $cgi->param('Morphite') || die('No morp price'); our @dbparams; require './dbparams.cgi'; my $db = DBI->connect(@dbparams) or die("Database connection failure: $DBI::errstr"); # Strip out line endings $str_items =~ s/[\n\r]+//g; # If the items string contains the contract info too, strip it out $str_items = $1 if ($str_items =~ /The container .+ contains the following items:(.+)/); $str_items = $1 if ($str_items =~ /(.+)Are you sure you want to continue?/); # SQL lookup for reprocessing amounts my $sql_reprocess = <<END; SELECT types.typeID, types.typeName, attrs.valueInt, -- metaLevel types.basePrice, graphics.icon, SUM(CASE WHEN m1.requiredTypeID = 34 THEN m1.quantity ELSE 0 END), -- [Tritanium] SUM(CASE WHEN m1.requiredTypeID = 35 THEN m1.quantity ELSE 0 END), -- [Pyerite] SUM(CASE WHEN m1.requiredTypeID = 36 THEN m1.quantity ELSE 0 END), -- [Mexallon] SUM(CASE WHEN m1.requiredTypeID = 37 THEN m1.quantity ELSE 0 END), -- [Isogen] SUM(CASE WHEN m1.requiredTypeID = 38 THEN m1.quantity ELSE 0 END), -- [Nocxium] SUM(CASE WHEN m1.requiredTypeID = 39 THEN m1.quantity ELSE 0 END), -- [Zydrine] SUM(CASE WHEN m1.requiredTypeID = 40 THEN m1.quantity ELSE 0 END), -- [Megacyte] SUM(CASE WHEN m1.requiredTypeID = 11399 THEN m1.quantity ELSE 0 END) -- [Morphite] FROM invTypes types INNER JOIN dgmTypeAttributes attrs ON types.typeID = attrs.typeID AND attrs.attributeID = 633 INNER JOIN typeActivityMaterials m1 ON types.typeID = m1.typeID INNER JOIN eveGraphics graphics ON types.graphicID = graphics.graphicID WHERE types.typeName = ? GROUP BY types.typeID, types.typeName, attrs.valueInt, types.basePrice END my $pre_reprocess = $db->prepare($sql_reprocess); my @output = (); for my $sitem (split(/\s*,\s*/, $str_items)) { my ($tid, $tname, $meta, $basePrice, $icon, $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega, $tmorp); $pre_reprocess->execute($sitem) or die("Can't lookup $sitem: $DBI::errstr"); $pre_reprocess->bind_columns(undef, \$tid, \$tname, \$meta, \$basePrice, \$icon, \$ttrit, \$tpyer, \$tmexa, \$tisog, \$tnocx, \$tzydr, \$tmega, \$tmorp); my $item = {}; if ($pre_reprocess->fetch()) { my $isk = ($trit * $ttrit) + ($pyer * $tpyer) + ($mexa * $tmexa) + ($isog * $tisog) + ($nocx * $tnocx) + ($zydr * $tzydr) + ($mega * $tmega) + ($morp * $tmorp); $meta = 0 unless defined $meta; $item = { id => $tid, name => $tname, meta => $meta, icon => $icon, price => $basePrice, reprocess => $isk }; } push @output, $item; } my $col = 0; print<<END; <html> <head> <style type="text/css"> .meta4, .meta5, .meta6, .meta7, .meta8, .meta9 { color: #FF0000; } .item { text-align: center; } </style> </head> <body> <table> END for my $item (@output) { if ($col == $cols) { print "</tr><tr>\n"; $col = 0; } my ($style, $img, $text, $link, $colour); if (defined $item->{id}) { $style = "meta$item->{meta}"; $img = "typeicon:$item->{id}"; $link = "showinfo:$item->{id}"; if ($item->{meta} == 4) { $text = $item->{name}; $colour = "#FF0000"; } else { $text = $item->{reprocess}; } } else { $text = 'Unknown item'; $img = "typeicon:07_15"; } print "<td width='64' class='item'>"; print "<a href='$link'>" if defined $link; print "<img src='$img' width='64' height='64' border='1' alt=\"$item->{name}\" />"; print "</a>" if defined $link; print "<br />"; print "<font color='$colour'>" if defined $colour; print $text; print "</font>" if defined $colour; print "</td>\n"; $col++; } print<<END; </tr> </table> </body> </html> END