annotate lib/IMPL/lang.pm @ 409:f7eeafbd33da ref20150831

sync
author cin
date Sun, 13 Sep 2015 19:30:49 +0300
parents 5c80e33f1218
children 30e8c6a74937
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
1 package IMPL::lang;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
2 use strict;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
3 use warnings;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
4
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
5 use parent qw(Exporter);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
6 use IMPL::_core::version;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
7 use IMPL::clone qw(clone);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
8 use Scalar::Util qw(blessed);
408
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
9 use POSIX;
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
10 use Carp qw(carp);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
11
409
cin
parents: 408
diff changeset
12 our @EXPORT = qw(&is &isclass &typeof &coarsen &coarsen_dt);
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
13 our %EXPORT_TAGS = (
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
14 base => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
15 qw(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
16 &is
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
17 &clone
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
18 &isclass
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
19 &typeof
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
20 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
21 ],
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
22
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
23 declare => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
24 qw(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
25 &public
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
26 &protected
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
27 &private
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
28 &property
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
29 &static
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
30 &property
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
31 &_direct
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
32 &ACCESS_PUBLIC
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
33 &ACCESS_PROTECTED
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
34 &ACCESS_PRIVATE
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
35 &PROP_GET
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
36 &PROP_SET
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
37 &PROP_OWNERSET
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
38 &PROP_LIST
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
39 &PROP_ALL
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
40 &PROP_RO
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
41 &PROP_RW
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
42 &PROP_DIRECT
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
43 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
44 ],
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
45 compare => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
46 qw(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
47 &equals
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
48 &equals_s
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
49 &hashCompare
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
50 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
51 ],
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
52 hash => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
53 qw(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
54 &hashApply
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
55 &hashMerge
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
56 &hashDiff
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
57 &hashCompare
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
58 &hashParse
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
59 &hashSave
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
60 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
61 ]
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
62 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
63
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
64 our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
65
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
66 use IMPL::Const qw(:all);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
67
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
68 sub is($$) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
69 carp "A typename can't be undefined" unless $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
70 blessed($_[0]) and $_[0]->isa( $_[1] );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
71 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
72
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
73 sub isclass {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
74 carp "A typename can't be undefined" unless $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
75 local $@;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
76 eval {not ref $_[0] and $_[0]->isa( $_[1] ) };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
77 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
78
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
79 sub typeof(*) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
80 local $@;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
81 eval { $_[0]->_typeof } || blessed($_[0]) || ref($_[0]);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
82 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
83
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
84 sub public($) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
85 my $info = shift;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
86 $info->{access} = ACCESS_PUBLIC;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
87 my $implementor = delete $info->{implementor};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
88 $implementor->Implement($info);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
89 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
90
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
91 sub private($) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
92 my $info = shift;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
93 $info->{access} = ACCESS_PRIVATE;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
94 my $implementor = delete $info->{implementor};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
95 $implementor->Implement($info);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
96 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
97
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
98 sub protected($) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
99 my $info = shift;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
100 $info->{access} = ACCESS_PROTECTED;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
101 my $implementor = delete $info->{implementor};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
102 $implementor->Implement($info);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
103 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
104
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
105 sub _direct ($) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
106 my $info = shift;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
107 $info->{direct} = 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
108 return $info;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
109 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
110
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
111 sub property($$) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
112 my ($propName,$attributes) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
113
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
114 $attributes = {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
115 get => $attributes & PROP_GET,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
116 set => $attributes & PROP_SET,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
117 isList => $attributes & PROP_LIST
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
118 } unless ref $attributes;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
119
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
120 my $class = caller;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
121
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
122 return hashMerge (
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
123 $attributes,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
124 {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
125 implementor => $class->ClassPropertyImplementor,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
126 name => $propName,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
127 class => scalar(caller),
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
128 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
129 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
130 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
131
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
132 sub static($$) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
133 my ( $name, $value ) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
134 my $class = caller;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
135 $class->static_accessor( $name, $value );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
136 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
137
408
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
138 sub coarsen {
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
139 my ( $value, $resolution ) = @_;
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
140 return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
141 }
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
142
409
cin
parents: 408
diff changeset
143 # datetime is DateTime object
cin
parents: 408
diff changeset
144 # resolution is DateTime::Duration object, the resulting time will be aligned to it
cin
parents: 408
diff changeset
145 sub coarsen_dt {
cin
parents: 408
diff changeset
146 my ( $datetime, $resolution ) = @_;
cin
parents: 408
diff changeset
147
cin
parents: 408
diff changeset
148 return $datetime unless $resolution;
cin
parents: 408
diff changeset
149
cin
parents: 408
diff changeset
150 my $date = $datetime->clone()->truncate( to => "day" );
cin
parents: 408
diff changeset
151
cin
parents: 408
diff changeset
152 return $date->add(
cin
parents: 408
diff changeset
153 minutes => coarsen(
cin
parents: 408
diff changeset
154 $datetime->subtract_datetime($date)->in_units('minutes'),
cin
parents: 408
diff changeset
155 $resolution->in_units('minutes')
cin
parents: 408
diff changeset
156 )
cin
parents: 408
diff changeset
157 );
cin
parents: 408
diff changeset
158 }
cin
parents: 408
diff changeset
159
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
160 sub equals {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
161 if (defined $_[0]) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
162 return 0 if (not defined $_[1]);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
163
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
164 return $_[0] == $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
165 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
166 return 0 if defined $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
167
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
168 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
169 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
170 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
171
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
172 sub equals_s {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
173 if (defined $_[0]) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
174 return 0 if (not defined $_[1]);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
175
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
176 return $_[0] eq $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
177 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
178 return 0 if defined $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
179
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
180 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
181 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
182 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
183
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
184 sub hashDiff {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
185 my ($src,$dst) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
186
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
187 $dst = $dst ? { %$dst } : {} ;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
188 $src ||= {};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
189
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
190 my %result;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
191
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
192 foreach my $key ( keys %$src ) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
193 if (exists $dst->{$key}) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
194 $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
195 delete $dst->{$key};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
196 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
197 $result{"-$key"} = 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
198 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
199 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
200
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
201 $result{"+$_"} = $dst->{$_} foreach keys %$dst;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
202
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
203 return \%result;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
204 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
205
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
206 sub hashMerge {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
207 return hashApply( { %{$_[0] || {}} }, $_[1] );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
208 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
209
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
210 sub hashApply {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
211 my ($target,$diff) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
212
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
213 return $target unless ref $diff eq 'HASH';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
214
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
215 while ( my ($key,$value) = each %$diff) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
216 $key =~ /^(\+|-)?(.*)$/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
217 my $op = $1 || '+';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
218 $key = $2;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
219
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
220 if ($op eq '-') {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
221 delete $target->{$key};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
222 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
223 $target->{$key} = $value;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
224 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
225 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
226
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
227 return $target;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
228 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
229
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
230 sub hashCompare {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
231 my ($l,$r,$cmp) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
232
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
233 $cmp ||= \&equals_s;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
234
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
235 return 0 unless scalar keys %$l == scalar keys %$r;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
236 &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
237
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
238 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
239 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
240
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
241 sub hashParse {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
242 my ($s,$p,$d) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
243
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
244 $p = $p ? qr/$p/ : qr/\n+/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
245 $d = $d ? qr/$d/ : qr/\s*=\s*/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
246
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
247 return {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
248 map split($d,$_,2), split($p,$s)
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
249 };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
250 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
251
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
252 sub hashSave {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
253 my ($hash,$p,$d) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
254
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
255 return "" unless ref $hash eq 'HASH';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
256
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
257 $p ||= "\n";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
258 $d ||= " = ";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
259
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
260 return
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
261 join(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
262 $p,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
263 map(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
264 join(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
265 $d,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
266 $_,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
267 $hash->{$_}
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
268 ),
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
269 keys %$hash
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
270 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
271 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
272 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
273
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
274 1;