Mercurial > hg > reproctool-df
annotate reproctool.cgi @ 30:d1028107ab75
Pretty numbers function
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sun, 25 Jan 2009 17:44:32 +0000 |
parents | 420807d41e04 |
children | 5c28a9d5fae7 583e4c324c24 |
rev | line source |
---|---|
0 | 1 #!/usr/bin/perl -T |
2 | |
3 use warnings; | |
4 use strict; | |
5 | |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
6 use Switch; |
0 | 7 use CGI; |
8 use DBI; | |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
9 use LWP::UserAgent; |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
10 use Storable qw/store_fd fd_retrieve/; |
0 | 11 |
27
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
12 # Settings from params.cgi |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
13 our (@dbparams, $img_http_path, $eve_central_url, |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
14 $marks_cache, $marks_cache_expiry); |
0 | 15 |
27
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
16 $img_http_path = '/itemimgs'; |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
17 $eve_central_url = 'http://eve-central.com/api/evemon'; |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
18 $marks_cache = 'minerals.cache'; |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
19 $marks_cache_expiry = 4 * 60 * 60; # 4 hours |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
20 |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
21 require './params.cgi'; |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
22 |
789877ff0e1a
Changing dbparams to contain all settings
Dominic Cleal <dominic@computerkb.co.uk>
parents:
26
diff
changeset
|
23 # Begin script |
0 | 24 my $cgi = new CGI; |
25 print $cgi->header(-type => 'text/html', | |
26 -pragma => 'no-cache', | |
27 -expires => '-365d'); | |
28 | |
12
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
29 sub user_error |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
30 { |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
31 my $text = shift; |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
32 print<<END; |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
33 <html><head><title>Error</title></head> |
13 | 34 <body><font color="#FF0000"><b>Error:</b></font> $text</body></html> |
12
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
35 END |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
36 exit; |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
37 } |
6d5296efb9ef
Shows user-errors to output, not dying
Dominic Cleal <dominic@computerkb.co.uk>
parents:
11
diff
changeset
|
38 |
24
266c93756c1b
Putting inputs next to each other again
Dominic Cleal <dominic@computerkb.co.uk>
parents:
21
diff
changeset
|
39 # Inputs |
266c93756c1b
Putting inputs next to each other again
Dominic Cleal <dominic@computerkb.co.uk>
parents:
21
diff
changeset
|
40 my $cols = $cgi->param('cols') || 4; |
266c93756c1b
Putting inputs next to each other again
Dominic Cleal <dominic@computerkb.co.uk>
parents:
21
diff
changeset
|
41 my $str_items = $cgi->param('items'); |
266c93756c1b
Putting inputs next to each other again
Dominic Cleal <dominic@computerkb.co.uk>
parents:
21
diff
changeset
|
42 |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
43 # Generate the first page, where eve-central mineral prices are prefilled. |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
44 unless ($str_items) |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
45 { |
29 | 46 # Try and pull the marks out of a stored cache |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
47 my $marks; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
48 if (-e $marks_cache) |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
49 { |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
50 open CACHE, "< $marks_cache" || die("Can't open cache $marks_cache: $!"); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
51 $marks = fd_retrieve(*CACHE) || die("Can't read marks from cache: $!"); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
52 close CACHE; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
53 |
29 | 54 # Check expiry time |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
55 if (time > ($marks->{timestamp} + $marks_cache_expiry)) |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
56 { |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
57 $marks = undef; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
58 } |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
59 } |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
60 |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
61 unless ($marks) |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
62 { |
29 | 63 # If cache was unavailable or had expired, pull again from eve-central |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
64 my $ua = LWP::UserAgent->new; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
65 $ua->agent('reproctool'); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
66 my $resp = $ua->request(HTTP::Request->new(GET => $eve_central_url)); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
67 |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
68 if ($resp->is_success) |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
69 { |
29 | 70 # Store as Mineral => 1234 |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
71 $marks = { timestamp => time }; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
72 foreach (split(/[\n\r]/, $resp->content)) |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
73 { |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
74 next unless (/<name>(.+)<\/name>.*<price>([0-9\.]+)<\/price>/i); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
75 $marks->{$1} = $2; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
76 } |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
77 |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
78 if (-e $marks_cache) |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
79 { |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
80 unlink $marks_cache |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
81 || die("Unable to unlink cache $marks_cache: $!"); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
82 } |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
83 |
29 | 84 # Store into the cache |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
85 open CACHE, "> $marks_cache" |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
86 || die("Can't open cache $marks_cache to write: $!"); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
87 store_fd($marks, *CACHE) || die("Can't write to cache: $!"); |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
88 close CACHE; |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
89 } |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
90 else |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
91 { |
29 | 92 # User can enter their own numbers if eve-central was down |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
93 $marks->{$_} = 1 foreach ('Tritanium', 'Pyerite', 'Mexallon', |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
94 'Isogen', 'Nocxium', 'Zydrine', |
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
95 'Megacyte', 'Morphite'); |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
96 } |
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
97 } |
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
98 |
28
61fb1a6de2c5
Fixing timestamp entry sometimes left
Dominic Cleal <dominic@computerkb.co.uk>
parents:
27
diff
changeset
|
99 delete $marks->{timestamp} if exists $marks->{timestamp}; |
61fb1a6de2c5
Fixing timestamp entry sometimes left
Dominic Cleal <dominic@computerkb.co.uk>
parents:
27
diff
changeset
|
100 |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
101 # What evenutally will be printed. |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
102 print<<END; |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
103 <html> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
104 <body> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
105 |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
106 <form method="post"> |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
107 <textarea rows="5" cols="80" name="items"></textarea> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
108 <table border="0" cellspacing="4"> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
109 <tr> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
110 END |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
111 # Lists the name of the minerals. |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
112 print "<td>$_</td>\n" foreach (keys %{$marks}); |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
113 print "</tr><tr>"; |
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
114 |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
115 foreach (keys %{$marks}) |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
116 { |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
117 my $sname = lc substr($_, 0, 4); |
25
ccbd8fa63b9f
Adding a cache for mineral marks
Dominic Cleal <dominic@computerkb.co.uk>
parents:
24
diff
changeset
|
118 my $fmt = sprintf('%.2f', $marks->{$_}); |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
119 print "<td><input type='text' name='$sname' size='7' value='$fmt' /></td>\n"; |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
120 } |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
121 |
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
122 print <<END; |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
123 </tr> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
124 </table> |
18
67f13a371c18
Adding columns input
Dominic Cleal <dominic@computerkb.co.uk>
parents:
17
diff
changeset
|
125 Columns: <input type='text' name='cols' size='2' value='4' /><br /><br /> |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
126 <input type="submit" /> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
127 </form> |
21
5ae40a1161e6
Added eve central credit (still need to cache some vals, got an idea on that dom?)
df
parents:
20
diff
changeset
|
128 <br /> |
5ae40a1161e6
Added eve central credit (still need to cache some vals, got an idea on that dom?)
df
parents:
20
diff
changeset
|
129 Mineral prices are empire averages from <a href="http://www.eve-central.com/">Eve-central</a>. |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
130 </body> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
131 </html> |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
132 END |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
133 |
17
a79168f03fc4
Replacing XML::DOM with LWP and regex, tidying code
Dominic Cleal <dominic@computerkb.co.uk>
parents:
16
diff
changeset
|
134 exit; |
8
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
135 } |
ccd5e74fa58e
Untested xml import of prices from evecentral. solution is a dead end, as the rammsrdi.com dont support dom xlm.
df
parents:
7
diff
changeset
|
136 |
0 | 137 # Load mineral prices |
15
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
138 my $trit = $cgi->param('trit') || user_error('No tritanium price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
139 my $pyer = $cgi->param('pyer') || user_error('No pyerite price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
140 my $mexa = $cgi->param('mexa') || user_error('No mexallon price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
141 my $isog = $cgi->param('isog') || user_error('No isogen price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
142 my $nocx = $cgi->param('nocx') || user_error('No nocxium price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
143 my $zydr = $cgi->param('zydr') || user_error('No zydrine price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
144 my $mega = $cgi->param('mega') || user_error('No megacyte price'); |
50d8619bce32
Improving mineral errors
Dominic Cleal <dominic@computerkb.co.uk>
parents:
14
diff
changeset
|
145 my $morp = $cgi->param('morp') || user_error('No morphite price'); |
0 | 146 |
1
c39512d94605
Adding dbparams config
Dominic Cleal <dominic@computerkb.co.uk>
parents:
0
diff
changeset
|
147 my $db = DBI->connect(@dbparams) |
0 | 148 or die("Database connection failure: $DBI::errstr"); |
149 | |
150 # Strip out line endings | |
151 $str_items =~ s/[\n\r]+//g; | |
152 | |
153 # If the items string contains the contract info too, strip it out | |
154 $str_items = $1 if ($str_items =~ /The container .+ contains the following items:(.+)/); | |
155 $str_items = $1 if ($str_items =~ /(.+)Are you sure you want to continue?/); | |
156 | |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
157 my @item_names = split(/\s*,\s*/, $str_items); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
158 |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
159 # SQL fragment to match all items |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
160 my $sql_typenames = ''; |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
161 $sql_typenames = 'types.typeName = ?' if ($#item_names >= 0); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
162 $sql_typenames .= " OR types.typeName = ?" foreach (1..$#item_names); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
163 |
0 | 164 # SQL lookup for reprocessing amounts |
165 my $sql_reprocess = <<END; | |
166 SELECT | |
167 types.typeID, | |
168 types.typeName, | |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
169 groups.groupName, |
3
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
170 attrs.valueInt, -- metaLevel |
0 | 171 types.basePrice, |
172 graphics.icon, | |
3
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
173 SUM(CASE WHEN m1.requiredTypeID = 34 THEN m1.quantity ELSE 0 END), -- [Tritanium] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
174 SUM(CASE WHEN m1.requiredTypeID = 35 THEN m1.quantity ELSE 0 END), -- [Pyerite] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
175 SUM(CASE WHEN m1.requiredTypeID = 36 THEN m1.quantity ELSE 0 END), -- [Mexallon] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
176 SUM(CASE WHEN m1.requiredTypeID = 37 THEN m1.quantity ELSE 0 END), -- [Isogen] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
177 SUM(CASE WHEN m1.requiredTypeID = 38 THEN m1.quantity ELSE 0 END), -- [Nocxium] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
178 SUM(CASE WHEN m1.requiredTypeID = 39 THEN m1.quantity ELSE 0 END), -- [Zydrine] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
179 SUM(CASE WHEN m1.requiredTypeID = 40 THEN m1.quantity ELSE 0 END), -- [Megacyte] |
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
180 SUM(CASE WHEN m1.requiredTypeID = 11399 THEN m1.quantity ELSE 0 END) -- [Morphite] |
0 | 181 FROM invTypes types |
11
f749981ad862
Fixes items with no metalevel attribute, improves sorting
Dominic Cleal <dominic@computerkb.co.uk>
parents:
10
diff
changeset
|
182 LEFT JOIN dgmTypeAttributes attrs ON types.typeID = attrs.typeID AND attrs.attributeID = 633 |
0 | 183 INNER JOIN typeActivityMaterials m1 ON types.typeID = m1.typeID |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
184 INNER JOIN invGroups groups ON types.groupID = groups.groupID |
0 | 185 INNER JOIN eveGraphics graphics ON types.graphicID = graphics.graphicID |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
186 WHERE $sql_typenames |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
187 GROUP BY types.typeID |
11
f749981ad862
Fixes items with no metalevel attribute, improves sorting
Dominic Cleal <dominic@computerkb.co.uk>
parents:
10
diff
changeset
|
188 ORDER BY groups.categoryID DESC, groupName ASC, typeName ASC |
0 | 189 END |
190 my $pre_reprocess = $db->prepare($sql_reprocess); | |
191 | |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
192 # Execute, bring back one row per item |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
193 my ($tid, $tname, $gname, $meta, $basePrice, $icon, |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
194 $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega, $tmorp); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
195 |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
196 $pre_reprocess->execute(@item_names) or die("Can't lookup items: $DBI::errstr"); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
197 $pre_reprocess->bind_columns(undef, \$tid, \$tname, \$gname, \$meta, \$basePrice, |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
198 \$icon, \$ttrit, \$tpyer, \$tmexa, \$tisog, |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
199 \$tnocx, \$tzydr, \$tmega, \$tmorp); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
200 |
0 | 201 my @output = (); |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
202 while ($pre_reprocess->fetch()) |
0 | 203 { |
204 my $item = {}; | |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
205 my $isk = ($trit * $ttrit) + ($pyer * $tpyer) + ($mexa * $tmexa) + |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
206 ($isog * $tisog) + ($nocx * $tnocx) + ($zydr * $tzydr) + |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
207 ($mega * $tmega) + ($morp * $tmorp); |
20
877806fb69a3
Fixed double use of var, and added reprocessing details in ALT
df
parents:
18
diff
changeset
|
208 my $repDetails = sprintf( "Trit=%d Py=%d Mex=%d Iso=%d Nocx=%d Zyd=%d Mega=%d Morp=%d", |
877806fb69a3
Fixed double use of var, and added reprocessing details in ALT
df
parents:
18
diff
changeset
|
209 $ttrit, $tpyer, $tmexa, $tisog, $tnocx, $tzydr, $tmega, $tmorp ); |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
210 |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
211 $meta = 0 unless defined $meta; |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
212 $item = { id => $tid, name => $tname, meta => $meta, icon => $icon, |
20
877806fb69a3
Fixed double use of var, and added reprocessing details in ALT
df
parents:
18
diff
changeset
|
213 price => $basePrice, reprocessIsk => $isk, reprocessDetails => $repDetails }; |
9
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
214 |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
215 # If this item exists multiple times in the input, then they weren't stacked |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
216 # so output it multiple times |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
217 my @matching_in = grep({ $_ eq $tname } @item_names); |
6b98a17fbe22
Changing to a single SQL query for type-based sorting and efficiency
Dominic Cleal <dominic@computerkb.co.uk>
parents:
7
diff
changeset
|
218 push @output, $item foreach (0..$#matching_in); |
0 | 219 } |
220 | |
221 my $col = 0; | |
222 print<<END; | |
223 <html> | |
224 <head> | |
225 <style type="text/css"> | |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
226 .reg |
3
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
227 { |
4
4351c0bf33d4
Improving IGB formatting
Dominic Cleal <dominic@computerkb.co.uk>
parents:
3
diff
changeset
|
228 text-align: center; |
3
e640eb6cefc3
Making DB stuff more generic, fixing missing mineral
Dominic Cleal <dominic@computerkb.co.uk>
parents:
1
diff
changeset
|
229 } |
0 | 230 </style> |
231 </head> | |
4
4351c0bf33d4
Improving IGB formatting
Dominic Cleal <dominic@computerkb.co.uk>
parents:
3
diff
changeset
|
232 |
0 | 233 <body> |
234 <table> | |
235 END | |
236 | |
30
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
237 sub pretty_numbers |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
238 { |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
239 my $num = shift; |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
240 $num = sprintf('%.2f', $num); |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
241 $num = reverse $num; |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
242 $num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
243 return reverse $num; |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
244 } |
d1028107ab75
Pretty numbers function
Dominic Cleal <dominic@computerkb.co.uk>
parents:
29
diff
changeset
|
245 |
10
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
246 my $igb = ($ENV{HTTP_USER_AGENT} =~ /EVE-minibrowser/i); |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
247 |
0 | 248 for my $item (@output) |
249 { | |
250 if ($col == $cols) | |
251 { | |
252 print "</tr><tr>\n"; | |
253 $col = 0; | |
254 } | |
255 | |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
256 my ($img, $text, $link, $colour); |
0 | 257 |
258 if (defined $item->{id}) | |
259 { | |
10
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
260 if ($igb) |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
261 { |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
262 $img = "typeicon:$item->{id}"; |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
263 $link = "showinfo:$item->{id}"; |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
264 } |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
265 else |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
266 { |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
267 $img = "$img_http_path/icons/icons_items_png/64_64/icon$item->{icon}.png"; |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
268 } |
de10d02dc715
Using item images for non-IGB browsers
Dominic Cleal <dominic@computerkb.co.uk>
parents:
9
diff
changeset
|
269 |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
270 switch ($item->{meta}) |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
271 { |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
272 case 0 { $colour = "#666600"; } |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
273 case 1 { $colour = "#777777"; } |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
274 case 2 { $colour = "#BBBBBB"; } |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
275 case 3 { $colour = "#FFFFFF"; } |
23 | 276 case 4 { $colour = "#4444FF"; } |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
277 case 5 { $colour = "#FF0000"; } |
23 | 278 case [6..30]{ $colour = "#00FF00"; } |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
279 } |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
280 |
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
281 if ($item->{meta} >= 4) |
0 | 282 { |
283 $text = $item->{name}; | |
284 } | |
285 else | |
286 { | |
20
877806fb69a3
Fixed double use of var, and added reprocessing details in ALT
df
parents:
18
diff
changeset
|
287 $text = $item->{reprocessIsk}; |
0 | 288 } |
289 } | |
290 else | |
291 { | |
292 $text = 'Unknown item'; | |
5
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
293 $img = "typeicon:07_15"; |
0 | 294 } |
295 | |
22
66a63068fb23
Cleaned up the styles and added colour s on meta level .... the happy colour show.
df
parents:
21
diff
changeset
|
296 print "<td width='64' class='reg'>"; |
5
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
297 print "<a href='$link'>" if defined $link; |
14
9b8670ac1bcc
Adding title attr to images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
13
diff
changeset
|
298 print "<img src='$img' width='64' height='64' border='1' "; |
20
877806fb69a3
Fixed double use of var, and added reprocessing details in ALT
df
parents:
18
diff
changeset
|
299 print "title=\"$item->{name}\" alt=\"$item->{name} ($item->{reprocessDetails})\" />"; |
5
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
300 print "</a>" if defined $link; |
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
301 print "<br />"; |
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
302 print "<font color='$colour'>" if defined $colour; |
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
303 print $text; |
42268fc087a9
Improving IGB integration with links and images
Dominic Cleal <dominic@computerkb.co.uk>
parents:
4
diff
changeset
|
304 print "</font>" if defined $colour; |
0 | 305 print "</td>\n"; |
306 | |
307 $col++; | |
308 } | |
309 | |
310 print<<END; | |
311 </tr> | |
312 </table> | |
313 </body> | |
314 </html> | |
315 END | |
316 |