Mercurial > pub > Impl
annotate Lib/IMPL/Object/List.pm @ 117:0475eb382085
Controls support (RC1)
author | wizard |
---|---|
date | Thu, 03 Jun 2010 02:41:44 +0400 |
parents | 76b878ad6596 |
children | e36ffd8c29db |
rev | line source |
---|---|
49 | 1 package IMPL::Object::List; |
2 use strict; | |
3 use warnings; | |
4 | |
5 use base qw(IMPL::Object::ArrayObject); | |
6 use IMPL::Exception; | |
7 | |
8 sub as_list { | |
9 return wantarray ? @{$_[0]} : $_[0]; | |
10 } | |
11 | |
12 sub CTOR { | |
13 my ($this,$data) = @_; | |
14 | |
15 if ($data) { | |
16 die new IMPL::InvalidArgumentException("The parameter should be a reference to an array") unless UNIVERSAL::isa($data,"ARRAY"); | |
17 @$this = @$data; | |
18 } | |
19 } | |
20 | |
21 sub Append { | |
22 push @{$_[0]}, @_[1 .. $#_]; | |
23 } | |
24 | |
25 sub RemoveLast { | |
26 return pop @{$_[0]}; | |
27 } | |
28 | |
29 sub AddFirst { | |
30 return unshift @{$_[0]}, $_[1]; | |
31 } | |
32 | |
33 sub RemoveFirst { | |
34 return shift @{$_[0]}; | |
35 } | |
36 | |
37 sub Count { | |
38 return scalar @{$_[0]}; | |
39 } | |
40 | |
41 sub InsertAt { | |
42 my ($this,$index,@val) = @_; | |
43 | |
44 splice @$this,($index||0),0,@val; | |
45 } | |
46 | |
47 sub RemoveAt { | |
48 my ($this,$index,$count) = @_; | |
49 | |
50 $count ||= 1; | |
51 | |
52 return splice @$this,$index,$count; | |
53 } | |
54 | |
55 sub RemoveItem { | |
56 my ($this,$item) = @_; | |
57 | |
58 @$this = grep $_ != $item, @$this; | |
59 | |
60 return $this; | |
61 } | |
62 | |
63 sub RemoveItemStr { | |
64 my ($this,$item) = @_; | |
65 | |
66 @$this = grep $_ ne $item, @$this; | |
67 | |
68 return $this; | |
69 } | |
70 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
71 sub save { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
72 my ($this,$ctx) = @_; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
73 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
74 $ctx->AddVar( item => $_ ) foreach @$this; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
75 } |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
76 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
77 sub restore { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
78 my ($class,$data,$surrogate) = @_; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
79 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
80 my $i = 0; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
81 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
82 if ($surrogate) { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
83 @$surrogate = grep { ($i++)%2 } @$data; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
84 } else { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
85 $surrogate = $class->new([grep { ($i++)%2 } @$data]); |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
86 } |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
87 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
88 return $surrogate; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
49
diff
changeset
|
89 } |
49 | 90 |
91 1; |