cypress has asked for the wisdom of the Perl Monks concerning the following question:

Two questions today from another valiant but ignorant novice --- with thanks in advance!

1 Given the following code, how do I use Perl's flock function to exclusively lock "file" (comprised of a list of fund tickers) so that, while subroutine "process" reads from "file" and executes, the user can't mangle "file" via subroutine "alter_file"?

2 Should "process" hang for some unknown reason, how can the user terminate whatever processs(es) UserAgent "$html_source" is executing? (Exact SIG code much appreciated.) 

use Tk;
use LWP::Simple;
use LWP::UserAgent;
use FileHandle;

$mw = MainWindow -> new;what
$screw = $mw -> Button ( -text => "screw up ticker file", 
   -command => [ \&alter_file ] ) -> pack;
$go = $mw -> Button ( -text => "go", 
   -command => [ \&process ] ) -> pack;
$stop = $mw -> Button ( -text > "stop", 
   -command => [ \&stop_process ] ) -> pack;

$html_source = new LWP::UserAgent;

MainLoop;


sub alter_file {
    open ( HANDLE1, "+< file" );  #  OPEN FOR READ/WRITE
    while ( <HANDLE1> ) {
        chop; chop; chop;  #  SCREW UP file
    }
    close HANDLE1;
}

sub process {
    open ( HANDLE2, "< file" );  #  OPEN FOR READ-ONLY

    #  WANT TO LOCK HANDLE2 SO THAT USER CAN'T SCREW UP file WHILE 
    #  THE FOLLOWING CODE EXECUTES

    while ( <HANDLE2> ) {
        $html_source -> get ( "http://quicktake.morningstar.com/
             FundNet/Snapshot.aspx?Symbol=$_" );
        #  DO WHATEVER WITH $html_source CONTENT
    }
    close HANDLE2;
}

sub stop_process {
    #  WANT TO SIGNAL USERAGENT $html_source TO STOP (OR DESTROY?) 
    #  ITSELF
    #  (AS A SIDE QUESTION: ASSUMING IT'S STILL OPEN, HOW WOULD I 
    #  THEN CLOSE HANDLE2?)
}

[download]

Replies are listed 'Best First'.
Re: Two questions on interprocess communication
by pc88mxer (Vicar) on Apr 27, 2008 at 20:22 UTC
    Try this: 
    use Fcntl ':flock';
sub alter_file {
  open(HANDLE1, ...);
  flock(HANDLE1, LOCK_EX)  # exclusive lock
    or die "unable to obtain lock: $!";
  chop; chop; chop;
  close(HANDLE); # also releases lock
}

sub process {
  open(HANDLE2, ...);
  flock(HANDLE2, LOCK_SH)    # shared lock - allows multiple readers
    or die "unable to obtain shared lock: $!";
  ...read from file...
  close(HANDLE2);  # also releases lock
}

    [download]
    Note: The flock call will block until the lock can be acquired.

    Another approach which may work for you is to use an atomic operation to replace the contents of file: 

    sub alter_file {
  open(HANDLE1, ">/some/tmp/file");
  ...write to HANDLE1...
  close(HANDLE1);
  rename("/some/tmp/file", "file");
}

    [download]
    In this case no call to flock is needed in the process subroutine. Other processes accessing file may not always get the latest version of the file, but once they open file the contents won't change on them.
[reply]
[d/l]
[select]
Re: Two questions on interprocess communication
by zentara (Cardinal) on Apr 28, 2008 at 14:36 UTC
    I don't quite understand your question, but one obvious way is to set a flag variable, and prevent modification of the file if the flag is set.

    As far as running LWP and being able to cancel it, it probably is best to run the following "callback enhanced" LWP, so you can stop it at any time. In order to avoid blocking the Tk loop, run the sub in a separate thread, and use a shared variable to cancel it's running at a clever spot. 

    sub get_a_file {

    # don't buffer the prints to make the status update
    $| = 1;

    #from lwpcook
    use LWP::UserAgent;
    my $ua       = LWP::UserAgent->new;
    my $URL      = 'http://zentara.net/zentara1.avi';
    my $filename = substr( $URL, rindex( $URL, "/" ) + 1 );

    #print "$filename\n";
    open( IN, ">$filename" ) or die $!;

    my $expected_length;
    my $bytes_received = 0;
    my $res            = $ua->request(
        HTTP::Request->new( GET => $URL ),
        sub {
            my ( $chunk, $res ) = @_;
            $bytes_received += length($chunk);
            unless ( defined $expected_length ) {
                $expected_length = $res->content_length || 0;
            }
            if ($expected_length) {
                $progress = 100 * $bytes_received / $expected_length;
                printf "%d%% - ", 100 * $bytes_received / $expected_le
+ngth;
            }

            print "$bytes_received bytes received\n";

            # XXX Should really do something with the chunk itself
            print IN $chunk;

        }
    );

    print $res->status_line, "\n";
    close IN;
}

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]

Back to Seekers of Perl Wisdom