line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
## File: PDL::CCS::IO::Common.pm |
2
|
|
|
|
|
|
|
## Author: Bryan Jurish |
3
|
|
|
|
|
|
|
## Description: common routines for PDL::CCS::Nd I/O |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package PDL::CCS::IO::Common; |
6
|
4
|
|
|
4
|
|
29
|
use PDL::CCS::Config qw(ccs_indx); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
200
|
|
7
|
4
|
|
|
4
|
|
22
|
use PDL::CCS::Nd; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
71
|
|
8
|
4
|
|
|
4
|
|
20
|
use PDL; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
29
|
|
9
|
4
|
|
|
4
|
|
12379
|
use Carp qw(confess); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
256
|
|
10
|
4
|
|
|
4
|
|
26
|
use strict; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
4926
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.23.13'; |
13
|
|
|
|
|
|
|
our @ISA = ('PDL::Exporter'); |
14
|
|
|
|
|
|
|
our @EXPORT_OK = |
15
|
|
|
|
|
|
|
( |
16
|
|
|
|
|
|
|
qw(_ccsio_open _ccsio_close), |
17
|
|
|
|
|
|
|
qw(_ccsio_read_header _ccsio_parse_header), |
18
|
|
|
|
|
|
|
qw(_ccsio_write_header _ccsio_header_lines), |
19
|
|
|
|
|
|
|
qw(_ccsio_opts_ix _ccsio_opts_nz), |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
our %EXPORT_TAGS = |
22
|
|
|
|
|
|
|
( |
23
|
|
|
|
|
|
|
Func => [], ##-- respect PDL conventions (hopefully) |
24
|
|
|
|
|
|
|
intern => [@EXPORT_OK], |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
##====================================================================== |
29
|
|
|
|
|
|
|
## pod: headers |
30
|
|
|
|
|
|
|
=pod |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 NAME |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
PDL::CCS::IO::Common - Common pseudo-private routines for PDL::CCS::Nd I/O |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 SYNOPSIS |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
use PDL; |
39
|
|
|
|
|
|
|
use PDL::CCS::Nd; |
40
|
|
|
|
|
|
|
use PDL::CCS::IO::Common qw(:intern); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
#... stuff happens |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=cut |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
##====================================================================== |
47
|
|
|
|
|
|
|
## private utilities |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
## \%ixOpts = _ccsio_opts_ix(\%opts) |
50
|
|
|
|
|
|
|
## \%ixOpts = _ccsio_opts_ix(\%opts,\%defaults) |
51
|
|
|
|
|
|
|
## + extracts 'ixX' options from \%opts as 'X' options in \%ixOpts |
52
|
|
|
|
|
|
|
sub _ccsio_opts_ix { |
53
|
0
|
|
0
|
0
|
|
|
my $opts = { map {s/^ix//; ($_=>$_[0]{$_})} grep {/^ix/} keys %{$_[0]//{}} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
54
|
0
|
|
0
|
|
|
|
$opts->{$_} //= $_[1]{$_} foreach (keys %{$_[1]//{}}); |
|
0
|
|
0
|
|
|
|
|
55
|
0
|
|
|
|
|
|
return $opts; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
## \%nzOpts = _ccsio_opts_nz(\%opts) |
59
|
|
|
|
|
|
|
## \%nzOpts = _ccsio_opts_nz(\%opts,\%defaults) |
60
|
|
|
|
|
|
|
## + extracts 'nzX' options from \%opts as 'X' options in \%nzOpts |
61
|
|
|
|
|
|
|
sub _ccsio_opts_nz { |
62
|
0
|
|
0
|
0
|
|
|
my $opts = { map {s/^nz//; ($_=>$_[0]{$_})} grep {/^nz/} keys %{$_[0]//{}} }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
63
|
0
|
|
0
|
|
|
|
$opts->{$_} //= $_[1]{$_} foreach (keys %{$_[1]//{}}); |
|
0
|
|
0
|
|
|
|
|
64
|
0
|
|
|
|
|
|
return $opts; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
## $fh_or_undef = _ccsio_open($filename_or_handle,$mode) |
68
|
|
|
|
|
|
|
sub _ccsio_open { |
69
|
0
|
|
|
0
|
|
|
my ($file,$mode) = @_; |
70
|
0
|
0
|
|
|
|
|
return $file if (ref($file)); |
71
|
0
|
0
|
|
|
|
|
$mode = '<' if (!defined($mode)); |
72
|
0
|
|
|
|
|
|
open(my $fh, $mode, $file); |
73
|
0
|
|
|
|
|
|
return $fh; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
## $fh_or_undef = _ccsio_close($filename_or_handle,$fh) |
77
|
|
|
|
|
|
|
sub _ccsio_close { |
78
|
0
|
|
|
0
|
|
|
my ($file,$fh) = @_; |
79
|
0
|
0
|
|
|
|
|
return 1 if (ref($file)); ##-- don't close if we got a handle |
80
|
0
|
|
|
|
|
|
return close($fh); |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
## \%header = _ccsio_read_header( $hfile) |
85
|
|
|
|
|
|
|
sub _ccsio_read_header { |
86
|
0
|
|
|
0
|
|
|
my $hFile = shift; |
87
|
0
|
0
|
|
|
|
|
my $hfh = _ccsio_open($hFile,'<') |
88
|
|
|
|
|
|
|
or confess("_ccsio_read_header(): open failed for header-file $hFile: $!"); |
89
|
0
|
|
|
|
|
|
binmode($hfh,':raw'); |
90
|
0
|
|
|
|
|
|
my @hlines = <$hfh>; |
91
|
0
|
0
|
|
|
|
|
_ccsio_close($hFile,$hfh) |
92
|
|
|
|
|
|
|
or confess("_ccsio_read_header(): close failed for header-file $hFile: $!"); |
93
|
0
|
|
|
|
|
|
return _ccsio_parse_header(\@hlines); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
## \%header = _ccsio_parse_header(\@hlines) |
97
|
|
|
|
|
|
|
sub _ccsio_parse_header { |
98
|
0
|
|
|
0
|
|
|
my $hlines = shift; |
99
|
0
|
|
|
|
|
|
my ($magic,$pdims,$vdims,$flags,$iotype) = map {chomp;$_} @$hlines; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
return { |
101
|
0
|
0
|
0
|
|
|
|
magic=>$magic, |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
102
|
|
|
|
|
|
|
(defined($pdims) && $pdims ne '' ? (pdims=>pdl(ccs_indx(),[split(' ',$pdims)])) : qw()), |
103
|
|
|
|
|
|
|
(defined($vdims) && $vdims ne '' ? (vdims=>pdl(ccs_indx(),[split(' ',$vdims)])) : qw()), |
104
|
|
|
|
|
|
|
(defined($flags) && $flags ne '' ? (flags=>$flags) : qw()), |
105
|
|
|
|
|
|
|
(defined($iotype) && $iotype ne '' ? (iotype=>$iotype) : qw()), ##-- added in v1.22.6 |
106
|
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
## $bool = _ccsio_write_header(\%header, $hfile) |
110
|
|
|
|
|
|
|
## $bool = _ccsio_write_header( $ccs, $hfile) |
111
|
|
|
|
|
|
|
sub _ccsio_write_header { |
112
|
0
|
|
|
0
|
|
|
my ($header,$hFile) = @_; |
113
|
0
|
0
|
|
|
|
|
my $hfh = _ccsio_open($hFile,'>') |
114
|
|
|
|
|
|
|
or confess("_ccsio_write_header(): open failed for header-file $hFile: $!"); |
115
|
0
|
|
|
|
|
|
binmode($hfh,':raw'); |
116
|
0
|
|
|
|
|
|
local $, = ''; |
117
|
0
|
|
|
|
|
|
print $hfh @{_ccsio_header_lines($header)}; |
|
0
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
_ccsio_close($hFile,$hfh) |
119
|
|
|
|
|
|
|
or confess("_ccsio_write_header(): close failed for header-file $hFile: $!"); |
120
|
0
|
|
|
|
|
|
return 1; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
## \@header_lines = _ccsio_header_lines(\%header) |
124
|
|
|
|
|
|
|
## \@header_lines = _ccsio_header_lines( $ccs) |
125
|
|
|
|
|
|
|
sub _ccsio_header_lines { |
126
|
0
|
|
|
0
|
|
|
my $header = shift; |
127
|
0
|
0
|
|
|
|
|
$header = _ccsio_header($header) if (UNIVERSAL::isa($header,'PDL::CCS::Nd')); |
128
|
|
|
|
|
|
|
return [ |
129
|
0
|
|
|
|
|
|
map {"$_\n"} |
130
|
|
|
|
|
|
|
(defined($header->{magic}) ? $header->{magic} : ''), |
131
|
|
|
|
|
|
|
(defined($header->{pdims}) ? (join(' ', $header->{pdims}->list)) : ''), |
132
|
|
|
|
|
|
|
(defined($header->{vdims}) ? (join(' ', $header->{vdims}->list)) : ''), |
133
|
|
|
|
|
|
|
(defined($header->{flags}) ? $header->{flags} : $PDL::CCS::Nd::CCSND_FLAGS_DEFAULT), |
134
|
0
|
0
|
|
|
|
|
(defined($header->{iotype}) ? $header->{iotype} : $PDL::IO::Misc::deftype), |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
135
|
|
|
|
|
|
|
]; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
## \%header = _ccsio_header( $ccs) |
139
|
|
|
|
|
|
|
## \%header = _ccsio_header(\%header) |
140
|
|
|
|
|
|
|
sub _ccsio_header { |
141
|
0
|
|
|
0
|
|
|
my $ccs = shift; |
142
|
0
|
0
|
|
|
|
|
return $ccs if (!UNIVERSAL::isa($ccs,'PDL::CCS::Nd')); |
143
|
|
|
|
|
|
|
return { |
144
|
0
|
|
|
|
|
|
magic=>(ref($ccs)." $VERSION"), |
145
|
|
|
|
|
|
|
pdims=>$ccs->pdims, |
146
|
|
|
|
|
|
|
vdims=>$ccs->vdims, |
147
|
|
|
|
|
|
|
flags=>$ccs->flags, |
148
|
|
|
|
|
|
|
iotype=>$ccs->type, |
149
|
|
|
|
|
|
|
}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
1; ##-- be happy |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
##====================================================================== |
157
|
|
|
|
|
|
|
## POD: footer |
158
|
|
|
|
|
|
|
=pod |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Perl by Larry Wall. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
##--------------------------------------------------------------------- |
170
|
|
|
|
|
|
|
=pod |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head1 AUTHOR |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Bryan Jurish Emoocow@cpan.orgE |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 Copyright Policy |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Copyright (C) 2015-2018, Bryan Jurish. All rights reserved. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This package is free software, and entirely without warranty. |
181
|
|
|
|
|
|
|
You may redistribute it and/or modify it under the same terms |
182
|
|
|
|
|
|
|
as Perl itself. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 SEE ALSO |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
L, |
187
|
|
|
|
|
|
|
L, |
188
|
|
|
|
|
|
|
L, |
189
|
|
|
|
|
|
|
L, |
190
|
|
|
|
|
|
|
L, |
191
|
|
|
|
|
|
|
L, |
192
|
|
|
|
|
|
|
L, |
193
|
|
|
|
|
|
|
... |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=cut |