File Coverage

blib/lib/Treex/PML/List.pm
Criterion Covered Total %
statement 21 102 20.5
branch 3 40 7.5
condition 0 15 0.0
subroutine 8 26 30.7
pod 20 20 100.0
total 52 203 25.6


line stmt bran cond sub pod time code
1              
2             ############################################################
3              
4             =head1 NAME
5              
6             Treex::PML::List - lists of uniformly typed PML values
7              
8             =head1 DESCRIPTION
9              
10             This class implements the attribute value type 'list'.
11              
12             =over 4
13              
14             =cut
15              
16             package Treex::PML::List;
17 6     6   39 use Carp;
  6         11  
  6         309  
18 6     6   32 use warnings;
  6         15  
  6         145  
19              
20 6     6   30 use vars qw($VERSION);
  6         12  
  6         220  
21             BEGIN {
22 6     6   122 $VERSION='2.24'; # version template
23             }
24 6     6   32 use strict;
  6         13  
  6         1181  
25              
26             =item Treex::PML::List->new (val1,val2,...)
27              
28             Create a new list (optionally populated with given values).
29              
30             NOTE: Don't call this constructor directly, use Treex::PML::Factory->createList() instead!
31              
32             =cut
33              
34             sub new {
35 55     55 1 152 my $class = shift;
36 55         287 return bless [@_],$class;
37             }
38              
39             =item Treex::PML::List->new_from_ref (array_ref, reuse)
40              
41             Create a new list consisting of values in a given array reference.
42             Use this constructor instead of new() to pass large lists by reference. If
43             reuse is true, then the same array_ref scalar is used to represent the
44             Treex::PML::List object (i.e. blessed). Otherwise, a copy is created in
45             the constructor.
46              
47             NOTE: Don't call this constructor directly, use Treex::PML::Factory->createList() instead!
48              
49             =cut
50              
51             sub new_from_ref {
52 16510     16510 1 31992 my ($class,$array,$reuse) = @_;
53 16510 100       29122 if ($reuse) {
54 9854 50       24215 if (UNIVERSAL::isa($array,'ARRAY')) {
55 9854         43122 return bless $array,$class;
56             } else {
57 0         0 croak("Usage: new_from_ref(ARRAY_REF,1) - arg 1 is not an ARRAY reference!");
58             }
59             } else {
60 6656         24938 return bless [@$array],$class;
61             }
62             }
63              
64             =item $list->values ()
65              
66             Returns all its values (i.e. the list members).
67              
68             =cut
69              
70             sub values {
71 0     0 1   return @{$_[0]};
  0            
72             }
73              
74             =item $list->count ()
75              
76             Return number of values in the list.
77              
78             =cut
79              
80             sub count {
81 0     0 1   return scalar(@{$_[0]});
  0            
82             }
83              
84             =item $list->append (@values)
85              
86             Append given values to the list.
87              
88             =cut
89              
90             sub append {
91 0     0 1   my $self = shift;
92 0           CORE::push(@$self,@_);
93 0           return $self;
94             }
95             BEGIN{
96 6     6   4639 *push = \&append;
97             }
98              
99             =item $list->push (@values)
100              
101             An alias for C<$list->append()).
102              
103             =cut
104              
105              
106             =item $list->append_list ($list2)
107              
108             Append values from a given list or ARRAY-reference to the current list.
109              
110             =cut
111              
112             sub append_list {
113 0     0 1   my ($self, $list) = @_;
114 0           CORE::push(@$self,@$list);
115 0           return $self;
116             }
117              
118              
119             =item $list->insert ($index, @values)
120              
121             Insert values before the value at a given position in the list. The
122             index of the first position in the list is 0. It is an error if
123             $index is less then 0. If $index equals the index of the last
124             value + 1, then values are appended to the list, but it is an error if
125             $index is greater than that.
126              
127             =cut
128              
129             sub insert {
130 0     0 1   my $self = shift;
131 0           my $pos = shift;
132 0           $self->insert_list($pos,\@_);
133 0           return $self;
134             }
135              
136             =item $list->insert_list ($index, $list)
137              
138             Insert all values in $list before the value at a given position in the
139             current list. The index of the first position in the current list is
140             0. It is an error if $index is less then 0. If $index equals
141             the index of the last value + 1, then values are appended to the list,
142             but it is an error if $index is greater than that.
143              
144             =cut
145              
146             sub insert_list {
147 0 0   0 1   die 'Usage: Treex::PML::List->insert_list($index,$list) (wrong number of arguments!)'
148             if @_!=3;
149 0           my ($self,$pos,$list) = @_;
150 0 0 0       die 'Treex::PML::List->insert: position out of bounds' if ($pos<0 or $pos>@$self);
151 0 0         if ($pos==@$self) {
152 0           CORE::push(@$self,@$list);
153             } else {
154 0           splice @$self,$pos,0,@$list;
155             }
156 0           return $self;
157             }
158              
159             =item $list->delete ($index, $count)
160              
161             Delete $count values from the list starting at index $index.
162              
163             =cut
164              
165             sub delete {
166 0 0   0 1   die 'Usage: Treex::PML::List->delete($index,$count) (wrong number of arguments!)'
167             if @_!=3;
168 0           my ($self,$pos,$count) = @_;
169 0 0 0       die 'Treex::PML::List->insert: position out of bounds' if ($pos<0 or $pos>=@$self);
170 0           splice @$self,$pos,$count;
171 0           return $self;
172             }
173              
174             =item $list->delete_value ($value)
175              
176             Delete all occurences of value $value. Values are compared as strings.
177              
178             =cut
179              
180             sub delete_value {
181 0 0   0 1   die 'Usage: Treex::PML::List->delete_value($value) (wrong number of arguments!)'
182             if @_!=2;
183 0           my ($self,$value) = @_;
184 0           @$self = grep { $_ ne $value } @$self;
  0            
185 0           return $self;
186             }
187              
188             =item $list->delete_values ($value1,$value2,...)
189              
190             Delete all occurences of values $value1, $value2,... Values are
191             compared as strings.
192              
193             =cut
194              
195             sub delete_values {
196 0     0 1   my $self = shift;
197 0           my %d; @d{@_} = ();
  0            
198 0           @$self = grep { !exists($d{$_}) } @$self;
  0            
199 0           return $self;
200             }
201              
202             =item $list->replace ($index, $count, @list)
203              
204             Replacing $count values starting at index $index by values provided
205             in the @list (the count of values in @list may differ from $count).
206              
207             =cut
208              
209             sub replace {
210 0 0   0 1   die 'Usage: Treex::PML::List->replace($index,$count,@list) (wrong number of arguments!)'
211             unless @_>=3;
212 0           my $self = shift;
213 0           my $pos = shift;
214 0           my $count = shift;
215 0           $self->replace_list($pos,\@_);
216 0           return $self;
217             }
218              
219             =item $list->replace_list ($index, $count, $list)
220              
221             Like replace, but replacement values are taken from a Treex::PML::List
222             object $list.
223              
224             =cut
225              
226             sub replace_list {
227 0     0 1   my ($self,$pos,$count,$list)=@_;
228 0 0         die 'Usage: Treex::PML::List->replace_list($index,$count,$list) (wrong number of arguments!)'
229             if @_!=4;
230 0 0 0       die 'Treex::PML::List->replace_list: position out of bounds' if ($pos<0 or $pos>=@$self);
231 0           splice @$self,$pos,$count,@$list;
232 0           return $self;
233             }
234              
235             =item $list->value_at ($index)
236              
237             Return value at index $index. This is in fact the same as
238             $list->[$index] only $index is checked to be non-negative and less
239             then the index of the last value.
240              
241             =cut
242              
243             sub value_at {
244 0     0 1   my ($self,$pos)=@_;
245 0 0         die 'Usage: Treex::PML::List->value_at($index) (wrong number of arguments!)'
246             if @_!=2;
247 0 0 0       die 'Treex::PML::List->value_at: position out of bounds' if ($pos<0 or $pos>=@$self);
248 0           return $self->[$pos];
249             }
250              
251             =item $list->set_value_at ($index,$value)
252              
253             Set value at index $index to $value. This is in fact the same as
254             assigning directly to $list->[$index], except that $index is checked
255             to be non-negative and less then the index of the last value. Returns
256             $value.
257              
258             =cut
259              
260             sub set_value_at {
261 0     0 1   my ($self,$pos,$value)=@_;
262 0 0         die 'Usage: Treex::PML::List->set_value_at($index,$value) (wrong number of arguments!)'
263             if @_!=3;
264 0 0 0       die 'Treex::PML::List->set_value_index: position out of bounds' if ($pos<0 or $pos>=@$self);
265 0           return $self->[$pos] = $value;
266             }
267              
268             =item $list->index_of ($value)
269              
270             Search the list for the first occurence of value $value. Returns index
271             of the first occurence or undef if the value is not in the
272             list. (Values are compared as strings.)
273              
274             =cut
275              
276             sub index_of {
277 0     0 1   my ($self,$value)=@_;
278 0 0         die 'Usage: Treex::PML::List->index_of($value) (wrong number of arguments!)'
279             if @_!=2;
280 0           return &Treex::PML::Index;
281             }
282              
283             =item $list->unique_values ()
284              
285             Return unique values in the list (ordered by the index of the first
286             occurence). Values are compared as strings.
287              
288             =cut
289              
290             sub unique_values {
291 0 0   0 1   die 'Usage: Treex::PML::List->unique_values() (wrong number of arguments!)'
292             if @_!=1;
293 0           my $self = shift;
294 0           my %a;
295 0           return grep { !($a{$_}++) } @$self;
  0            
296             }
297              
298             =item $list->unique_list ()
299              
300             Return a new Treex::PML::List object consisting of unique values in the
301             current list (ordered by the index of the first occurence). Values
302             are compared as strings.
303              
304             =cut
305              
306             sub unique_list {
307 0 0   0 1   die 'Usage: Treex::PML::List->unique_values() (wrong number of arguments!)'
308             if @_!=1;
309 0           my $self = shift;
310 0           my %a;
311 0           my $class = ref $self;
312 0           return $class->new_from_ref([grep { !($a{$_}++) } @$self],1);
  0            
313             }
314              
315              
316             =item $list->make_unique ()
317              
318             Remove duplicated values from the list. Values are compared as
319             strings. Returns $list.
320              
321             =cut
322              
323             sub make_unique {
324 0 0   0 1   die 'Usage: Treex::PML::List->make_unique() (wrong number of arguments!)'
325             if @_!=1;
326 0           my $self = shift;
327 0           my %a; @$self = grep { !($a{$_}++) } @$self;
  0            
  0            
328 0           return $self;
329             }
330              
331              
332              
333             =item $list->empty ()
334              
335             Remove all values from the list.
336              
337             =cut
338              
339             sub empty {
340 0 0   0 1   die 'Usage: Treex::PML::List->empty() (wrong number of arguments!)'
341             if @_!=1;
342 0           my $self = shift;
343 0           @$self=();
344 0           return $self;
345             }
346              
347              
348             =back
349              
350             =cut
351              
352             =head1 SEE ALSO
353              
354             L, L, L, L
355              
356             =head1 COPYRIGHT AND LICENSE
357              
358             Copyright (C) 2006-2010 by Petr Pajas
359              
360             This library is free software; you can redistribute it and/or modify
361             it under the same terms as Perl itself, either Perl version 5.8.2 or,
362             at your option, any later version of Perl 5 you may have available.
363              
364             =cut
365              
366              
367             1;