line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
PDL::IO::Dumper -- data dumping for structs with PDLs |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 DESCRIPTION |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
This package allows you cleanly to save and restore complex data structures |
8
|
|
|
|
|
|
|
which include PDLs, as ASCII strings and/or transportable ASCII files. It |
9
|
|
|
|
|
|
|
exports four functions into your namespace: sdump, fdump, frestore, and |
10
|
|
|
|
|
|
|
deep_copy. |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
PDL::IO::Dumper traverses the same types of structure that Data::Dumper |
13
|
|
|
|
|
|
|
knows about, because it uses a call to Data::Dumper. Unlike Data::Dumper |
14
|
|
|
|
|
|
|
it doesn't crash when accessing PDLs. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
The PDL::IO::Dumper routines have a slightly different syntax than |
17
|
|
|
|
|
|
|
Data::Dumper does: you may only dump a single scalar perl expression |
18
|
|
|
|
|
|
|
rather than an arbitrary one. Of course, the scalar may be a ref to |
19
|
|
|
|
|
|
|
whatever humongous pile of spaghetti you want, so that's no big loss. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
The output string is intended to be about as readable as Dumper's |
22
|
|
|
|
|
|
|
output is for non-PDL expressions. To that end, small PDLs (up to 8 |
23
|
|
|
|
|
|
|
elements) are stored as inline perl expressions, midsized PDLs (up to |
24
|
|
|
|
|
|
|
200 elements) are stored as perl expressions above the main data |
25
|
|
|
|
|
|
|
structure, and large PDLs are stored as FITS files that are uuencoded |
26
|
|
|
|
|
|
|
and included in the dump string. (You have to have access to either |
27
|
|
|
|
|
|
|
uuencode(1) or the CPAN module Convert::UU for this to work). |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
No attempt is made to shrink the output string -- for example, inlined |
30
|
|
|
|
|
|
|
PDL expressions all include explicit reshape() and typecast commands, |
31
|
|
|
|
|
|
|
and uuencoding expands stuff by a factor of about 1.5. So your data |
32
|
|
|
|
|
|
|
structures will grow when you dump them. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 Bugs |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
It's still possible to break this code and cause it to dump core, for |
37
|
|
|
|
|
|
|
the same reason that Data::Dumper crashes. In particular, other |
38
|
|
|
|
|
|
|
external-hook variables aren't recognized (for that a more universal |
39
|
|
|
|
|
|
|
Dumper would be needed) and will still exercise the Data::Dumper crash. |
40
|
|
|
|
|
|
|
This is by choice: (A) it's difficult to recognize which objects |
41
|
|
|
|
|
|
|
are actually external, and (B) most everyday objects are quite safe. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Another shortfall of Data::Dumper is that it doesn't recognize tied objects. |
44
|
|
|
|
|
|
|
This might be a Good Thing or a Bad Thing depending on your point of view, |
45
|
|
|
|
|
|
|
but it means that PDL::IO::Dumper includes a kludge to handle the tied |
46
|
|
|
|
|
|
|
Astro::FITS::Header objects associated with FITS headers (see the rfits |
47
|
|
|
|
|
|
|
documentation in PDL::IO::Misc for details). |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
There's currently no reference recursion detection, so a non-treelike |
50
|
|
|
|
|
|
|
reference topology will cause Dumper to buzz forever. That will |
51
|
|
|
|
|
|
|
likely be fixed in a future version. Meanwhile a warning message finds |
52
|
|
|
|
|
|
|
likely cases. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 Author, copyright, no warranty |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Copyright 2002, Craig DeForest. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
This code may be distributed under the same terms as Perl itself |
60
|
|
|
|
|
|
|
(license available at L). Copying, reverse |
61
|
|
|
|
|
|
|
engineering, distribution, and modification are explicitly allowed so |
62
|
|
|
|
|
|
|
long as this notice is preserved intact and modified versions are |
63
|
|
|
|
|
|
|
clearly marked as such. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
This package comes with NO WARRANTY. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 HISTORY |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=over 3 |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item * 1.0: initial release |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item * 1.1 (26-Feb-2002): Shorter form for short PDLs; more readability |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item * 1.2 (28-Feb-2002): Added deep_copy() -- exported convenience function |
76
|
|
|
|
|
|
|
for "eval sdump" |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item * 1.3 (15-May-2002): Added checking for tied objects in gethdr() |
79
|
|
|
|
|
|
|
[workaround for hole in Data::Dumper] |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item * 1.4 (15-Jan-2003): Added support for Convert::UU as well as |
82
|
|
|
|
|
|
|
command-line uu{en|de}code |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=back |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 FUNCTIONS |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=cut |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# use PDL::NiceSlice; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
package PDL::IO::Dumper; |
93
|
1
|
|
|
1
|
|
897
|
use File::Temp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
109
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
0
|
BEGIN{ |
97
|
1
|
|
|
1
|
|
11
|
use Exporter (); |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
431
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
package PDL::IO::Dumper; |
100
|
|
|
|
|
|
|
|
101
|
1
|
|
|
1
|
|
4
|
$PDL::IO::Dumper::VERSION = '1.3.2'; |
102
|
|
|
|
|
|
|
|
103
|
1
|
|
|
|
|
23
|
@PDL::IO::Dumper::ISA = ( Exporter ) ; |
104
|
1
|
|
|
|
|
6
|
@PDL::IO::Dumper::EXPORT_OK = qw( fdump sdump frestore deep_copy); |
105
|
1
|
|
|
|
|
2
|
@PDL::IO::Dumper::EXPORT = @EXPORT_OK; |
106
|
1
|
|
|
|
|
3
|
%PDL::IO::Dumper::EXPORT_TAGS = ( Func=>[@EXPORT_OK]); |
107
|
|
|
|
|
|
|
|
108
|
1
|
|
|
1
|
|
58
|
eval "use Convert::UU;"; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
109
|
1
|
|
|
|
|
15
|
$PDL::IO::Dumper::convert_ok = !$@; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my $checkprog = sub { |
112
|
1
|
|
|
|
|
4
|
my($prog) = $_[0]; |
113
|
1
|
50
|
|
|
|
5
|
my $pathsep = $^O =~ /win32/i ? ';' : ':'; |
114
|
1
|
50
|
|
|
|
4
|
my $exe = $^O =~ /win32/i ? '.exe' : ''; |
115
|
1
|
50
|
|
|
|
31
|
for(split $pathsep,$ENV{PATH}){return 1 if -x "$_/$prog$exe"} |
|
9
|
|
|
|
|
247
|
|
116
|
1
|
|
|
|
|
2190
|
return 0; |
117
|
1
|
|
|
|
|
5
|
}; |
118
|
|
|
|
|
|
|
# make sure not to use uuencode/uudecode |
119
|
|
|
|
|
|
|
# on MSWin32 systems (it doesn't work) |
120
|
|
|
|
|
|
|
# Force Convert::UU for BSD systems to see if that fixes uudecode problem |
121
|
1
|
50
|
33
|
|
|
55
|
if (($^O !~ /(MSWin32|bsd)$/) or ($^O eq 'gnukfreebsd')) { |
122
|
1
|
50
|
33
|
|
|
5
|
$PDL::IO::Dumper::uudecode_ok = &$checkprog('uudecode') and &$checkprog('uuencode') and ($^O !~ /MSWin32/); |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
1
|
|
|
1
|
|
8
|
use PDL; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
126
|
1
|
|
|
1
|
|
9
|
use PDL::Exporter; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
3
|
|
127
|
1
|
|
|
1
|
|
4
|
use PDL::Config; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
35
|
|
128
|
1
|
|
|
1
|
|
771
|
use Data::Dumper 2.121; |
|
1
|
|
|
|
|
7185
|
|
|
1
|
|
|
|
|
62
|
|
129
|
1
|
|
|
1
|
|
7
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
59
|
|
130
|
1
|
|
|
1
|
|
6
|
use IO::File; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
159
|
|
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
###################################################################### |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 sdump |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=for ref |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Dump a data structure to a string. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=for usage |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
use PDL::IO::Dumper; |
144
|
|
|
|
|
|
|
$s = sdump(); |
145
|
|
|
|
|
|
|
... |
146
|
|
|
|
|
|
|
= eval $s; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=for description |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sdump dumps a single complex data structure into a string. You restore |
151
|
|
|
|
|
|
|
the data structure by eval-ing the string. Since eval is a builtin, no |
152
|
|
|
|
|
|
|
convenience routine exists to use it. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=cut |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub PDL::IO::Dumper::sdump { |
157
|
|
|
|
|
|
|
# Make an initial dump... |
158
|
5
|
|
|
5
|
1
|
45
|
my($s) = Data::Dumper->Dump([@_]); |
159
|
5
|
|
|
|
|
378
|
my(%pdls); |
160
|
|
|
|
|
|
|
# Find the bless(...,'PDL') lines |
161
|
5
|
|
|
|
|
41
|
while($s =~ s/bless\( do\{\\\(my \$o \= '?(-?\d+)'?\)\}\, \'PDL\' \)/sprintf('$PDL_%u',$1)/e) { |
|
7
|
|
|
|
|
60
|
|
162
|
7
|
|
|
|
|
48
|
$pdls{$1}++; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
## Check for duplicates -- a weak proxy for recursion... |
166
|
5
|
|
|
|
|
15
|
my($v); |
167
|
|
|
|
|
|
|
my($dups); |
168
|
5
|
|
|
|
|
17
|
foreach $v(keys %pdls) { |
169
|
7
|
50
|
|
|
|
18
|
$dups++ if($pdls{$v} >1); |
170
|
|
|
|
|
|
|
} |
171
|
5
|
50
|
|
|
|
13
|
print STDERR "Warning: duplicated PDL ref. If sdump hangs, you have a circular reference.\n" if($dups); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# This next is broken into two parts to ensure $s is evaluated *after* the |
174
|
|
|
|
|
|
|
# find_PDLs call (which modifies $s using the s/// operator). |
175
|
|
|
|
|
|
|
|
176
|
5
|
|
|
|
|
23
|
my($s2) = "{my(\$VAR1);\n".&PDL::IO::Dumper::find_PDLs(\$s,@_)."\n\n"; |
177
|
5
|
|
|
|
|
161
|
return $s2.$s."\n}"; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
###################################################################### |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head2 fdump |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=for ref |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Dump a data structure to a file |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=for usage |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
use PDL::IO::Dumper; |
193
|
|
|
|
|
|
|
fdump(,$filename); |
194
|
|
|
|
|
|
|
... |
195
|
|
|
|
|
|
|
= frestore($filename); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=for description |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
fdump dumps a single complex data structure to a file. You restore the |
200
|
|
|
|
|
|
|
data structure by eval-ing the perl code put in the file. A convenience |
201
|
|
|
|
|
|
|
routine (frestore) exists to do it for you. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
I suggest using the extension '.pld' or (for non-broken OS's) '.pdld' |
204
|
|
|
|
|
|
|
to distinguish Dumper files. That way they are reminiscent of .pl |
205
|
|
|
|
|
|
|
files for perl, while still looking a little different so you can pick |
206
|
|
|
|
|
|
|
them out. You can certainly feed a dump file straight into perl (for |
207
|
|
|
|
|
|
|
syntax checking) but it will not do much for you, just build your data |
208
|
|
|
|
|
|
|
structure and exit. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub PDL::IO::Dumper::fdump { |
213
|
0
|
|
|
0
|
1
|
0
|
my($struct,$file) = @_; |
214
|
0
|
|
|
|
|
0
|
my $fh = IO::File->new( ">$file" ); |
215
|
0
|
0
|
|
|
|
0
|
unless ( defined $fh ) { |
216
|
0
|
|
|
|
|
0
|
Carp::cluck ("fdump: couldn't open '$file'\n"); |
217
|
0
|
|
|
|
|
0
|
return undef; |
218
|
|
|
|
|
|
|
} |
219
|
0
|
|
|
|
|
0
|
$fh->print( "####################\n## PDL::IO::Dumper dump file -- eval this in perl/PDL.\n\n" ); |
220
|
0
|
|
|
|
|
0
|
$fh->print( sdump($struct) ); |
221
|
0
|
|
|
|
|
0
|
$fh->close(); |
222
|
0
|
|
|
|
|
0
|
return $struct; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
###################################################################### |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head2 frestore |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=for ref |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Restore a dumped file |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=for usage |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
use PDL::IO::Dumper; |
236
|
|
|
|
|
|
|
fdump(,$filename); |
237
|
|
|
|
|
|
|
... |
238
|
|
|
|
|
|
|
= frestore($filename); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=for description |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
frestore() is a convenience function that just reads in the named |
243
|
|
|
|
|
|
|
file and executes it in an eval. It's paired with fdump(). |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub PDL::IO::Dumper::frestore { |
248
|
0
|
|
|
0
|
1
|
0
|
local($_); |
249
|
0
|
|
|
|
|
0
|
my($fname) = shift; |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
0
|
my $fh = IO::File->new( "<$fname" ); |
252
|
0
|
0
|
|
|
|
0
|
unless ( defined $fh ) { |
253
|
0
|
|
|
|
|
0
|
Carp::cluck("frestore: couldn't open '$file'\n"); |
254
|
0
|
|
|
|
|
0
|
return undef; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
|
|
0
|
my($file) = join("",<$fh>); |
258
|
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
0
|
$fh->close; |
260
|
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
0
|
return eval $file; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
###################################################################### |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head2 deep_copy |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=for ref |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Convenience function copies a complete perl data structure by the |
271
|
|
|
|
|
|
|
brute force method of "eval sdump". |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=cut |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub PDL::IO::Dumper::deep_copy { |
276
|
0
|
|
|
0
|
1
|
0
|
return eval sdump @_; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
###################################################################### |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head2 PDL::IO::Dumper::big_PDL |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=for ref |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Identify whether a PDL is ``big'' [Internal routine] |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
Internal routine takes a PDL and returns a boolean indicating whether |
288
|
|
|
|
|
|
|
it's small enough for direct insertion into the dump string. If 0, |
289
|
|
|
|
|
|
|
it can be inserted. Larger numbers yield larger scopes of PDL. |
290
|
|
|
|
|
|
|
1 implies that it should be broken out but can be handled with a couple |
291
|
|
|
|
|
|
|
of perl commands; 2 implies full uudecode treatment. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
PDLs with Astro::FITS::Header objects as headers are taken to be FITS |
294
|
|
|
|
|
|
|
files and are always treated as huge, regardless of size. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
$PDL::IO::Dumper::small_thresh = 8; # Smaller than this gets inlined |
299
|
|
|
|
|
|
|
$PDL::IO::Dumper::med_thresh = 400; # Smaller than this gets eval'ed |
300
|
|
|
|
|
|
|
# Any bigger gets uuencoded |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub PDL::IO::Dumper::big_PDL { |
303
|
7
|
|
|
7
|
1
|
12
|
my($x) = shift; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
return 0 |
306
|
|
|
|
|
|
|
if($x->nelem <= $PDL::IO::Dumper::small_thresh |
307
|
7
|
100
|
100
|
|
|
46
|
&& !(keys %{$x->hdr()}) |
|
2
|
|
|
|
|
16
|
|
308
|
|
|
|
|
|
|
); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
return 1 |
311
|
|
|
|
|
|
|
if($x->nelem <= $PDL::IO::Dumper::med_thresh |
312
|
6
|
100
|
50
|
|
|
27
|
&& ( !( ( (tied %{$x->hdr()}) || '' ) =~ m/^Astro::FITS::Header\=/) ) |
|
|
|
66
|
|
|
|
|
313
|
|
|
|
|
|
|
); |
314
|
|
|
|
|
|
|
|
315
|
3
|
|
|
|
|
9
|
return 2; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
###################################################################### |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=head2 PDL::IO::Dumper::stringify_PDL |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=for ref |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Turn a PDL into a 1-part perl expr [Internal routine] |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
Internal routine that takes a PDL and returns a perl string that evals to the |
327
|
|
|
|
|
|
|
PDL. It should be used with care because it doesn't dump headers and |
328
|
|
|
|
|
|
|
it doesn't check number of elements. The point here is that numbers are |
329
|
|
|
|
|
|
|
dumped with the correct precision for their storage class. Things we |
330
|
|
|
|
|
|
|
don't know about get stringified element-by-element by their builtin class, |
331
|
|
|
|
|
|
|
which is probably not a bad guess. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=cut |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
%PDL::IO::Dumper::stringify_formats = ( |
336
|
|
|
|
|
|
|
"byte"=>"%d", |
337
|
|
|
|
|
|
|
"short"=>"%d", |
338
|
|
|
|
|
|
|
"long"=>"%d", |
339
|
|
|
|
|
|
|
"float"=>"%.6g", |
340
|
|
|
|
|
|
|
"double"=>"%.16g" |
341
|
|
|
|
|
|
|
); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub PDL::IO::Dumper::stringify_PDL{ |
345
|
4
|
|
|
4
|
1
|
6
|
my($pdl) = shift; |
346
|
|
|
|
|
|
|
|
347
|
4
|
50
|
|
|
|
14
|
if(!ref $pdl) { |
348
|
0
|
|
|
|
|
0
|
confess "PDL::IO::Dumper::stringify -- got a non-pdl value!\n"; |
349
|
0
|
|
|
|
|
0
|
die; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
## Special case: empty PDL |
353
|
4
|
50
|
|
|
|
16
|
if($pdl->nelem == 0) { |
354
|
0
|
|
|
|
|
0
|
return "which(pdl(0))"; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
## Normal case: Figure out how to dump each number and dump them |
358
|
|
|
|
|
|
|
## in sequence as ASCII strings... |
359
|
|
|
|
|
|
|
|
360
|
4
|
|
|
|
|
16
|
my($pdlflat) = $pdl->flat; |
361
|
4
|
|
|
|
|
16
|
my($t) = $pdl->type; |
362
|
|
|
|
|
|
|
|
363
|
4
|
|
|
|
|
23
|
my($s); |
364
|
|
|
|
|
|
|
my(@s); |
365
|
4
|
|
|
|
|
0
|
my($dmp_elt); |
366
|
|
|
|
|
|
|
|
367
|
4
|
50
|
|
|
|
35
|
if(defined $PDL::IO::Dumper::stringify_formats{$t}) { |
368
|
4
|
|
|
|
|
11
|
$dmp_elt = eval "sub { sprintf '$PDL::IO::Dumper::stringify_formats{$t}',shift }"; |
369
|
|
|
|
|
|
|
} else { |
370
|
0
|
0
|
|
|
|
0
|
if(!$PDL::IO::Dumper::stringify_warned) { |
371
|
0
|
|
|
|
|
0
|
print STDERR "PDL::IO::Dumper: Warning, stringifying a '$t' PDL using default method\n\t(Will be silent after this)\n"; |
372
|
0
|
|
|
|
|
0
|
$PDL::IO::Dumper::stringify_warned = 1; |
373
|
|
|
|
|
|
|
} |
374
|
0
|
|
|
0
|
|
0
|
$dmp_elt = sub { my($x) = shift; "$x"; }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
375
|
|
|
|
|
|
|
} |
376
|
4
|
|
|
|
|
15
|
$i = 0; |
377
|
|
|
|
|
|
|
|
378
|
4
|
|
|
|
|
7
|
my($i); |
379
|
4
|
|
|
|
|
26
|
for($i = 0; $i < $pdl->nelem; $i++) { |
380
|
30
|
|
|
|
|
121
|
push(@s, &{$dmp_elt}( $pdlflat->slice("($i)") ) ); |
|
30
|
|
|
|
|
627
|
|
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
## Assemble all the strings and bracket with a pdl() call. |
385
|
|
|
|
|
|
|
|
386
|
4
|
50
|
66
|
|
|
15
|
$s = ($PDL::IO::Dumper::stringify_formats{$t}?$t:'pdl'). |
387
|
|
|
|
|
|
|
"(" . join( "," , @s ) . ")". |
388
|
|
|
|
|
|
|
(($_->getndims > 1) && ("->reshape(" . join(",",$pdl->dims) . ")")); |
389
|
|
|
|
|
|
|
|
390
|
4
|
|
|
|
|
65
|
return $s; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
###################################################################### |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 PDL::IO::Dumper::uudecode_PDL |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=for ref |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
Recover a PDL from a uuencoded string [Internal routine] |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
This routine encapsulates uudecoding of the dumped string for large piddles. |
403
|
|
|
|
|
|
|
It's separate to encapsulate the decision about which method of uudecoding |
404
|
|
|
|
|
|
|
to try (both the built-in Convert::UU and the shell command uudecode(1) |
405
|
|
|
|
|
|
|
are supported). |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=cut |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# should we use OS/library-level routines for creating |
410
|
|
|
|
|
|
|
# a temporary filename? |
411
|
|
|
|
|
|
|
# |
412
|
|
|
|
|
|
|
sub _make_tmpname () { |
413
|
|
|
|
|
|
|
# should we use File::Spec routines to create the file name? |
414
|
6
|
|
|
6
|
|
40
|
return File::Temp::tmpnam() . ".fits"; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# For uudecode_PDL: |
418
|
|
|
|
|
|
|
# |
419
|
|
|
|
|
|
|
# uudecode on OS-X needs the -s option otherwise it strips off the |
420
|
|
|
|
|
|
|
# path of the data file - which messes things up. We could change the |
421
|
|
|
|
|
|
|
# logic so that we explicitly tell uudecode where to create the output |
422
|
|
|
|
|
|
|
# file, except that this is also OS-dependent (-o on OS-X/linux, |
423
|
|
|
|
|
|
|
# -p on solaris/OS-X to write to stdout, any others?), |
424
|
|
|
|
|
|
|
# so we go this way for now as it is less-likely to break things |
425
|
|
|
|
|
|
|
# |
426
|
|
|
|
|
|
|
my $uudecode_string = "|uudecode"; |
427
|
|
|
|
|
|
|
$uudecode_string .= " -s" if (($^O =~ m/darwin|((free|open)bsd)|dragonfly/) and ($^O ne 'gnukfreebsd')); |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub PDL::IO::Dumper::uudecode_PDL { |
430
|
3
|
|
|
3
|
1
|
1162
|
my $lines = shift; |
431
|
3
|
|
|
|
|
8
|
my $out; |
432
|
3
|
|
|
|
|
14
|
my $fname = _make_tmpname(); |
433
|
3
|
50
|
|
|
|
970
|
if($PDL::IO::Dumper::uudecode_ok) { |
|
|
50
|
|
|
|
|
|
434
|
0
|
|
|
0
|
|
0
|
local $SIG{PIPE}= sub {}; # Prevent crashing if uudecode exits |
435
|
0
|
|
|
|
|
0
|
my $fh = IO::File->new( $uudecode_string ); |
436
|
0
|
|
|
|
|
0
|
$lines =~ s/^[^\n]*\n/begin 664 $fname\n/o; |
437
|
0
|
|
|
|
|
0
|
$fh->print( $lines ); |
438
|
0
|
|
|
|
|
0
|
$fh->close; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
elsif($PDL::IO::Dumper::convert_ok) { |
441
|
3
|
|
|
|
|
33
|
my $fh = IO::File->new(">$fname"); |
442
|
3
|
|
|
|
|
568
|
my $fits = Convert::UU::uudecode($lines); |
443
|
3
|
|
|
|
|
11194
|
$fh->print( $fits ); |
444
|
3
|
|
|
|
|
367
|
$fh->close(); |
445
|
|
|
|
|
|
|
} else { |
446
|
0
|
|
|
|
|
0
|
barf("Need either uudecode(1) or Convert::UU to decode dumped PDL.\n"); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
3
|
|
|
|
|
166
|
$out = rfits($fname); |
450
|
3
|
|
|
|
|
549
|
unlink($fname); |
451
|
|
|
|
|
|
|
|
452
|
3
|
|
|
|
|
149
|
$out; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head2 PDL::IO::Dumper::dump_PDL |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=for ref |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
Generate 1- or 2-part expr for a PDL [Internal routine] |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Internal routine that produces commands defining a PDL. You supply |
462
|
|
|
|
|
|
|
(, ) and get back two strings: a prepended command string and an |
463
|
|
|
|
|
|
|
expr that evaluates to the final PDL. PDL is the PDL you want to dump. |
464
|
|
|
|
|
|
|
is a flag whether dump_PDL is being called inline or before |
465
|
|
|
|
|
|
|
the inline dump string (0 for before; 1 for in). is the |
466
|
|
|
|
|
|
|
name of the variable to be assigned (for medium and large PDLs, |
467
|
|
|
|
|
|
|
which are defined before the dump string and assigned unique IDs). |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=cut |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub PDL::IO::Dumper::dump_PDL { |
472
|
7
|
|
|
7
|
1
|
15
|
local($_) = shift; |
473
|
7
|
|
|
|
|
19
|
my($pdlid) = @_; |
474
|
7
|
|
|
|
|
15
|
my(@out); |
475
|
|
|
|
|
|
|
|
476
|
7
|
|
|
|
|
18
|
my($style) = &PDL::IO::Dumper::big_PDL($_); |
477
|
|
|
|
|
|
|
|
478
|
7
|
100
|
|
|
|
17
|
if($style==0) { |
479
|
1
|
|
|
|
|
3
|
@out = ("", "( ". &PDL::IO::Dumper::stringify_PDL($_). " )"); |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
else { |
483
|
6
|
|
|
|
|
11
|
my(@s); |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
## midsized case |
486
|
6
|
100
|
|
|
|
13
|
if($style==1){ |
487
|
3
|
|
|
|
|
12
|
@s = ("my(\$$pdlid) = (", |
488
|
|
|
|
|
|
|
&PDL::IO::Dumper::stringify_PDL($_), |
489
|
|
|
|
|
|
|
");\n"); |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
## huge case |
493
|
|
|
|
|
|
|
else { |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
## |
496
|
|
|
|
|
|
|
## Write FITS file, uuencode it, snarf it up, and clean up the |
497
|
|
|
|
|
|
|
## temporary directory |
498
|
|
|
|
|
|
|
## |
499
|
3
|
|
|
|
|
10
|
my $fname = _make_tmpname(); |
500
|
3
|
|
|
|
|
1207
|
wfits($_,$fname); |
501
|
3
|
|
|
|
|
12
|
my(@uulines); |
502
|
|
|
|
|
|
|
|
503
|
3
|
50
|
|
|
|
18
|
if($PDL::IO::Dumper::uudecode_ok) { |
|
|
50
|
|
|
|
|
|
504
|
0
|
|
|
|
|
0
|
my $fh = IO::File->new( "uuencode $fname $fname |" ); |
505
|
0
|
|
|
|
|
0
|
@uulines = <$fh>; |
506
|
0
|
|
|
|
|
0
|
$fh->close; |
507
|
|
|
|
|
|
|
} elsif($PDL::IO::Dumper::convert_ok) { |
508
|
|
|
|
|
|
|
# Convert::UU::uuencode does not accept IO::File handles |
509
|
|
|
|
|
|
|
# (at least in version 0.52 of the module) |
510
|
|
|
|
|
|
|
# |
511
|
3
|
|
|
|
|
282
|
open(FITSFILE,"<$fname"); |
512
|
3
|
|
|
|
|
27
|
@uulines = ( Convert::UU::uuencode(*FITSFILE) ); |
513
|
|
|
|
|
|
|
} else { |
514
|
0
|
|
|
|
|
0
|
barf("dump_PDL: Requires either uuencode or Convert:UU"); |
515
|
|
|
|
|
|
|
} |
516
|
3
|
|
|
|
|
4347
|
unlink $fname; |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
## |
519
|
|
|
|
|
|
|
## Generate commands to uudecode the FITS file and resnarf it |
520
|
|
|
|
|
|
|
## |
521
|
3
|
|
|
|
|
50
|
@s = ("my(\$$pdlid) = PDL::IO::Dumper::uudecode_PDL(<<'DuMPERFILE'\n", |
522
|
|
|
|
|
|
|
@uulines, |
523
|
|
|
|
|
|
|
"\nDuMPERFILE\n);\n", |
524
|
|
|
|
|
|
|
"\$$pdlid->hdrcpy(".$_->hdrcpy().");\n" |
525
|
|
|
|
|
|
|
); |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
## |
528
|
|
|
|
|
|
|
## Unfortunately, FITS format mangles headers (and gives us one |
529
|
|
|
|
|
|
|
## even if we don't want it). Delete the FITS header if we don't |
530
|
|
|
|
|
|
|
## want one. |
531
|
|
|
|
|
|
|
## |
532
|
3
|
100
|
|
|
|
6
|
if( !scalar(keys %{$_->hdr()}) ) { |
|
3
|
|
|
|
|
34
|
|
533
|
2
|
|
|
|
|
8
|
push(@s,"\$$pdlid->sethdr(undef);\n"); |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
## |
538
|
|
|
|
|
|
|
## Generate commands to reconstitute the header |
539
|
|
|
|
|
|
|
## information in the PDL -- common to midsized and huge case. |
540
|
|
|
|
|
|
|
## |
541
|
|
|
|
|
|
|
## We normally want to reconstitute, because FITS headers mangle |
542
|
|
|
|
|
|
|
## arbitrary hashes and we can reconsitute efficiently with a private |
543
|
|
|
|
|
|
|
## sdump(). The one known exception to this is when there's a FITS |
544
|
|
|
|
|
|
|
## header object (Astro::FITS::Header) tied to the original |
545
|
|
|
|
|
|
|
## PDL's header. Other types of tied object will get handled just |
546
|
|
|
|
|
|
|
## like normal hashes. |
547
|
|
|
|
|
|
|
## |
548
|
|
|
|
|
|
|
## Ultimately, Data::Dumper will get fixed to handle tied objects, |
549
|
|
|
|
|
|
|
## and this kludge will go away. |
550
|
|
|
|
|
|
|
## |
551
|
|
|
|
|
|
|
|
552
|
6
|
100
|
|
|
|
13
|
if( scalar(keys %{$_->hdr()}) ) { |
|
6
|
|
|
|
|
33
|
|
553
|
2
|
50
|
50
|
|
|
5
|
if( ((tied %{$_->hdr()}) || '') =~ m/Astro::FITS::Header\=/) { |
554
|
0
|
|
|
|
|
0
|
push(@s,"# (Header restored from FITS file)\n"); |
555
|
|
|
|
|
|
|
} else { |
556
|
2
|
|
|
|
|
22
|
push(@s,"\$$pdlid->sethdr( eval <<'EndOfHeader_${pdlid}'\n", |
557
|
|
|
|
|
|
|
&PDL::IO::Dumper::sdump($_->hdr()), |
558
|
|
|
|
|
|
|
"\nEndOfHeader_${pdlid}\n);\n", |
559
|
|
|
|
|
|
|
"\$$pdlid->hdrcpy(".$_->hdrcpy().");\n" |
560
|
|
|
|
|
|
|
); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
6
|
|
|
|
|
150
|
@out = (join("",@s), undef); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
7
|
|
|
|
|
27
|
return @out; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
###################################################################### |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head2 PDL::IO::Dumper::find_PDLs |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=for ref |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Walk a data structure and dump PDLs [Internal routine] |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Walks the original data structure and generates appropriate exprs |
579
|
|
|
|
|
|
|
for each PDL. The exprs are inserted into the Data::Dumper output |
580
|
|
|
|
|
|
|
string. You shouldn't call this unless you know what you're doing. |
581
|
|
|
|
|
|
|
(see sdump, above). |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=cut |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub PDL::IO::Dumper::find_PDLs { |
586
|
15
|
|
|
15
|
1
|
24
|
local($_); |
587
|
15
|
|
|
|
|
27
|
my($out)=""; |
588
|
15
|
|
|
|
|
21
|
my($sp) = shift; |
589
|
|
|
|
|
|
|
|
590
|
15
|
|
|
|
|
32
|
findpdl:foreach $_(@_) { |
591
|
15
|
100
|
|
|
|
46
|
next findpdl unless ref($_); |
592
|
|
|
|
|
|
|
|
593
|
12
|
100
|
|
|
|
73
|
if(UNIVERSAL::isa($_,'ARRAY')) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
594
|
1
|
|
|
|
|
3
|
my($x); |
595
|
1
|
|
|
|
|
3
|
foreach $x(@{$_}) { |
|
1
|
|
|
|
|
4
|
|
596
|
3
|
|
|
|
|
13
|
$out .= find_PDLs($sp,$x); |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
elsif(UNIVERSAL::isa($_,'HASH')) { |
600
|
4
|
|
|
|
|
7
|
my($x); |
601
|
4
|
|
|
|
|
9
|
foreach $x(values %{$_}) { |
|
4
|
|
|
|
|
13
|
|
602
|
7
|
|
|
|
|
21
|
$out .= find_PDLs($sp,$x) |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
} elsif(UNIVERSAL::isa($_,'PDL')) { |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
# In addition to straight PDLs, |
607
|
|
|
|
|
|
|
# this gets subclasses of PDL, but NOT magic-hash subclasses of |
608
|
|
|
|
|
|
|
# PDL (because they'd be gotten by the previous clause). |
609
|
|
|
|
|
|
|
# So if you subclass PDL but your actual data structure is still |
610
|
|
|
|
|
|
|
# just a straight PDL (and not a hash with PDL field), you end up here. |
611
|
|
|
|
|
|
|
# |
612
|
|
|
|
|
|
|
|
613
|
7
|
|
|
|
|
90
|
my($pdlid) = sprintf('PDL_%u',$$_); |
614
|
7
|
|
|
|
|
31
|
my(@strings) = &PDL::IO::Dumper::dump_PDL($_,$pdlid); |
615
|
|
|
|
|
|
|
|
616
|
7
|
|
|
|
|
67
|
$out .= $strings[0]; |
617
|
7
|
100
|
|
|
|
45
|
$$sp =~ s/\$$pdlid/$strings[1]/g if(defined($strings[1])); |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
elsif(UNIVERSAL::isa($_,'SCALAR')) { |
620
|
|
|
|
|
|
|
# This gets other kinds of refs -- PDLs have already been gotten. |
621
|
|
|
|
|
|
|
# Naked PDLs are themselves SCALARs, so the SCALAR case has to come |
622
|
|
|
|
|
|
|
# last to let the PDL case run. |
623
|
0
|
|
|
|
|
0
|
$out .= find_PDLs( $sp, ${$_} ); |
|
0
|
|
|
|
|
0
|
|
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
} |
627
|
15
|
|
|
|
|
134
|
return $out; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
1; |