annotate lib/IMPL/lang.pm @ 408:5c80e33f1218 ref20150831

added 'coarsen' function
author cin
date Mon, 07 Sep 2015 01:35:25 +0300
parents c6e90e02dd17
children f7eeafbd33da
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
408
5c80e33f1218 added 'coarsen' function
cin
parents: 407
diff changeset
12 our @EXPORT = qw(&is &isclass &typeof &coarsen);
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
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
143 sub equals {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
144 if (defined $_[0]) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
145 return 0 if (not defined $_[1]);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
146
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
147 return $_[0] == $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
148 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
149 return 0 if defined $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
150
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
151 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
152 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
153 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
154
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
155 sub equals_s {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
156 if (defined $_[0]) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
157 return 0 if (not defined $_[1]);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
158
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
159 return $_[0] eq $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
160 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
161 return 0 if defined $_[1];
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
162
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
163 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
164 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
165 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
166
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
167 sub hashDiff {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
168 my ($src,$dst) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
169
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
170 $dst = $dst ? { %$dst } : {} ;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
171 $src ||= {};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
172
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
173 my %result;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
174
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
175 foreach my $key ( keys %$src ) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
176 if (exists $dst->{$key}) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
177 $result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
178 delete $dst->{$key};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
179 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
180 $result{"-$key"} = 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 $result{"+$_"} = $dst->{$_} foreach keys %$dst;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
185
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
186 return \%result;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
187 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
188
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
189 sub hashMerge {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
190 return hashApply( { %{$_[0] || {}} }, $_[1] );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
191 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
192
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
193 sub hashApply {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
194 my ($target,$diff) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
195
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
196 return $target unless ref $diff eq 'HASH';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
197
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
198 while ( my ($key,$value) = each %$diff) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
199 $key =~ /^(\+|-)?(.*)$/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
200 my $op = $1 || '+';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
201 $key = $2;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
202
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
203 if ($op eq '-') {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
204 delete $target->{$key};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
205 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
206 $target->{$key} = $value;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
207 }
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 return $target;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
211 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
212
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
213 sub hashCompare {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
214 my ($l,$r,$cmp) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
215
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
216 $cmp ||= \&equals_s;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
217
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
218 return 0 unless scalar keys %$l == scalar keys %$r;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
219 &$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
220
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
221 return 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
222 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
223
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
224 sub hashParse {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
225 my ($s,$p,$d) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
226
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
227 $p = $p ? qr/$p/ : qr/\n+/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
228 $d = $d ? qr/$d/ : qr/\s*=\s*/;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
229
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
230 return {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
231 map split($d,$_,2), split($p,$s)
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
232 };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
233 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
234
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
235 sub hashSave {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
236 my ($hash,$p,$d) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
237
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
238 return "" unless ref $hash eq 'HASH';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
239
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
240 $p ||= "\n";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
241 $d ||= " = ";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
242
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
243 return
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
244 join(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
245 $p,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
246 map(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
247 join(
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
248 $d,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
249 $_,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
250 $hash->{$_}
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
251 ),
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
252 keys %$hash
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
253 )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
254 );
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
255 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
256
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
257 1;