1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
package Number; use strict; use warnings; use IO::File; use Fcntl ':flock'; use Cwd; sub new{ my $class = shift; my $self = bless{}, $class; return eval{ my $file = $class.".pm"; $self->{POS} = tell DATA; $self->{BUF} = ''; read DATA, $self->{BUF}, 32; $self->{NR} = unpack "A32", $self->{BUF}; $self->{FH} = new IO::File; my $dir = getcwd(); $self->{FH}->open("$dir/$file", O_RDWR) or die "IO-Error: $!"; flock $self->{FH}, LOCK_EX or warn "Your system does not support flock"; $self; }; } sub nr{ my $self = shift; return $self->{NR}++; } sub DESTROY{ my $self = shift; $self->{FH}->seek($self->{POS}, 0); $self->{FH}->print(pack "A32", $self->{NR}); } 1; __DATA__ 124
Quotedu liest den zähler aus der datei, bevor du sie dann nochmal öffnest und lockst. race condition,
Quoteden pfad gäbe übrigens leichter mit $INC{'Number.pm'}.
Quotewenn die datei gerade geschrieben wird und ein anderer prozess das modul mit use lädt,
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
sub new{ my $class = shift; my $self = bless{}, $class; return eval{ my $file = $class.".pm"; $self->{POS} = tell DATA; $self->{BUF} = ''; $self->{FH} = new IO::File; $self->{FH}->open($INC{$file}, O_RDWR) or die "IO-Error: $!"; flock $self->{FH}, LOCK_EX or warn "Your system does not support flock"; $self->{FH}->seek($self->{POS}, 0); read $self->{FH}, $self->{BUF}, 32; $self->{NR} = unpack "A32", $self->{BUF}; $self; }; }
2012-12-31T20:29:14 rostiQuotewenn die datei gerade geschrieben wird und ein anderer prozess das modul mit use lädt,
Dürfte nicht passieren, wenn die .pm gerade geschrieben wird, ist sie gelockt.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
$ perl -wE'
open my $fh, "<", "foo" or die $!;
while (<$fh>) {
print $_;
sleep 1;
}
say "end";' &
[2] 15475
$ test1
test2
perl -pi -e 's/test/TEST/' foo
test3
$ test4
test5
test6
test7
test8
test9
test10
test11
end
Quoteuse kümmert sich nicht darum, ob ein flock gesetzt ist.
1
2
3
4
5
D:\home\netsh100633\html\cgi-bin>number.pl
Number.pm did not return a true value at D:\home\netsh100633\html\cgi-bin\number
.pl line 5.
BEGIN failed--compilation aborted at D:\home\netsh100633\html\cgi-bin\number.pl
line 5.
1
2
3
4
5
6
7
8
9
10
11
$ cat Number.pm
package Number;
1;
$ perl -wE'
open my $fh, "+<", "Number.pm" or die $!;
use Fcntl qw/ :flock /;
flock $fh, LOCK_EX;
<STDIN>;' &
$ perl -wE'use Number'
$
2013-01-01T18:20:36 pqkommt da noch was?
1
2
3
4
5
D:\home\netsh100633\html\cgi-bin>number.pl
Number.pm did not return a true value at D:\home\netsh100633\html\cgi-bin\number
.pl line 5.
BEGIN failed--compilation aborted at D:\home\netsh100633\html\cgi-bin\number.pl
line 5.
1
2
3
4
Number.pm did not return a true value at D:\home\netsh100633\html\cgi-bin\number.pl line 2.
BEGIN failed--compilation aborted at D:\home\netsh100633\html\cgi-bin\number.pl line 2.
Prozess beendet mit Exit-Code 13
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
package Number; use strict; use warnings; use IO::File; use Fcntl ':flock'; sub new{ my $class = shift; my $self = bless{}, $class; return eval{ my $file = $class.".pm"; $self->{POS} = tell DATA; $self->{BUF} = ''; $self->{FH} = new IO::File; $self->{FH}->open($INC{$file}, O_RDWR) or die "IO-Error: $!"; flock $self->{FH}, LOCK_EX or warn "Your system does not support flock"; $self->{FH}->seek($self->{POS}, 0); read $self->{FH}, $self->{BUF}, 32; $self->{NR} = unpack "A32", $self->{BUF}; $self; }; } sub nr{ my $self = shift; return $self->{NR}++; } sub DESTROY{ my $self = shift; $self->{FH}->seek($self->{POS}, 0); $self->{FH}->print(pack "A32", $self->{NR}); } 1; __DATA__ 2056
1 2 3 4 5 6 7 8 9
#!/usr/bin/perl use strict; use warnings; use Number; my $no = new Number; sleep 100;
1
2
3
4
5
6
$ uname -a
Linux iggy 2.6.32-5-amd64 #1 SMP Sun Sep 23 10:07:46 UTC 2012 x86_64 GNU/Linux
$ perl -v
This is perl, v5.10.1 (*) built for x86_64-linux-gnu-thread-multi
(with 59 registered patches, see perl -V for more detail)
2013-01-01T20:22:01 pqich nehme an, das ist was windows-spezifisches. evtl. tritt der effekt dort sogar ohne flock auf.
Quotespasselhalber wäre noch interessant, was bei LOCK_SH statt LOCK_EX passiert.
2013-01-01T19:22:55 rostiDas sind keine Behauptungen, sondern die Fakten.
1
2
3
C:>perl number.pl
Number.pm did not return a true value at number.pl line 5.
BEGIN failed--compilation aborted at number.pl line 5.
2013-01-01T19:44:08 rostiSei sogut, teste den Code
QuoteDann schau Dir die Ergebnisse an, die ich dazu liefere. Und dann vergleiche meine Ergebnisse mit Deinen Ergebnissen.
2012-12-31T20:34:44 pquse kümmert sich nicht darum, ob ein flock gesetzt ist.
2012-12-31T22:05:04 pqgibs doch zu, du wolltest nur den letzten thread fürs jahr eröffnen!
2012-12-31T21:46:31 rostiPS/Edit: Mails vom POP3 holt mein Perl-Mailclient und speichert die als Datei mit einer fortlaufenden Nummer. Beim 'Aufräumen' hatte ich versehentlich die Counter-Datei gelöscht... naja, und wer löscht schon eine .pm-Datei ;)
2013-01-01T12:27:07 rostiBTW., die Idee ist nur für den Hausgebrauch tauglich, wenn der Hausmeister selbst dafür sorgt, dass keine RaceConditions auftreten. Ein LOCK_EX ist der Killer für use ;)
2013-01-01T17:15:36 rosti[...] dafür aber einen Workaround.
eval "use Number";
Der fatale Fehler wird abgefangen. Falls in $@ was drinsteht, läuft die main in eine Warteschleife, until($@ eq ''); dann kann das Object erstellt werden.