Thank you for idea. Here is code i have now:
#!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;
}
