File Coverage

blib/lib/MetaStore.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package MetaStore;
2             #$Id$
3              
4             =head1 NAME
5              
6             MetaStore - Set of classes for multiuser web applications.
7              
8             =head1 SYNOPSIS
9              
10             use MetaStore;
11              
12             =head1 DESCRIPTION
13              
14             MetaStore - Set of classes for multiuser web applications.
15              
16             =head1 METHODS
17              
18             =cut
19              
20 2     2   38944 use Collection;
  0            
  0            
21             use Collection::Utl::Base;
22             use Data::Dumper;
23              
24             use Data::UUID;
25             use strict;
26             use warnings;
27              
28             our @ISA = qw(Collection);
29             our $VERSION = '0.60';
30              
31             attributes qw/ props meta links _sub_ref/;
32              
33             sub _init {
34             my $self = shift;
35             my %args = @_;
36             props $self $args{props};
37             meta $self $args{meta};
38             links $self $args{links};
39             $self->_sub_ref($args{sub_ref}) if ref $args{sub_ref};
40             return 1
41             }
42              
43             sub sub_ref {
44             my $self = shift;
45             if ( my $val = shift ) {
46             $self->_sub_ref($val)
47             }
48             return $self->_sub_ref()
49             }
50              
51             sub _fetch {
52             my $self = shift;
53             my $props_hash_ref = $self->props->fetch(@_);
54             my @ids = keys %$props_hash_ref;
55             my $meta_ref = $self->meta;
56             my $links_ref = $self->links;
57             my $meta_hash_ref = { map { $_=>$meta_ref->get_lazy_object($_) } @ids};
58             my $links_hash_ref = { map { $_=>$links_ref->get_lazy_object($_) } @ids};
59             my %res;
60             foreach my $id ( @ids ) {
61             $res{$id}= {
62             props=>$props_hash_ref->{$id},
63             meta=>$meta_hash_ref->{$id},
64             links=>$links_hash_ref->{$id},
65             }
66             }
67             return \%res;
68             }
69              
70             sub _prepare_record {
71             my ( $self, $key, $ref ) = @_;
72             if ( ref($self->_sub_ref) eq 'CODE') {
73             return $self->_sub_ref()->($key,$ref)
74             } esle {
75             LOG $self "Not defined sub_ref"
76             }
77             return $ref;
78             }
79              
80             sub _delete {
81             my $self = shift;
82             if ( my $ref = $self->fetch(@_) ){
83             $_->delete for values %{ $ref };
84             }
85             $self->props->delete(@_) ;
86             $self->meta->delete(@_) ;
87              
88             }
89             sub create_obj {
90             my $self = shift;
91             my ($id,$props) = @_;
92             return unless my $class = $props->{__class};
93             my $meta_ref = $self->meta->get_lazy_object($id);
94             my $code = qq! new $class\:\: \$props,\$id,\$meta_ref; !;
95             my $ret = eval $code;
96             die ref($self)." die !".$@ if $@;
97             return $ret;
98             }
99              
100             sub fetch_by_guid {
101             my $self = shift;
102             my $guid = shift;
103             my ( $res ) = values %{ $self->fetch({ 'tval'=>$guid}) };
104             return $res;
105             }
106              
107             sub create_object {
108             my $self = shift;
109             my %arg = @_;
110             my $class = $arg{class};
111             my ($meta_obj_id) = keys %{ $self->meta->create(mdata=>'') };
112             $self->props->create($meta_obj_id=>{__class=>$class});
113             my $dummy = $self->fetch_one($meta_obj_id);
114             $dummy->_attr->{guid} = $arg{guid}||$self->make_uuid;
115             return $self->fetch_one($meta_obj_id);
116             }
117              
118             sub _fetch_all {
119             my $self = shift;
120             return $self->fetch( @{ $self->_fetch_all_ids })
121             }
122             sub _fetch_all_ids {
123             my $self = shift;
124             my $all = $self->meta->_fetch_all;
125             $all = [ keys %{$all} ] if ref($all) eq 'HASH';
126             return $all
127             }
128             sub create_item {
129             my $self = shift;
130             my %arg = @_;
131             my $class = $arg{class};
132             my ($meta_obj_id) = keys %{ $self->meta->create(mdata=>'') };
133             my ( $dummy ) = values %{ $self->props->create($meta_obj_id,$class) || {}};
134             return $dummy;
135             }
136              
137             sub commit {
138             my $self = shift;
139             map {
140             $_->store_changed;
141             $_->release_objects;
142             }
143             ( $self->props, $self->meta, $self->links)
144             }
145            
146             sub make_uuid {
147             my $self = shift;
148             my $ug = new Data::UUID::;
149             return $ug->to_string( $ug->create() )
150             }
151              
152             1;
153             __END__