File: MLDBM.pm

package info (click to toggle)
libtm-perl 1.56-7
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 3,692 kB
  • ctags: 1,084
  • sloc: perl: 35,266; makefile: 48
file content (75 lines) | stat: -rw-r--r-- 2,187 bytes parent folder | download | duplicates (2)
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
package TM::Synchronizable::MLDBM;

use Class::Trait 'base';
use Class::Trait 'TM::Synchronizable';

use Data::Dumper;

#use MLDBM qw(MLDBM::Sync::SDBM_File Storable);
use MLDBM qw(DB_File);
use MLDBM::Sync;
use Fcntl qw(:DEFAULT);

=pod

=head1 NAME

TM::Synchronizable::MLDBM - Topic Maps, trait for DBM Storage, synchronous

=head1 DESCRIPTION

This package subclasses L<TM::Synchronizable> with a MLDBM store.  The methods C<source_in> and
C<source_out> do the obvious things of copying between the DBM file and the in-memory
representation. Only during the synchronisation the DBM file is locked. Otherwise the two copies are
independent.  The synchronisation is quite performant, certainly faster than using a text
representation of the map.

=cut

sub source_in {
    my $self = shift;
    my $url  = $self->url;
    $TM::log->logdie (scalar __PACKAGE__ . ": url '$url' is not pointing to a file") unless $url =~ /^file:/;
    (my $filename = $self->url) =~ s/^file://;                                     # get rid of this
#warn "source in  '$filename'";
    my %map;
    my $sync_dbm = tie %map, 'MLDBM::Sync', $filename, O_RDWR|O_CREAT, 0600 or $TM::log->logdie (scalar __PACKAGE__ .": $!");
    $sync_dbm->Lock;
    %{$self} = %{$map{data}};
    $sync_dbm->UnLock;
}

sub source_out {
    my $self = shift;
    my $url  = $self->url;
    $TM::log->logdie (scalar __PACKAGE__ . ": url '$url' is not pointing to a file") unless $url =~ /^file:/;
    (my $filename = $self->url) =~ s/^file://;                                     # get rid of this
#warn "source out  '$filename'";
    my %map;
    my $sync_dbm = tie %map, 'MLDBM::Sync', $filename, O_CREAT|O_RDWR, 0600 or $TM::log->logdie (scalar __PACKAGE__ .": $!");
    $sync_dbm->Lock;
    $map{data} = $self;
    $sync_dbm->UnLock;
}

=pod

=head1 SEE ALSO

L<TM::ResourceAble>, L<TM::Synchronizable>

=head1 AUTHOR INFORMATION

Copyright 200[68], Robert Barta <drrho@cpan.org>, All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl
itself.  http://www.perl.com/perl/misc/Artistic.html

=cut

our $VERSION  = '0.03';
our $REVISION = '$Id$';

1;

__END__