Mercurial > hg > reproctool-df
view reproctool.cgi @ 32:583e4c324c24
Adding file copyright
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sun, 25 Jan 2009 17:55:47 +0000 |
parents | d1028107ab75 |
children | a4197a854e79 |
line wrap: on
line source
#!/usr/bin/perl -T # # CGI script for assessing reprocessing value of items in EVE-Online based # on mineral prices. # # Released under the revised BSD licence # Copyright (c) 2009 Dominic Cleal # Portions copyright (c) 2009 Bjorn Hamels use warnings; use strict; use Switch; use CGI; use DBI; use LWP::UserAgent; use Storable qw/store_fd fd_retrieve/; # Settings from params.cgi our (@dbparams, $img_http_path, $eve_central_url, $marks_cache, $marks_cache_expiry); $img_http_path = '/itemimgs'; $eve_central_url = 'http://eve-central.com/api/evemon'; $marks_cache = 'minerals.cache'; $marks_cache_expiry = 4 * 60 * 60; # 4 hours require './params.cgi'; # Begin script 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 color="#FF0000"><b>Error:</b></font> $text</body></html> END exit; } # Inputs my $cols = $cgi->param('cols') || 4; my $str_items = $cgi->param('items'); # Generate the first page, where eve-central mineral prices are prefilled. unless ($str_items) { # Try and pull the marks out of a stored cache my $marks; if (-e $marks_cache) { open CACHE, "< $marks_cache" || die("Can't open cache $marks_cache: $!"); $marks = fd_retrieve(*CACHE) || die("Can't read marks from cache: $!"); close CACHE; # Check expiry time if (time > ($marks->{timestamp} + $marks_cache_expiry)) { $marks = undef; } } unless ($marks) { # If cache was unavailable or had expired, pull again from eve-central my $ua = LWP::UserAgent->new; $ua->agent('reproctool'); my $resp = $ua->request(HTTP::Request->new(GET => $eve_central_url)); if ($resp->is_success) { # Store as Mineral => 1234 $marks = { timestamp => time }; foreach (split(/[\n\r]/, $resp->content)) { next unless (/<name>(.+)<\/name>.*<price>([0-9\.]+)<\/price>/i); $marks->{$1} = $2; } if (-e $marks_cache) { unlink $marks_cache || die("Unable to unlink cache $marks_cache: $!"); } # Store into the cache open CACHE, "> $marks_cache" || die("Can't open cache $marks_cache to write: $!"); store_fd($marks, *CACHE) || die("Can't write to cache: $!"); close CACHE; } else { # User can enter their own numbers if eve-central was down $marks->{$_} = 1 foreach ('Tritanium', 'Pyerite', 'Mexallon', 'Isogen', 'Nocxium', 'Zydrine', 'Megacyte', 'Morphite'); } } delete $marks->{timestamp} if exists $marks->{timestamp}; # What evenutally will be printed. print<<END; <html> <body> <form method="post"> <textarea rows="5" cols="80" name="items"></textarea> <table border="0" cellspacing="4"> <tr> END # Lists the name of the minerals. print "<td>$_</td>\n" foreach (keys %{$marks}); print "</tr><tr>"; foreach (keys %{$marks}) { my $sname = lc substr($_, 0, 4); my $fmt = sprintf('%.2f', $marks->{$_}); print "<td><input type='text' name='$sname' size='7' value='$fmt' /></td>\n"; } print <<END; </tr> </table> Columns: <input type='text' name='cols' size='2' value='4' /><br /><br /> <input type="submit" /> </form> <br /> Mineral prices are empire averages from <a href="http://www.eve-central.com/">Eve-central</a>. </body> </html> END exit; } # Load mineral prices my $trit = $cgi->param('trit') || user_error('No tritanium price'); my $pyer = $cgi->param('pyer') || user_error('No pyerite price'); my $mexa = $cgi->param('mexa') || user_error('No mexallon price'); my $isog = $cgi->param('isog') || user_error('No isogen price'); my $nocx = $cgi->param('nocx') || user_error('No nocxium price'); my $zydr = $cgi->param('zydr') || user_error('No zydrine price'); my $mega = $cgi->param('mega') || user_error('No megacyte price'); my $morp = $cgi->param('morp') || user_error('No morphite price'); 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); my $repDetails = sprintf( "Trit=%d Py=%d Mex=%d Iso=%d Nocx=%d Zyd=%d Mega=%d Morp=%d", $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega, $tmorp ); $meta = 0 unless defined $meta; $item = { id => $tid, name => $tname, meta => $meta, icon => $icon, price => $basePrice, reprocessIsk => $isk, reprocessDetails => $repDetails }; # 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"> .reg { text-align: center; } </style> </head> <body> <table> END sub pretty_numbers { my $num = shift; $num = sprintf('%.2f', $num); $num = reverse $num; $num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; return reverse $num; } my $igb = ($ENV{HTTP_USER_AGENT} =~ /EVE-minibrowser/i); for my $item (@output) { if ($col == $cols) { print "</tr><tr>\n"; $col = 0; } my ($img, $text, $link, $colour); if (defined $item->{id}) { 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"; } switch ($item->{meta}) { case 0 { $colour = "#666600"; } case 1 { $colour = "#777777"; } case 2 { $colour = "#BBBBBB"; } case 3 { $colour = "#FFFFFF"; } case 4 { $colour = "#4444FF"; } case 5 { $colour = "#FF0000"; } case [6..30]{ $colour = "#00FF00"; } } if ($item->{meta} >= 4) { $text = $item->{name}; } else { $text = $item->{reprocessIsk}; } } else { $text = 'Unknown item'; $img = "typeicon:07_15"; } print "<td width='64' class='reg'>"; print "<a href='$link'>" if defined $link; print "<img src='$img' width='64' height='64' border='1' "; print "title=\"$item->{name}\" alt=\"$item->{name} ($item->{reprocessDetails})\" />"; 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