| MetaStore documentation | Contained in the MetaStore distribution. |
MetaStore - Set of classes for multiuser web applications.
use MetaStore;
MetaStore - Set of classes for multiuser web applications.
WebDAO, README
Zahatski Aliaksandr, <zag@cpan.org>
Copyright (C) 2005-2008 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.
| MetaStore documentation | Contained in the MetaStore distribution. |
package MetaStore; #$Id: MetaStore.pm 927 2010-12-22 14:53:53Z zag $
use Collection; use Collection::Utl::Base; use Data::Dumper; use Data::UUID; use strict; use warnings; our @ISA = qw(Collection); our $VERSION = '0.53'; attributes qw/ props meta links _sub_ref/; sub _init { my $self = shift; my %args = @_; props $self $args{props}; meta $self $args{meta}; links $self $args{links}; $self->_sub_ref($args{sub_ref}) if ref $args{sub_ref}; return 1 } sub sub_ref { my $self = shift; if ( my $val = shift ) { $self->_sub_ref($val) } return $self->_sub_ref() } sub _fetch { my $self = shift; my $props_hash_ref = $self->props->fetch(@_); my @ids = keys %$props_hash_ref; my $meta_ref = $self->meta; my $links_ref = $self->links; my $meta_hash_ref = { map { $_=>$meta_ref->get_lazy_object($_) } @ids}; my $links_hash_ref = { map { $_=>$links_ref->get_lazy_object($_) } @ids}; my %res; foreach my $id ( @ids ) { $res{$id}= { props=>$props_hash_ref->{$id}, meta=>$meta_hash_ref->{$id}, links=>$links_hash_ref->{$id}, } } return \%res; } sub _prepare_record { my ( $self, $key, $ref ) = @_; if ( ref($self->_sub_ref) eq 'CODE') { return $self->_sub_ref()->($key,$ref) } esle { LOG $self "Not defined sub_ref" } return $ref; } sub _delete { my $self = shift; if ( my $ref = $self->fetch(@_) ){ $_->delete for values %{ $ref }; } $self->props->delete(@_) ; $self->meta->delete(@_) ; } sub create_obj { my $self = shift; my ($id,$props) = @_; return unless my $class = $props->{__class}; my $meta_ref = $self->meta->get_lazy_object($id); my $code = qq! new $class\:\: \$props,\$id,\$meta_ref; !; my $ret = eval $code; die ref($self)." die !".$@ if $@; return $ret; } sub fetch_by_guid { my $self = shift; my $guid = shift; my ( $res ) = values %{ $self->fetch({ 'tval'=>$guid}) }; return $res; } sub create_object { my $self = shift; my %arg = @_; my $class = $arg{class}; my ($meta_obj_id) = keys %{ $self->meta->create(mdata=>'') }; $self->props->create($meta_obj_id=>{__class=>$class}); my $dummy = $self->fetch_one($meta_obj_id); $dummy->_attr->{guid} = $arg{guid}||$self->make_uuid; return $self->fetch_one($meta_obj_id); } sub _fetch_all { my $self = shift; return $self->fetch( @{ $self->_fetch_all_ids }) } sub _fetch_all_ids { my $self = shift; my $all = $self->meta->_fetch_all; $all = [ keys %{$all} ] if ref($all) eq 'HASH'; return $all } sub create_item { my $self = shift; my %arg = @_; my $class = $arg{class}; my ($meta_obj_id) = keys %{ $self->meta->create(mdata=>'') }; my ( $dummy ) = values %{ $self->props->create($meta_obj_id,$class) || {}}; return $dummy; } sub commit { my $self = shift; map { $_->store_changed; $_->release_objects; } ( $self->props, $self->meta, $self->links) } sub make_uuid { my $self = shift; my $ug = new Data::UUID::; return $ug->to_string( $ug->create() ) } 1; __END__