#!/usr/bin/perl -w

# get-stats.pl
# by mindc

use strict;
use Digest::MD5 qw(md5_hex);
use XML::Simple;
use POSIX qw(strftime);
use Time::HiRes qw(gettimeofday);
use Data::Dumper;
use LWP::UserAgent;
use Getopt::Long qw(:config bundling pass_through);
use Carp;
$|++;

# defaults
my $config_file = 'config.xml',
my $stats_file = 'stats.xml',
my $debug = 0;

my $ua = LWP::UserAgent->new;
$ua->timeout(30);

my $host_cpid = md5_hex(gettimeofday());
my $stats = {};
my $stats_tmp = {};
my $config = {};

GetOptions(
    "c|config=s" => \$config_file,
    "o|output=s" => \$stats_file,
    "d|debug" => \$debug,
    "h|help|usage" => \&usage,
);

usage() if $ARGV[0];

# wymagany plik konfiguracyjny
if ( -r $config_file ) {
    $config = XMLin(
        $config_file,
        KeyAttr => '',
        GroupTags => { projects => 'project' },
        ForceArray => [ 'project' ],
    );
    print Dumper $config if $debug;
} else {
    croak "$config_file $!\n";
}

# odczytanie wcześniej zapisanych danych
if ( -r $stats_file ) {
    $stats = XMLin(
        $stats_file,
        KeyAttr => '',
        GroupTags => { projects => 'project' },
        ForceArray => [ 'project' ],
    );
    print Dumper $stats if $debug;

    $host_cpid = $stats->{host_cpid} || $host_cpid;

    foreach my $project ( @{$stats->{projects}} ) {
        if ( $project->{project_url} ne '' ) {
            $stats_tmp->{$project->{project_url}} = {
                total_credit => $project->{user_total_credit} + 0,
                expavg_credit => $project->{user_expavg_credit} + 0,
                project_url => $project->{project_url},
                project_name => $project->{project_name},
                last_update => $project->{last_update},
                diff_credit => $project->{user_diff_credit} + 0,
                hostid => $project->{hostid},
                request_delay => $project->{request_delay} + 0,
           };
        }
    }
}

print Dumper $stats_tmp if $debug;

# główna pętla
MAIN: foreach my $project ( @{$config->{projects}} ) {
    my $prj_url = $project->{project_url};
    my $prj_email = $project->{account_email} || $config->{account_email};
    my $prj_passwd = $project->{account_passwd} || $config->{account_passwd};
    my $hostid = $stats_tmp->{$prj_url}{hostid} || '';
    my $prj_key;
    my $sch_url;

    if ( ( $prj_email && $prj_passwd ) || $project->{account_key}) {
        print "getting stats from `$prj_url' for `@{[ $project->{account_key} || $prj_email ]}' using `$hostid' as hostid\n" if $debug;
        unless ( $prj_key = ($project->{account_key} || lookup_account($prj_url,$prj_email,$prj_passwd)) ) {
            print STDERR "!!! $prj_url: account key not found\n";
            next MAIN;
        }
    } else {
        print STDERR "!!! $prj_url: project email or password not found, skipped\n";
        next MAIN;
    }

    unless ( $sch_url = $project->{scheduler_url} ||  get_scheduler_url($prj_url) ) {
#        print STDERR "!!! $prj_url: scheduler url not found, skipped\n";
        next MAIN;
    }

    if ( $sch_url && $prj_key ) {
        if ( ( ($stats_tmp->{$prj_url}{last_update} || 0 ) + ( $stats_tmp->{$prj_url}{request_delay} || 0 )) > time ) {
#            print "$prj_url: last request too recent, skipped\n";
            next MAIN;
        }

        if ( my $st = get_stats($sch_url,$prj_key,$hostid,$host_cpid) ) {
            print Dumper $st if $debug;
            $stats_tmp->{$prj_url}{last_update} = time;
            $stats_tmp->{$prj_url}{request_delay} = $st->{request_delay} || 0;
            next MAIN unless $st->{user_total_credit} && $st->{user_expavg_credit};
            $stats_tmp->{$prj_url}{project_name} = $st->{project_name};
            $stats_tmp->{$prj_url}{diff_credit} = $st->{user_total_credit} - ($stats_tmp->{$prj_url}{total_credit} || $st->{user_total_credit});
            $stats_tmp->{$prj_url}{total_credit} = $st->{user_total_credit} + 0;
            $stats_tmp->{$prj_url}{expavg_credit} = $st->{user_expavg_credit} + 0;
            $stats_tmp->{$prj_url}{hostid} = $st->{hostid} if defined $st->{hostid};
            $stats_tmp->{$prj_url}{project_url} = $prj_url;
        } else {
#            print STDERR "!!! $prj_url: cannot get statistics, skipped\n";
            next MAIN;
        }
    }
}

print Dumper $stats_tmp if $debug;

# wyjście

my $out = "<stats>\n";
$out .= "  <host_cpid>$host_cpid</host_cpid>\n";
$out .= "  <projects>\n";

foreach ( sort { uc $stats_tmp->{$a}{project_name} cmp uc $stats_tmp->{$b}{project_name} } keys %$stats_tmp ) {
    if ( defined $stats_tmp->{$_}{project_url} ) {
        $out .= "    <project>\n";
        $out .= "      <project_name>@{[$stats_tmp->{$_}{project_name}]}</project_name>\n";
        $out .= "      <project_url>@{[$stats_tmp->{$_}{project_url}]}</project_url>\n";
        $out .= "      <user_total_credit>@{[$stats_tmp->{$_}{total_credit}]}</user_total_credit>\n";
        $out .= "      <user_expavg_credit>@{[$stats_tmp->{$_}{expavg_credit}]}</user_expavg_credit>\n";
        $out .= "      <user_diff_credit>@{[$stats_tmp->{$_}{diff_credit}]}</user_diff_credit>\n";
        $out .= "      <last_update>@{[$stats_tmp->{$_}{last_update}]}</last_update>\n";
        $out .= "      <hostid>@{[$stats_tmp->{$_}{hostid}]}</hostid>\n";
        $out .= "      <request_delay>@{[$stats_tmp->{$_}{request_delay} + 0]}</request_delay>\n";
        $out .= "    </project>\n";
    }
}

$out .= "  </projects>\n";
$out .= "</stats>\n";

if ( open (my $fh,'>',$stats_file) ) {
    print $fh $out;
    close $fh;
}

exit;

sub get_stats {
    my ($url,$key,$hostid,$host_cpid) = @_;
    $url =~ s!https://secure!http://www!; # obejście World Community Grid

    # wysyłamy zapytanie do schedulera
    # w większości projektów nie trzeba podawać wersji klienta
    # ale POEM i WUProp wymaga tego

    my $req = HTTP::Request->new(POST => $url );
    $req->content_type('application/x-www-form-urlencoded');
    $req->content("<scheduler_request>
<authenticator>$key</authenticator>
<core_client_major_version>6</core_client_major_version>
<core_client_minor_version>10</core_client_minor_version>
<core_client_release>56</core_client_release>
<hostid>$hostid</hostid>
<platform_name>i686-pc-linux-gnu</platform_name>
<host_info>
<host_cpid>$host_cpid</host_cpid>
<domain_name>perl script for personal stats</domain_name>
<os_name>mindc</os_name>
<os_version>1.0</os_version>
<p_vendor>GenuineIntel</p_vendor>
<p_model>Intel(R) Atom(TM) CPU  330   @ 1.60GHz [Family 6 Model 28 Stepping 2]</p_model>
</host_info>
</scheduler_request>
");

    my $res = $ua->request($req);

    if ( $res->is_success ) {
        my $tmp = $res->content;
        $tmp =~ s!<<!<!g; # obejście przy uFluids 
        $tmp =~ s!</scheduler_reply>.*!</scheduler_reply>!s; # obejście przy World Community Grid
        my $cnt;

        print $tmp if $debug;
	$tmp =~ s/&/&amp;/g;
        eval {
            $cnt = XMLin($tmp);
        };

        if ( $@ ) {
            carp "!!! $url: $@";
            carp $tmp;
            return 0;
        }

        if ( exists($cnt->{project_is_down}) ) {
#            warn "!!! $url: Message from server: ".$cnt->{message}{content};
            return 0;
        } else {
            return $cnt;
        }
    } else {
        carp $res->status_line;
        return 0;
    }
}

sub lookup_account {
    my ($url,$email,$passwd) = @_;
    $url =~ s!/$!!;

    # pobieramy uid
    my $res = $ua->get(
    "$url/lookup_account.php?email_addr=$email&passwd_hash=@{[md5_hex($passwd.$email)]}"
    );

    if ( $res->is_success ) {
        my $tmp = $res->content;
        my $cnt;
        eval {
            $cnt = XMLin($tmp);
        };

        if ( $@ ) {
            carp $@;
            return 0;
        }

        # sprawdzamy czy nie było jakiegoś błędu przy identyfikacji
        if ( exists($cnt->{error_msg})) {
#            print STDERR "!!! $url: Message from server: ".$cnt->{error_msg};
            return 0;
        } else {
            return $cnt->{authenticator};
        }

    } else {
        return 0;
    }
}

sub get_scheduler_url {
    my $url = shift;
    my $scheduler_url;
    my $res = $ua->get($url);

    if ( $res->is_success ) {
        # szukanie na głównej stronie projektu adresu schedulera
        ($scheduler_url) = $res->content =~ m'<scheduler>\s*(.*?)\s*</scheduler>';
        return $scheduler_url;
    } else {
    #    warn "!!! $url: ".$res->status_line;
        return 0
    }
}

sub usage {
    print "$0 [-c|--config=FILE] [-o|--output=FILE] [-d|--debug] [-h|--help|--usage]\n\n";
    exit(1);
}