Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re^2: How to emulate queue for CGI script?

by Gangabass (Priest)
on Mar 21, 2011 at 16:33 UTC ( #894565=note: print w/ replies, xml ) Need Help??


in reply to Re: How to emulate queue for CGI script?
in thread How to emulate queue for CGI script?

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; }


Comment on Re^2: How to emulate queue for CGI script?
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://894565]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2014-12-29 05:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (184 votes), past polls