Thread Problem mit FileHandle
(24 answers)
Opened by rosti at 2011-04-05 22:27
Lieber Topeg,
ein herzliches Dankeschön für Deine Unterstützung. Ich bin schon am Tippen und es zeichnet sich ab, dass es doch was wird mit Storable. An eval habe ich auch gleich gedacht, ich werde es so machen und on $@ eine {} zurückgeben ;) Und wieder ein schönes altes Modul neu entdeckt! Viele Grüße aus Oppenheim, Rolf Edit: Wer Lust und Laune hat, Modul untenstehend ;) LOCK_EX funktioniert einwandfrei. Code (perl): (dl
)
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 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 package Numbers; use strict; use warnings; use IO::File; use Carp; use Fcntl ':flock'; use Tie::Hash; our @ISA = qw(Tie::StdHash); use Storable qw(fd_retrieve store_fd); # VARs intern my $fh = new IO::File; # LOCK_EX my $init = 0; # Constructor sub TIEHASH{ my $class = shift; my $ref = shift or return; croak "No ref HASH in Arg" if ref $ref ne 'HASH'; croak "No file is given, use {-file => \$file} in Args" if not exists $ref->{-file}; my $self = _initialize($ref->{-file}) or return; # IO-Error # apply autoincrement for custom keys like 'foo', 'bar' if(exists $ref->{-auto}){ if(ref $ref->{-auto} eq 'ARRAY'){ foreach my $k(@{$ref->{-auto}}){ $self->{$k}++; } } else{ carp "Second Arg must be a ARRAY-Ref ['foo','bar']" } } return bless $self, $class; } # hash from $file sub _initialize{ my $file = shift; return if $init == 1; $init = 1; $fh->open($file, O_CREAT|O_BINARY|O_RDWR) or return; flock($fh, LOCK_EX) or carp "Your system does not support flock()!"; binmode $fh, ':raw'; my $ref = {}; eval { $ref = fd_retrieve($fh) }; # caught exception: file is void if($@){ return {} } else { return $ref } } # hash to file sub _serialize{ my $ref = shift; seek $fh, 0, 0; truncate $fh, 0; store_fd($ref, $fh); undef $fh; } # Overload method, make sure that value is numeric sub STORE{ my $self = shift; my $key = shift; my $value = shift; if($value =~ /^\d+$/){ $self->{$key} = $value; } else{ carp "Value is not numeric"; } } sub DESTROY{ my $self = shift; _serialize($self); } ########################################################################### 1; ######################################################################## ########################################################################### package main; my $file = 'd:/tmp/storednumbers.bin'; tie my %h, 'Numbers', {-file => $file, -auto => ['foo','bar']} or die $!; foreach my $k(keys %h){ print "$k => $h{$k}\n"; } Last edited: 2011-04-06 22:17:32 +0200 (CEST) |