Mercurial > hg > reproctool-df
annotate reproctool.cgi @ 1:c39512d94605
Adding dbparams config
| author | Dominic Cleal <dominic@computerkb.co.uk> |
|---|---|
| date | Sat, 24 Jan 2009 16:46:51 +0000 |
| parents | 9c46727ce7ab |
| children | e640eb6cefc3 |
| rev | line source |
|---|---|
| 0 | 1 #!/usr/bin/perl -T |
| 2 | |
| 3 use warnings; | |
| 4 use strict; | |
| 5 | |
| 6 use CGI; | |
| 7 use DBI; | |
| 8 | |
| 9 # Settings | |
| 10 my $db_path = 'qr100-sqlite3-v1.db'; | |
| 11 my $img_http_path = '/itemimgs'; | |
| 12 | |
| 13 my $cgi = new CGI; | |
| 14 print $cgi->header(-type => 'text/html', | |
| 15 -pragma => 'no-cache', | |
| 16 -expires => '-365d'); | |
| 17 | |
| 18 # Inputs | |
| 19 my $str_items = $cgi->param('items') or die('Items missing'); | |
| 20 my $cols = $cgi->param('cols') || 4; | |
| 21 | |
| 22 # Load mineral prices | |
| 23 my $trit = $cgi->param('trit') || die('No trit price'); | |
| 24 my $pyer = $cgi->param('pyer') || die('No pyer price'); | |
| 25 my $mexa = $cgi->param('mexa') || die('No mexa price'); | |
| 26 my $isog = $cgi->param('isog') || die('No isog price'); | |
| 27 my $nocx = $cgi->param('nocx') || die('No nocx price'); | |
| 28 my $zydr = $cgi->param('zydr') || die('No zydr price'); | |
| 29 my $mega = $cgi->param('mega') || die('No mega price'); | |
| 30 my $morp = $cgi->param('morp') || die('No morp price'); | |
| 31 | |
|
1
c39512d94605
Adding dbparams config
Dominic Cleal <dominic@computerkb.co.uk>
parents:
0
diff
changeset
|
32 require 'dbparams.cgi'; |
|
c39512d94605
Adding dbparams config
Dominic Cleal <dominic@computerkb.co.uk>
parents:
0
diff
changeset
|
33 my $db = DBI->connect(@dbparams) |
| 0 | 34 or die("Database connection failure: $DBI::errstr"); |
| 35 | |
| 36 # Strip out line endings | |
| 37 $str_items =~ s/[\n\r]+//g; | |
| 38 | |
| 39 # If the items string contains the contract info too, strip it out | |
| 40 $str_items = $1 if ($str_items =~ /The container .+ contains the following items:(.+)/); | |
| 41 $str_items = $1 if ($str_items =~ /(.+)Are you sure you want to continue?/); | |
| 42 | |
| 43 # SQL lookup for reprocessing amounts | |
| 44 my $sql_reprocess = <<END; | |
| 45 SELECT | |
| 46 types.typeID, | |
| 47 types.typeName, | |
| 48 attrs.valueInt [metaLevel], | |
| 49 types.basePrice, | |
| 50 graphics.icon, | |
| 51 SUM(CASE WHEN m1.requiredTypeID = 34 THEN m1.quantity ELSE 0 END) [Tritanium], | |
| 52 SUM(CASE WHEN m1.requiredTypeID = 35 THEN m1.quantity ELSE 0 END) [Pyerite], | |
| 53 SUM(CASE WHEN m1.requiredTypeID = 36 THEN m1.quantity ELSE 0 END) [Mexallon], | |
| 54 SUM(CASE WHEN m1.requiredTypeID = 37 THEN m1.quantity ELSE 0 END) [Isogen], | |
| 55 SUM(CASE WHEN m1.requiredTypeID = 38 THEN m1.quantity ELSE 0 END) [Nocxium], | |
| 56 SUM(CASE WHEN m1.requiredTypeID = 39 THEN m1.quantity ELSE 0 END) [Zydrine], | |
| 57 SUM(CASE WHEN m1.requiredTypeID = 40 THEN m1.quantity ELSE 0 END) [Megacyte], | |
| 58 SUM(CASE WHEN m1.requiredTypeID = 11399 THEN m1.quantity ELSE 0 END) [Morphite] | |
| 59 FROM invTypes types | |
| 60 INNER JOIN dgmTypeAttributes attrs ON types.typeID = attrs.typeID AND attrs.attributeID = 633 | |
| 61 INNER JOIN typeActivityMaterials m1 ON types.typeID = m1.typeID | |
| 62 INNER JOIN eveGraphics graphics ON types.graphicID = graphics.graphicID | |
| 63 WHERE types.typeName = ? | |
| 64 GROUP BY | |
| 65 types.typeID, | |
| 66 types.typeName, | |
| 67 attrs.valueInt, | |
| 68 types.basePrice | |
| 69 END | |
| 70 my $pre_reprocess = $db->prepare($sql_reprocess); | |
| 71 | |
| 72 my @output = (); | |
| 73 for my $sitem (split(/\s*,\s*/, $str_items)) | |
| 74 { | |
| 75 my ($tid, $tname, $meta, $basePrice, $icon, | |
| 76 $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega); | |
| 77 | |
| 78 $pre_reprocess->execute($sitem) or die("Can't lookup $sitem: $DBI::errstr"); | |
| 79 $pre_reprocess->bind_columns(undef, \$tid, \$tname, \$meta, \$basePrice, | |
| 80 \$icon, \$ttrit, \$tpyer, \$tmexa, \$tisog, \$tnocx, \$tzydr, \$tmega); | |
| 81 | |
| 82 my $item = {}; | |
| 83 if ($pre_reprocess->fetch()) | |
| 84 { | |
| 85 my $isk = ($trit * $ttrit) + ($pyer * $tpyer) + ($mexa * $tmexa) + | |
| 86 ($isog * $tisog) + ($nocx * $tnocx) + ($zydr * $tzydr) + | |
| 87 ($mega * $tmega); | |
| 88 | |
| 89 $item = { id => $tid, name => $tname, meta => $meta, icon => $icon, | |
| 90 price => $basePrice, reprocess => $isk }; | |
| 91 } | |
| 92 push @output, $item; | |
| 93 } | |
| 94 | |
| 95 my $col = 0; | |
| 96 print<<END; | |
| 97 <html> | |
| 98 <head> | |
| 99 <style type="text/css"> | |
| 100 .meta4, .meta5, .meta6, .meta7, .meta8, .meta9 | |
| 101 { | |
| 102 border: 2px #FF0000 solid; | |
| 103 } | |
| 104 </style> | |
| 105 </head> | |
| 106 <body> | |
| 107 <table> | |
| 108 END | |
| 109 | |
| 110 for my $item (@output) | |
| 111 { | |
| 112 if ($col == $cols) | |
| 113 { | |
| 114 print "</tr><tr>\n"; | |
| 115 $col = 0; | |
| 116 } | |
| 117 | |
| 118 my ($style, $img, $text); | |
| 119 | |
| 120 if (defined $item->{id}) | |
| 121 { | |
| 122 $style = "meta$item->{meta}"; | |
| 123 $img = "icons/icons_items_png/64_64/icon$item->{icon}.png"; | |
| 124 if ($item->{meta} == 4) | |
| 125 { | |
| 126 $text = $item->{name}; | |
| 127 } | |
| 128 else | |
| 129 { | |
| 130 $text = $item->{reprocess}; | |
| 131 } | |
| 132 } | |
| 133 else | |
| 134 { | |
| 135 $text = 'Unknown item'; | |
| 136 $img = "icons/icons_items_png/64_64/icon07_15.png"; | |
| 137 } | |
| 138 | |
| 139 print "<td class='item $style'>"; | |
| 140 print "<img src='$img_http_path/$img' width='64' height='64' alt='$item->{name}' /><br />$text"; | |
| 141 print "</td>\n"; | |
| 142 | |
| 143 $col++; | |
| 144 } | |
| 145 | |
| 146 print<<END; | |
| 147 </tr> | |
| 148 </table> | |
| 149 </body> | |
| 150 </html> | |
| 151 END | |
| 152 |