package Livescore;
use strict;
use WWW::Mechanize;
use IO::Handle;
STDOUT->autoflush(1);

$SIG{"ALRM"} = sub {};

use constant {
    PRED_VYKOPEM => 0,
    PROBIHA => 1,
    UKONCEN => 2,
};

#konstruktor
sub new {
    my($self, $liga, $refresh) = @_;
    my $f = {};
    bless $f;
    $f->{"liga"} = $liga;
    $f->{"refresh"} = (int $refresh < 30) ? 30 : $refresh;
    return $f;
}

#vyextrahuje ze staženého souboru data o zápasech dané ligy
sub ziskej_zapasy_dane_ligy {
    my($self) = @_;
    my @zapas;              #bude obsahovat informace o zápasech
    my($mesic, $den, $cas);
    my($zeme,$soutez);
    my $zdroj = $self->ziskej_zdrojovy_kod($self->{"liga"});

    #rozdělíme zdrojový kód na řádky
    my $i=0;
    my @radek;
    $radek[$i++] = $1 while $zdroj =~ /(<tr.*?>.*?<\/tr>)/g;

    #každý řádek postupně prozkoumáme a zjistíme, zda neobsahuje nějaká pro nás zajímavá data
    for (@radek){
        #budou nám data k něčemu užitečná? - tedy jedná se řádek obsahující informaci o zápase, jménu soutěže nebo času výkopu?
        if ($_ =~
                /(?:<tr bgcolor=\"#......\"><td(?:[^>]*)>&nbsp;(?:<(i)mg[^>]*> )?([\w\:.]*)'?<\/td><td(?:[^>]*)>(.[^<]*)<\/td><td(?:[^>]*)>(?:\<a class=\"scorelink\" target=\"match_details\" onclick=\"window.open\('','match_details','width=400,height=\d*,menubar=no,status=no,location=no,toolbar=no,scrollbars=no,resizable=yes'\)\" href=\"\/default.dll\/Game\?comp=(\w*)&game=(\d*)\">)?([?\d]+) - ([?\d]+)(?:<\/a>)?<\/td><td width=\"118\">(.[^<]*)<\/td><\/tr>)|(?:<tr bgcolor=\"#......\"><td class=\"title\" colspan=\"4\" height=\"18\">&nbsp;<b>([^<]*)<\/b> - ([^<]*)<\/td><\/tr>)|(?:<tr bgcolor=\"#......\"><td class=\"match-light\" width=\"45\" height=\"18\">&nbsp;([^<]*)?<\/td><td class=\"match-light\" align=\"right\" width=\"286\" colspan=\"3\">(\w+) (\d+)&nbsp;<\/td><\/tr>)/g){
            #narazili jsme na řádek se zápasem
            if($2){
                my $hraje_se;
                my $minuta=$2;
                my $tym1 = $3;
                my $tym2 = $8;
                my $skore1 = $6;
                my $skore2 = $7;
                my $liga = $4;
                my $id = $5;
                $tym1 =~ s/(&amp;)/&/;
                $tym2 =~ s/(&amp;)/&/;

                if($skore1 eq "?"){$skore1 = $skore2 = "-";}
                if($minuta =~ /^\d\d:\d\d$/){$cas = $minuta; $minuta="--";}

                if   ($minuta eq "AET"){$minuta = "OT";}
                elsif($minuta eq "Pen."){$minuta= "PN";}
                elsif($minuta eq "Postp."){$minuta= "XO";}
                elsif($minuta eq "Susp."){$minuta= "XS";}
                else{$minuta = $minuta;}

                if($1 eq "i"){$hraje_se = PROBIHA;}
                elsif($minuta eq "--"){$hraje_se = PRED_VYKOPEM;}
                else{$hraje_se = UKONCEN;}

                push(@zapas, {
                    "tym1"         => $tym1,
                    "tym2"         => $tym2,
                    "skore1"       => $skore1,
                    "skore2"       => $skore2,
                    "liga"         => "$zeme: $soutez",
                    "odkaz_liga"=> $liga,
                    "odkaz_idzapasu" => $id,
                    "minuta"       => $minuta,
                    "vykop"        => $den ? "$den.$mesic $cas" : "KONEC",
                    "hraje_se"     => $hraje_se
                });
            }

            #narazili jsme na řádek se jménem soutěže
            elsif($9){
                $zeme = $9;
                $soutez = $10;
            }

            #narazili jsme na řádek s časem výkopu
            elsif($12){
                $cas = $11;
                $mesic = $12;
                $den = $13;

                $mesic eq "January" and $mesic=1;
                $mesic eq "February" and $mesic=2;
                $mesic eq "March" and $mesic=3;
                $mesic eq "April" and $mesic=4;
                $mesic eq "May" and $mesic=5;
                $mesic eq "June" and $mesic=6;
                $mesic eq "July" and $mesic=7;
                $mesic eq "August" and $mesic=8;
                $mesic eq "September" and $mesic=9;
                $mesic eq "Octomber" and $mesic=10;
                $mesic eq "November" and $mesic=11;
                $mesic eq "December" and $mesic=12;
            }
        }
    }
    return @zapas;
}

#na základě přijatých zápasů a kritérií vrátí pouze zápasy vyhovující těmto kritériím
sub najdi_zapas_podle_kriterii {
    my($self, $p_zapasy, $p_kriteria) = @_;
    my @vyhovujici;

    #nebyla zadána kritéria
    return @$p_zapasy if scalar @$p_kriteria == 0;

    #pokud zápas vyhovuje všem kritériím, přidáme ho k vyhovujícím zápasům
    my $eval = 'if(/'.join("/i and /", @$p_kriteria).'/i){push @vyhovujici, $zapas;}';
    foreach my $zapas (@$p_zapasy){
       $_ = $zapas->{"tym1"}."-".$zapas->{"tym2"};
       eval $eval;
    }

    return @vyhovujici;
}

#vrátí detailní informaci o zápase
sub prenos {
    my($self, $liga, $odkaz_idzapasu) = @_;
    my $tym;
    my $strelec;
    my $zdroj = $self->ziskej_zdrojovy_kod($liga, $odkaz_idzapasu);
    my @udalost;
    my $i = 0;

    my($hraje_se, $probihajici_minuta, $domaci, $hoste) = ($zdroj =~ /<font[^>]*><b>(?:<(i)mg[^>]*>)?\s?([\w\:.]*)'?<\/b><\/font><\/td><td[^>]*>([^[]*)\s\[[^\]]*\]\s([^<]*)<\/td>/);
    $hraje_se = ($hraje_se ? 1 : 0);

    while ($zdroj =~
                 /
                 <tr[^>]*><td[^>]*>
                 (\d+)'                       #minuta události
                 <\/td><td[^>]*><b>
                 (?:\[(\d+)\s?-\s?(\d+)\])?   #nové skóre
                 <\/b><\/td>

                 #událost domácích - buď je nebo není
                 <td[^>]*>
                 (?:([^<]*)\s<img\ssrc="http:\/\/www1.livescore.com\/img\/([\w-]+)\.gif"[^>]*>)?
                 <\/td>   #typ události


                 #událost hostů - buď je nebo není
                 <td[^>]*>
                 (?:([^<]*)\s<img\ssrc="http:\/\/www1.livescore.com\/img\/([\w-]+)\.gif"[^>]*>)?
                 <\/td>   #typ události

                 <td\swidth=4><\/td><\/tr><tr><td\scolspan=\"4\"\swidth=\"400\"\sheight=\"1\"><\/td><\/tr>
                 /gx){

        #domácí mají událost
        if($4){
            $tym = $domaci;
            $strelec = ($4 ? $4 : "neznamy strelec");

            $udalost[$i++] = {
                "id_udalosti" => $i-1,
                "udalost" => $5,
                "minuta" => $1,
                "hrac" => $strelec,
                "tym" => $tym,
                "skore1" => $2,
                "skore2" => $3
            }
        }

        #hosté mají událost
        if($6){
            $tym = $hoste;
            $strelec = ($6 ? $6 : "neznamy strelec");

            $udalost[$i++] = {
                "id_udalosti" => $i-1,
                "udalost" => $7,
                "minuta" => $1,
                "hrac" => $strelec,
                "tym" => $tym,
                "skore1" => $2,
                "skore2" => $3
            }
        }
    }
    return ($probihajici_minuta, $hraje_se, \@udalost);
}


sub ziskej_zdrojovy_kod {
    my($self, $liga, $odkaz_idzapasu) = @_;
    my $url;
    my $cil;
    my $zdroj = undef;
    local $/ = "";

    if ($odkaz_idzapasu){
        $url = "http://www.livescore.com/default.dll/Game?comp=$liga&game=$odkaz_idzapasu";
        $cil = "/tmp/livescore_".$liga."_".$odkaz_idzapasu;
    }else{
        $url = "http://www.livescore.com/default.dll?page=$liga";
        $cil = "/tmp/livescore_$liga";
    }
    if (-e $cil and time() - (stat($cil))[9] <= $self->{"refresh"}){
        open(R, $cil) or die "Nelze otevrit datovy soubor\n";
        $zdroj = <R>;
        close R;
    }else{
        unlink $cil;
        my $mech = WWW::Mechanize->new();
        $mech->get($url);
        $zdroj = ($mech->get($url))->{'_content'};
        open(W, ">$cil") or die "Nelze otevrit datovy soubor\n";
        print W $zdroj;
        close W;

	chmod 511, $cil;
    }
    return $zdroj;
}

1;

__END__