Thread Problem mit FileHandle (24 answers)
Opened by rosti at 2011-04-05 22:27

rosti
 2011-04-05 22:27
#147404 #147404
User since
2011-03-19
3492 Artikel
BenutzerIn
[Homepage]
user image
Hi,

für ein paar Spezialaufgaben brauche ich ein Modul was das hier macht:

Code (perl): (dl )
1
2
3
4

my $file = 'd:/tmp/numbers.bin';
tie my $nr1, 'Number', (-file => $file, -key => 'foo') or die $!;
tie my $nr2, 'Number', (-file => $file, -key => 'bar') or die $!;
print "$nr1 $nr2\n";


Nun bin ich auf CPAN nicht so richtig fündig geworden und habe meine schon etwas angegraute Eigenentwicklung wieder hervorgekramt. Number.pm tut einwandfrei mit einer Nummer, aber manchmal brauche ich mehr als Eine und mit einundderselben Datei will das nicht so richtig klappen. D.h., wenn die Datei frisch angelegt wurde, funktionieren $nr1 und $nr2 bis zum Wert '2', dann läuft nur $nr2 mit -auto => 1 weiter.

Irgendwo ist da ein Denkfehler, könnt Ihr mal gucken?

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

package Number;

use strict;
use warnings;
use IO::File;
use Carp;
use Fcntl ':flock';
use Tie::Scalar;
our @ISA = qw(Tie::StdScalar);

# VARs intern
my $fh = new IO::File;
my %rep = ();            # Repository
my $repkey = undef;      # Pepository Key

# Constructor
sub TIESCALAR{
        my $class = shift;

        my %args = (
                -file => undef,
                -key  => undef,
                -auto => 1,
                @_
        );

        croak "No file, use -file in args!" if not defined $args{-file};
        croak "No key, use -key in args!" if not defined $args{-key};

        deserialize($args{-file}) or return;
        $repkey = $args{-key} || '_default';
        $rep{$repkey} ||= 0;
        $rep{$repkey}++ if $args{-auto} == 1;
        my $nr = $rep{$repkey};
        return bless \$nr, $class;
}

# hash to file
sub serialize{
        if(defined $fh){
                truncate $fh, 0;
                seek $fh, 0, 0;
                while(my ($k, $v) = each %rep){
                        print $fh pack("N", length $k).$k.pack("N", $v);
                }
        }
}

# hash from $file
sub deserialize{
        my $file = shift;
        $fh->open($file, O_CREAT|O_BINARY|O_RDWR) or return;
        flock($fh, LOCK_EX) or die "Your system does not support flock()!";
        binmode $fh, ':raw';
        seek $fh, 0, 0;
        my ($buffer, $key, $klen, $number) = (undef, undef, undef, undef);
        while(read $fh, $buffer, 4){
                $klen = unpack "N", $buffer;
                read $fh, $key, $klen;
                read $fh, $buffer, 4;
                $rep{$key} = unpack "N", $buffer;
        }
        return 1;
}


sub DESTROY{
        serialize();
        undef $fh;
}

###########################################################################
1; ########################################################################
###########################################################################

View full thread Problem mit FileHandle