annotate Lib/CDBI/Map.pm @ 40:ac21a032e7a9

bnf parser in progress
author Sergey
date Thu, 10 Dec 2009 17:43:39 +0300
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package CDBI::Map;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 DeclareProperty _Cache => ACCESS_NONE;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 DeclareProperty _HoldingType => ACCESS_NONE;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 sub _KeyValuePairClass {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 ($this->{$_HoldingType} = ref $this ) =~ s/^((?:\w+::)*)Map(\w+)$/${1}MapItem${2}/ unless $this->{$_HoldingType};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 return $this->{$_HoldingType};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 # ïðè çàãðóçêå êåøà íåëüçÿ ãðóçèòü KeyValuePair ïîñêîëüêó ïîëó÷àòñÿ öèêëè÷åñêèå ññûëêè:(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 sub GetCache {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 if (not $this->{$_Cache}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 $this->{$_Cache} = { map { $_->ItemKey, { id => $_->id, value => $_->Value} } $this->_KeyValuePairClass->search(Parent => $this) };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 return $this->{$_Cache};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 sub Keys {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 return wantarray ? keys %{$this->GetCache} : [keys %{$this->GetCache}];
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 sub Item {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 my ($this,$key,$value,%options) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 die new Exception('A key must be specified') unless defined $key;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 if (@_ > 2) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 # set
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 if (my $pairInfo = $this->GetCache->{$key}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 # update
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 my $pair = $this->_KeyValuePairClass->retrieve($pairInfo->{id});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 if (defined $value or $options{'keepnull'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 $pair->Value($value);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 $pair->update;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 $pairInfo->{value} = $value;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 #delete
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 $pair->delete;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 delete $this->GetCache->{$key};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 if ( defined $value or $options{'keepnull'}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 my $pair = $this->_KeyValuePairClass->insert( {Parent => $this, ItemKey => $key, Value => $value } );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 $this->GetCache->{$key} = {id => $pair->id, value => $value };
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 return $value;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 # get
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 if (my $pairInfo = $this->GetCache->{$key}) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61 return $pairInfo->{value};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 return undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
68 sub Delete {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
69 my ($this,$key) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
70
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
71 if (my $pair = $this->GetCache->{$key} ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
72 $pair->delete;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
73 delete $this->GetCache->{$key};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
74 return 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
75 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
76 return 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
77 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
78
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
79 sub Has {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
80 my ($this,$key) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
81
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
82 return exists $this->GetCache->{$key};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
83 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
84
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
85 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
86 __END__
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
87 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
88 =head1 SYNOPSIS
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
89 package App::CDBI;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
90 use base 'Class::DBI';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
91
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
92 #....
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
93
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
94 package App::MapString;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
95 use base 'Class::DBI','CDBI::Map';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
96
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
97 #....
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
98
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
99
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
100 my $Map = App::MapString->retrieve($id);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
101 print $Map->Item('key');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
102 $Map->Item('key','value');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
103 $Map->Delete('key');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
104 print "the $key is found" if $Map->Has($key);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
105
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
106 =head1 DESCRIPTION
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
107
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
108 Provides a set of methods to manipulate with Maps;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
109
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
110 =cut