#!C:\Perl64\bin\perl.exe

use strict;
use warnings;
use WWW::Mechanize;
use File::Path;
use Fcntl qw(:DEFAULT :flock);
use FileHandle;
use IO::Handle;
use CGI;

my $q = CGI->new();

my %CONFIG = read_config("Config.cfg");

my $cfiscalf = $q->param("cfiscalf");

my $result = check_cache($cfiscalf);

print $q->header();

unless ($result) {
    
    my $last_request_time = get_request_time();
    my $position = check_queue($cfiscalf);
    
    if ( $position == 1 ) {
    
    if ( time() - $last_request_time > $CONFIG{MIN_DELAY_AFTER_REQUEST
+} ) {
    
        my $mech = WWW::Mechanize->new();
        $mech->credentials( $CONFIG{USERNAME}, $CONFIG{PASSWORD} );
        $mech->get( $CONFIG{URL} );
    
        $mech->submit_form(
        
        form_name => "form1",
        fields => {
            
            cfiscalf => $cfiscalf,
        },
        button => "cauta",
        );
        
        my $firm_name = parse_result( $mech->content() );
        
        if ($firm_name) {
    
        print "<strong>$firm_name</strong>";
        }
        else {
    
        print "<em>Nothing finded... Are you sure enter right number?<
+/em>";
        }
        save_request_time( time() );
    }

    }
    else {
    
    my $estimate_run_time = $position * $CONFIG{MIN_DELAY_AFTER_REQUES
+T};
    
    print "<em>Please wait for " . $estimate_run_time . " seconds and 
+try again...</em>";
    }
}
else {
    
    print "<strong>$result</strong>";
}


sub save_request_time {
    
    my ($time) = @_;
            
    open my $fh, ">", $CONFIG{LAST_REQUEST_FILE} or die $!;
    flock( $fh, LOCK_EX );
    print $fh $time;
    flock( $fh, LOCK_UN );
    close $fh;
}

sub get_request_time {
    
    my ($time);
            
    if ( -e $CONFIG{LAST_REQUEST_FILE} ) {
                              
        open my $fh, "<", $CONFIG{LAST_REQUEST_FILE} or die $!;
        flock( $fh, LOCK_EX );
        chomp( $time = <$fh> );
        flock( $fh, LOCK_UN );
        close $fh;
    }
    else {
        
        $time = 0;
    }
    
    return $time;
}


sub parse_result {
    
    my ($html) = @_;
    
    my ($firm) = $html =~ m{
        
        <td\s+align=center\s+valign=top>1\.</td>\s*
        <td>\s*<a\s+href='calcul\.cgi\?[^']+'>(.+?)</a>
    }isx;
    
    return $firm || "";
}

sub read_config {
    
    my ($filename) = @_;
    my (%CONFIG);
    
    open my $fh, "<:encoding(UTF-8)", $filename or die "Could't read c
+onfig file. $!";
    
    while ( my $line = <$fh> ) {
    
    chomp $line;
    my ( $key, $value ) = split /=/, $line, 2;
    $CONFIG{$key} = $value;
    }    
    close $fh;
    
    return %CONFIG;
}

sub check_cache {
    
    my ($cfiscalf) = @_;
    my %cache;
    
    if ( -e $CONFIG{CACHE} ) {
    
    open my $fh, "<:encoding(UTF-8)", $CONFIG{CACHE} or die "Could't r
+ead cache file. $!";
    flock( $fh, LOCK_EX );

    while ( my $line = <$fh> ) {
        
        chomp $line;
        my ( $cfiscalf, $result ) = split /\t/, $line;
        $cache{$cfiscalf} = $result;
    }
    flock( $fh, LOCK_UN );
    close $fh;
    }
    
    if ( $cache{$cfiscalf} ) {
    
    return $cache{$cfiscalf};
    }
    else {
    
    return undef;
    }
}

sub check_queue {
    
    my ($cfiscalf) = @_;
    my %queue;
    my @queue;
    
    if ( -e $CONFIG{QUEUE} ) {
    
    open my $fh, "<:encoding(UTF-8)", $CONFIG{QUEUE} or die "Could't r
+ead queue file. $!";
    flock( $fh, LOCK_EX );
    
    my $position = 1;
    while ( my $line = <$fh> ) {
        
        chomp $line;
        my ( $cfiscalf, $time ) = split /\t/, $line;
        $queue{$cfiscalf} = {
    
        time => $time,
        position => $position++,
        };
        
        push @queue, {
        
        cfiscalf => $cfiscalf,
        time => $time,
        };
    }
    
    flock( $fh, LOCK_UN );
    close $fh;
    
    if ( time() - $queue[0]->{time} > $CONFIG{MAX_QUEUE_LIVE_TIME} ) {
        
        shift @queue;
        $queue[0]->{time} = time();
    }
    }
    
    unless ( $queue{$cfiscalf} ) {

    my $time = time();
    push @queue, {
        
        cfiscalf => $cfiscalf,
        time => time(),
    };
    
    $queue{$cfiscalf} = {
    
        time => $time,
        position => scalar(@queue) + 1,
    };
    }
    
    save_queue(\@queue);
    
    return $queue{$cfiscalf}->{position};
}

sub save_queue {
    
    my ($queue) = @_;
    
    open my $fh, ">:encoding(UTF-8)", $CONFIG{QUEUE} or die "Could't c
+reate/update queue file. $!";
    flock( $fh, LOCK_EX );

    foreach my $entry ( @{$queue} ) {
    
    print $fh $entry->{cfiscalf}, "\t", $entry->{time}, "\n";
    }
    flock( $fh, LOCK_UN );
    close $fh;
}
[download]