Mercurial > hg > reproctool-df

view reproctool.cgi @ 34:2709fae95b1e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added help text.
author df
date Sun, 25 Jan 2009 18:43:30 +0000
parents a4197a854e79
children 558b63789352
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>
Welcome to the sell, reprocess or keep tool. :)
<p />
Here's a <a href="http://rammsrdi.com/img/reproctool.png">screenshot</a>
on how it looks in game.
<p />
Mineral prices below are empire averages from <a
href="http://www.eve-central.com/">Eve-central</a>. Usually you dont need to
update those yourself, unless the Eve central is down, or you live in
special area's and are not welcome in empire space anymore.
<p />
How does this work? Well, you need to copy paste an item list (text) in the
input box below. Then press submit. Getting this item list from our
inventory is simple, albeit unusual. Follow these steps:
<ol>
    <li>Put all the items in a container in your station</li>
    <li>Richt click to container and select 'Create contract'.</li>
    <li>Click 'Next' and then again 'Next'.</li>
    <li>A popup will appear which will list the items in the container!
    Richt click the text area of the popup, and select 'Copy'.</li>
    <li>Cancel the contract creation! (We only needed the item list, there
    is no contract needed.</li>
    <li>Paste the text you just copied in the text box below, and click
    'Submit'.</li>
    <li>The page will take some seconds to load, be patient. If the server
    gives you an error, you just copy pasted too many items. Try again with
    half the list.</li>
</ol>
<p />
Tip: Set the number of columns to match your inventory columns for easy comparison.
<p />
<hr>
<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>
</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>
Welcome to the sell, reprocess or keep tool. :)
<p />
Here is how it works, the colour coding:
<ul>
    <li>Items in <font color='#666600'>dark yellow</font> are meta 0.</li>
    <li>Items in grey to white are meta 1, 2 or 3.</li>
    <li>Items in <font color='#4444FF'>blue</font> are meta 4.</li>
    <li>Items in <font color='#FF0000'>red</font> are T2 (meta 5).</li>
    <li>items in <font color='#00FF00'>green</font> are above meta 5.</li>
</ul>
<p />
The number below the item represents the itemvalue if you would reprocess
and sell the minerals on the market. Basicly, if you have the option of
selling that item for a price below that number, its better to keep the item
and reprocess it.
<p />
As you might see, the items are listed just like your inventory in Eve. The
sorting is the same as when you sort by type. If you have this browser
window next to your inventory window, matching the colums(!), it is very
easy to pick out those valuable items.
<p />
Tip: Because this can be a huge page to load in eve, resising might freeze the
game a bit.<br />
Also, clickin on the item gives you the general information of that item. It
is not the same as clicking 'Show info' on the real item. (For example: the
real item might be damanged.)<br />
<a href="http://rammsrdi.com">Ramm's RDI</a>.
<p />
<hr>
<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 = pretty_numbers($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