File Coverage

blib/lib/Palm/MaTirelire/DBItemId.pm
Criterion Covered Total %
statement 9 81 11.1
branch 0 44 0.0
condition 0 9 0.0
subroutine 3 13 23.0
pod 0 10 0.0
total 12 157 7.6


line stmt bran cond sub pod time code
1             #
2             # Author : Maxime Soule
3             # Created On : Sun Jun 5 16:48:42 2005
4             # Last Modified By: Maxime Soule
5             # Last Modified On: Mon May 3 14:56:08 2010
6             # Update Count : 1
7             #
8             # Copyright (C) 2005, Maxime Soulé
9             # You may distribute this file under the terms of the Artistic
10             # License, as specified in the README file.
11             #
12              
13             package Palm::MaTirelire::DBItemId;
14              
15 1     1   1715 use strict;
  1         2  
  1         44  
16              
17 1     1   6 use Palm::MaTirelire::DBItem;
  1         1  
  1         7  
18              
19 1     1   39 use base qw(Palm::MaTirelire::DBItem);
  1         2  
  1         1246  
20              
21             our $VERSION = '1.0';
22              
23              
24             sub name ($$;$)
25             {
26 0     0 0   my($self, $id, $ref_cache) = @_;
27              
28 0           my($num, $unfiled_name) = @{$self->meta_infos}{qw(num unfiled_name)};
  0            
29              
30             # "Unfiled" case...
31 0 0 0       return $unfiled_name if defined $unfiled_name and $id == $num - 1;
32              
33 0 0         my $rec = defined($ref_cache) ? $ref_cache->[$id] : $self->get_id($id);
34              
35 0 0         return undef unless defined $rec;
36              
37 0           return $rec->{name};
38             }
39              
40              
41             sub full_name ($$;$)
42             {
43 0     0 0   my($self, $id, $ref_cache) = @_;
44              
45 0           return $self->name($id, $ref_cache);
46             }
47              
48              
49             sub unfiled_id ($)
50             {
51 0     0 0   my $self = shift;
52              
53 0           my($unfiled_name, $num) = @{$self->meta_infos}{qw(unfiled_name num)};
  0            
54              
55 0 0         return undef unless defined $unfiled_name;
56              
57 0           return $num - 1;
58             }
59              
60              
61             sub unfiled_name ($)
62             {
63 0     0 0   return shift->meta_infos->{unfiled_name};
64             }
65              
66              
67             sub new_RecordWithAutoId ($)
68             {
69 0     0 0   my $self = shift;
70              
71 0           my $rec = $self->new_Record;
72              
73 0           my $id_field = $self->meta_infos->{id_field};
74              
75 0           $rec->{$id_field} = $self->get_first_free_id;
76            
77 0 0         return defined($rec->{$id_field}) ? $rec : undef;
78             }
79              
80              
81             sub new_RecordWithId ($$)
82             {
83 0     0 0   my($self, $id) = @_;
84              
85 0           my($id_field, $unfiled_name, $num)
86 0           = @{$self->meta_infos}{qw(id_field unfiled_name num)};
87              
88 0 0         return undef if $id >= $num - (defined($unfiled_name) ? 1 : 0);
    0          
89              
90 0           my $rec = $self->new_Record;
91              
92 0           $rec->{$id_field} = $id;
93            
94 0 0         return defined($rec->{$id_field}) ? $rec : undef;
95             }
96              
97              
98             sub get_first_free_id ($)
99             {
100 0     0 0   my $self = shift;
101              
102 0           my($id_field, $unfiled_name, $num)
103 0           = @{$self->meta_infos}{qw(id_field unfiled_name num)};
104 0           my @ids;
105              
106 0           foreach my $rec (@{$self->{records}})
  0            
107             {
108 0           $ids[$rec->{$id_field}] = 1;
109             }
110              
111 0           my $free_id;
112 0           for ($free_id = 0; $free_id < @ids; $free_id++)
113             {
114 0 0         return $free_id unless defined $ids[$free_id];
115             }
116              
117 0 0         return $free_id if $free_id < $num - (defined($unfiled_name) ? 1 : 0);
    0          
118              
119 0           return undef;
120             }
121              
122              
123             sub get_id ($$)
124             {
125 0     0 0   my($self, $id) = @_;
126              
127 0           my($id_field, $unfiled_name, $num)
128 0           = @{$self->meta_infos}{qw(id_field unfiled_name num)};
129              
130 0 0         if ($id >= $num - (defined($unfiled_name) ? 1 : 0))
    0          
131             {
132             # XXX
133 0           return undef;
134             }
135              
136 0           foreach my $rec (@{$self->{records}})
  0            
137             {
138 0 0 0       return $rec if exists $rec->{$id_field} and $rec->{$id_field} == $id;
139             }
140              
141 0           return undef;
142             }
143              
144              
145             sub find_by_full_name ($$)
146             {
147 0     0 0   my($self, $name) = @_;
148              
149 0           my($id_field, $unfiled_name)
150 0           = @{$self->meta_infos}{qw(id_field unfiled_name)};
151              
152 0 0         return wantarray ? () : undef if $name eq $unfiled_name;
    0          
153              
154 0           my $ref_cache = $self->build_cache_id;
155 0           my @ret_list;
156              
157 0           foreach my $rec (@{$self->{records}})
  0            
158             {
159 0 0 0       if (exists $rec->{$id_field}
160             and $name eq $self->full_name($rec->{$id_field}, $ref_cache))
161             {
162 0 0         return $rec unless wantarray;
163              
164 0           push(@ret_list, $rec);
165             }
166             }
167              
168 0 0         return wantarray ? @ret_list : undef;
169             }
170              
171              
172             sub build_cache_id ($)
173             {
174 0     0 0   my $self = shift;
175              
176 0           my($id_field, $unfiled, $num)
177 0           = @{$self->meta_infos}{qw(id_field unfiled_name num)};
178              
179 0 0         $unfiled = defined($unfiled) ? 1 : 0;
180              
181 0           my @cache;
182 0           foreach my $rec (@{$self->{records}})
  0            
183             {
184 0 0         if (exists $rec->{$id_field})
185             {
186 0           my $id = $rec->{$id_field};
187              
188 0 0         if ($id >= $num - $unfiled)
189             {
190             # XXX
191             }
192             else
193             {
194 0           $cache[$id] = $rec;
195             }
196             }
197             }
198              
199 0           return \@cache;
200             }
201              
202             1;
203             __END__