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

rosti
 2011-04-06 20:01
#147437 #147437
User since
2011-03-19
3492 Artikel
BenutzerIn
[Homepage]
user image
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)

View full thread Problem mit FileHandle