why does it behave like this?

Because the locks are merely advisory? As you have not provided an example of your "corrupted/wrongly printed" data we can only guess that some other process isn't honouring the advisory lock.

You may be suffering from buffering, and from misuse of flock. Update: This assertion is incorrect; Perl handles it correctly now.

LOCK_UN unlocks the file, removing the advisory lock before you closed the file. Remember that close flushes the output buffer if there's anything still in it. So it's entirely possible that your lock has been removed before the buffer gets flushed.

The solution is to not call flock($fh, LOCK_UN) or ..., but rather, to call close $fh or ..., at which time the lock will be cleared after flushing.

If this doesn't clear up your problem, then you have another bug in addition to the one demonstrated in the code you provided.

flock:

To avoid the possibility of miscoordination, Perl now flushes FILEHANDLE before locking or unlocking it.

Well goodness, and that's been around awhile, it would seem. :) Thanks.




Dave

Welcome deruytja,

Since your OS is Ubuntu 14.04, you should be able to run the sample script shown here. I just downloaded it and verified that it still works on Debian.

This is more complicated than you need, but without 'flock', this script couldn't run correctly. It manually handles the 'fork's but once you get the methodology of using 'fork' to enable multi-user, multi-tasking, you'll have a lot of fun with this.

I also think there are some examples in the 'Perl Cookbook' and I'm sure more on PM. But I know this one works! Good Luck!

Regards...Ed

As it says in the docs flock :-

locks are merely advisory

Exactly what happens will depend on the operating system you're on, what other process is trying to write to the file, and the exact timing of the writes.

IMHO flock just isn't worth using, it's almost entirely pointless.

IMHO flock just isn't worth using, it's almost entirely pointless.

flock is advisory, that's true. But to conclude that flock is useless is just wrong.

flock won't prevent a malicious (or clueless) other process from damaging a file. But as long as all processes agree on using flock to access the file, no damage will happen. Period. Unless, of course, the file is on NFS or other network filesystems (SMB, AFS, ...). At least some versions of NFS have locking problems, other network filesystems may have them, too.

Alexander

--
Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

... as long as all processes agree on using flock to access the file, no damage will happen. Period. Unless, of course, ...

Unfortunately, Dave, that sounds a lot like Famous Last Words.

---

Give a man a fish:  <%-(-(-(-<

What does "corrupted" mean? I.e. what is the expected output vs. actual output? How do I post a question effectively?

Are there actually multiple programs writing to the file simultaneously? Do you set $,, $\, or $" in your program?

The OS is Ubuntu 14.04, writing to the local filesystem

open ($fh, '>>', $file_out);
$fh->autoflush(1);
print $fh "$date;Site;CTR;IP;Temperature\n";
$i = 0;
#######################Variables for the ForkManager------------------
+------------------->
my $count1 = 0;
my $pm = Parallel::ForkManager->new(50);
$pm->run_on_wait(
    sub    {
        $count1++;
        }, 1
        );
#<---------------------------Variables for the ForkManager############
+####################

foreach my $key_bgtr(sort keys %devices) 
    {
    foreach my $key_ip (keys %{$devices{$key_bgtr}})#
        {
        $i++;        
        $pm->start and next;
        $out[0]=$date.';';
        $out[1]=$devices{$key_bgtr}{$key_ip}.';';
        $out[2]=$key_bgtr.';';
        $out[3]=$key_ip.';';
        for (my $k =2;$k<=3;$k++)
                        {
                        if (!defined $out[$k]) {$out[$k] = './.'}
                        }
        $ss =  Net::SNMP->session(Hostname=> $key_ip, Timeout => 1);
        
        $out[4] = $ss->get_request(Varbindlist => [$oid]);
        $out[4]= $out[4]->{$oid};
        if (defined $out[4] && $out[4] !~ /^$|\s/ && $out[4] >=5)
            {
            $out[4] = "$out[4]\n";
            }
        else
            {
            $error = $ss->error();
            if ($error =~ /.*noSuchName.*/)
                {
                $out[4]="no ALCplus2e\n";
                }
            else
                {
                $out[4]="OFFLINE\n";
                }
            print $log "$key_bgtr: $error \n";
            }
        
flock($fh, LOCK_EX) or die "cannnot lock file - $!\n";
            print $fh @out;
            #print $fh $out[0]; #Datum
            #print $fh $out[1]; #Site ID
            #print $fh $out[2]; #BGTR/Link ID
            #print $fh $out[3]; #IP Adresse
            #print $fh $out[4]; #Temperature
flock($fh, LOCK_UN) or die "cannnot unlock file - $!\n";
        $ss->close;
        $pm->finish;
        }
    }
close $fh;
[download]

The output should look like this:

"2015-06-23_16:57;124124124;123123123B;10.80.80.70;43"

But if printed value by value I sometimes get something like this:

"2015-06-23_16:57;2015-06-23_16:57;124124124;123123123B;10.80.80.70;43456456456;457457457B;10.81.81.71;43"

as if 2 forks could print to the fh, regardless of the lock on it

From the man page of flock(2) on Linux, the file descriptors created by fork(2) are considered to be the same instance, as if you were calling flock on the same file descriptor in the same process.

The solution would be to open the file after $pm->start, and close it before $pm->finish, so that flock(2) will consider it as a different file descriptor.

as if 2 forks could print to the fh, regardless of the lock on it

This is exactly how it works. Manpage:

Locks created by flock() are associated with an open file table entry. This means that duplicate file descriptors (created by, for example, fork(2) or dup(2)) refer to the same lock, and this lock may be modified or released using any of these descriptors... Subsequent flock() calls on an already locked file will convert an existing lock to the new lock mode.

If you don't understand this stuff - descriptors, file table entries - don't worry... the short answer is: yes, forks do that.

G'day deruytja,

"I've already "played" a bit with the flock system in Perl, ..."

I'm not addressing your question directly. This is just additional information that I recalled having bookmarked and thought might be useful for you.

Here's a series of twelve pages starting with: File Locking Tricks and Traps. This forms part of the much larger Classes and Talks by Mark Jason Dominus.

Update: Small changes applied to the two examples.

Having each worker obtain the file handle will do the trick. The + is not necessary in this context but needed for LOCK_SH. Thus, I typically open flock handles in read and write mode.

open ($fh, '+>>', $file_out);

flock($fh, LOCK_EX) or die "cannnot lock file - $!\n";
            print $fh @out;
            #print $fh $out[0]; #Date
            #print $fh $out[1]; #Site
            #print $fh $out[2]; #CTR
            #print $fh $out[3]; #IP 
            #print $fh $out[4]; #Temperature
flock($fh, LOCK_UN) or die "cannnot unlock file - $!\n";

close $fh;
[download]

Below is an example using MCE::Loop. Calling MCE->print passes data to the manager process to append to the file. Locking is handled automatically behind the scene.

use Net::SNMP;
use MCE::Loop;

# ... acquire devices and log handle

open ($fh, '>>', $file_out);
print $fh "$date;Site;CTR;IP;Temperature\n";

MCE::Loop::init( chunk_size => 1, max_workers => 50 );

mce_loop {
    my $key_bgtr = $_;
    my @out;

    foreach my $key_ip (keys %{$devices{$key_bgtr}})
        {
        $out[0]=$date.';';
        $out[1]=$devices{$key_bgtr}{$key_ip}.';';
        $out[2]=$key_bgtr.';';
        $out[3]=$key_ip.';';

        for (my $k =2;$k<=3;$k++)
            {
            if (!defined $out[$k]) {$out[$k] = './.'}
            }

        $ss =  Net::SNMP->session(Hostname=> $key_ip, Timeout => 1);

        $out[4] = $ss->get_request(Varbindlist => [$oid]);
        $out[4]= $out[4]->{$oid};

        if (defined $out[4] && $out[4] !~ /^$|\s/ && $out[4] >=5)
            {
            $out[4] = "$out[4]\n";
            }
        else
            {
            $error = $ss->error();
            if ($error =~ /.*noSuchName.*/)
                {
                $out[4]="no ALCplus2e\n";
                }
            else
                {
                $out[4]="OFFLINE\n";
                }
            MCE->print($log, "$key_bgtr: $error\n");
            }

        MCE->print($fh, @out);
        $ss->close;
        }

    } keys %devices;

close $fh;
[download]

The following example outputs orderly if processing sorted keys is desired. Each worker must gather regardless if @out is empty or not. The manager process needs the $chunk_id value for ordered output.

use Net::SNMP;
use MCE::Loop;
use MCE::Candy;

# ... acquire devices

open ($fh, '>>', $file_out);
print $fh "$date;Site;CTR;IP;Temperature\n";

MCE::Loop::init(
    chunk_size => 1, max_workers => 50,
    gather => MCE::Candy::out_iter_fh($fh)
    );

mce_loop {
    my ($mce, $chunk_ref, $chunk_id) = @_;
    my $key_bgtr = $chunk_ref->[0];
    my @out;

    foreach my $key_ip (keys %{$devices{$key_bgtr}})
        {
        $out[0]=$date.';';
        $out[1]=$devices{$key_bgtr}{$key_ip}.';';
        $out[2]=$key_bgtr.';';
        $out[3]=$key_ip.';';

        for (my $k =2;$k<=3;$k++)
            {
            if (!defined $out[$k]) {$out[$k] = './.'}
            }

        $ss =  Net::SNMP->session(Hostname=> $key_ip, Timeout => 1);

        $out[4] = $ss->get_request(Varbindlist => [$oid]);
        $out[4]= $out[4]->{$oid};

        if (defined $out[4] && $out[4] !~ /^$|\s/ && $out[4] >=5)
            {
            $out[4] = "$out[4]\n";
            }
        else
            {
            $error = $ss->error();
            if ($error =~ /.*noSuchName.*/)
                {
                $out[4]="no ALCplus2e\n";
                }
            else
                {
                $out[4]="OFFLINE\n";
                }
            MCE->print($log, "$key_bgtr: $error\n");
            }

        $ss->close;
        }

        MCE->gather($chunk_id, join('', @out));

    } sort keys %devices;

close $fh;
[download]

Kind regards, Mario