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