Mercurial > hg > reproctool-df
view reproctool.cgi @ 12:6d5296efb9ef
Shows user-errors to output, not dying
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sun, 25 Jan 2009 13:36:31 +0000 |
parents | f749981ad862 |
children | 135adaf0eed2 |
line wrap: on
line source
#!/usr/bin/perl -T use warnings; use strict; use CGI; use DBI; # Settings my $img_http_path = '/itemimgs'; my $cgi = new CGI; print $cgi->header(-type => 'text/html', -pragma => 'no-cache', -expires => '-365d'); sub user_error { my $text = shift; print<<END; <html><head><title>Error</title></head> <body><font colour="#FF0000"><b>Error:</b></font> $text</body></html> END exit; } # Inputs my $str_items = $cgi->param('items') or user_error('Items missing'); my $cols = $cgi->param('cols') || 4; # Load mineral prices my $trit = $cgi->param('trit') || user_error('No trit price'); my $pyer = $cgi->param('pyer') || user_error('No pyer price'); my $mexa = $cgi->param('mexa') || user_error('No mexa price'); my $isog = $cgi->param('isog') || user_error('No isog price'); my $nocx = $cgi->param('nocx') || user_error('No nocx price'); my $zydr = $cgi->param('zydr') || user_error('No zydr price'); my $mega = $cgi->param('mega') || user_error('No mega price'); my $morp = $cgi->param('morp') || user_error('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?/); my @item_names = split(/\s*,\s*/, $str_items); # SQL fragment to match all items my $sql_typenames = ''; $sql_typenames = 'types.typeName = ?' if ($#item_names >= 0); $sql_typenames .= " OR types.typeName = ?" foreach (1..$#item_names); # SQL lookup for reprocessing amounts my $sql_reprocess = <<END; SELECT types.typeID, types.typeName, groups.groupName, 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 LEFT JOIN dgmTypeAttributes attrs ON types.typeID = attrs.typeID AND attrs.attributeID = 633 INNER JOIN typeActivityMaterials m1 ON types.typeID = m1.typeID INNER JOIN invGroups groups ON types.groupID = groups.groupID INNER JOIN eveGraphics graphics ON types.graphicID = graphics.graphicID WHERE $sql_typenames GROUP BY types.typeID ORDER BY groups.categoryID DESC, groupName ASC, typeName ASC END my $pre_reprocess = $db->prepare($sql_reprocess); # Execute, bring back one row per item my ($tid, $tname, $gname, $meta, $basePrice, $icon, $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega, $tmorp); $pre_reprocess->execute(@item_names) or die("Can't lookup items: $DBI::errstr"); $pre_reprocess->bind_columns(undef, \$tid, \$tname, \$gname, \$meta, \$basePrice, \$icon, \$ttrit, \$tpyer, \$tmexa, \$tisog, \$tnocx, \$tzydr, \$tmega, \$tmorp); my @output = (); while ($pre_reprocess->fetch()) { my $item = {}; 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 }; # If this item exists multiple times in the input, then they weren't stacked # so output it multiple times my @matching_in = grep({ $_ eq $tname } @item_names); push @output, $item foreach (0..$#matching_in); } 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 my $igb = ($ENV{HTTP_USER_AGENT} =~ /EVE-minibrowser/i); 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}"; if ($igb) { $img = "typeicon:$item->{id}"; $link = "showinfo:$item->{id}"; } else { $img = "$img_http_path/icons/icons_items_png/64_64/icon$item->{icon}.png"; } 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