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