File Coverage

/root/.cpan/build/PDL-CCS-1.23.11-0/blib/lib/PDL/CCS/IO/FastRaw.pm
Criterion Covered Total %
statement 24 62 38.7
branch 0 36 0.0
condition 0 46 0.0
subroutine 8 11 72.7
pod 3 3 100.0
total 35 158 22.1


line stmt bran cond sub pod time code
1             ## File: PDL::CCS::IO::FastRaw.pm
2             ## Author: Bryan Jurish
3             ## Description: PDL::IO::FastRaw wrappers for PDL::CCS::Nd
4              
5             package PDL::CCS::IO::FastRaw;
6 4     4   1599 use PDL::CCS::Version;
  4         15  
  4         166  
7 4     4   23 use PDL::CCS::Config qw(ccs_indx);
  4         10  
  4         246  
8 4     4   25 use PDL::CCS::Nd;
  4         6  
  4         93  
9 4     4   1784 use PDL::CCS::IO::Common qw(:intern);
  4         11  
  4         29  
10 4     4   551 use PDL;
  4         13  
  4         17  
11 4     4   13109 use PDL::IO::FastRaw;
  4         14069  
  4         39  
12 4     4   497 use Carp qw(confess);
  4         9  
  4         181  
13 4     4   25 use strict;
  4         10  
  4         4363  
14              
15             our $VERSION = '1.23.11';
16             our @ISA = ('PDL::Exporter');
17             our @EXPORT_OK = qw(ccs_writefraw ccs_readfraw ccs_mapfraw);
18             our %EXPORT_TAGS =
19             (
20             Func => [@EXPORT_OK], ##-- respect PDL conventions (hopefully)
21             );
22              
23              
24              
25             ##======================================================================
26             ## pod: headers
27             =pod
28              
29             =head1 NAME
30              
31             PDL::CCS::IO::FastRaw - PDL::IO::FastRaw wrappers for PDL::CCS::Nd
32              
33             =head1 SYNOPSIS
34              
35             use PDL;
36             use PDL::CCS::Nd;
37             use PDL::CCS::IO::FastRaw;
38              
39             $ccs = PDL::CCS::Nd->newFromWhich($which,$nzvals);
40              
41             ccs_writefraw($ccs,$fname); # write a pair of raw files
42             $ccs2 = ccs_readfraw($fname); # read a pair of raw files
43              
44             $ccs3 = ccs_mapfraw($fname,{ReadOnly=>1}); # mmap a pair of files, don't read yet
45              
46             =cut
47              
48             ##======================================================================
49             ## I/O utilities
50             =pod
51              
52             =head1 I/O Utilities
53              
54             =cut
55              
56             ##---------------------------------------------------------------
57             ## ccs_writefraw
58             =pod
59              
60             =head2 ccs_writefraw
61              
62             Write a pair of raw binary files using PDL::IO::FastRaw::writefraw().
63              
64             ccs_writefraw($ccs,$fname)
65             ccs_writefraw($ccs,$fname,\%opts)
66              
67             Options %opts:
68              
69             Header => $Header, ##-- default="$fname.hdr"
70             ixFile => $ixFile, ##-- default="$fname.ix"
71             ixHeader => $ixHeader, ##-- default="$ixFile.hdr"
72             nzFile => $nzFile, ##-- default="$fname.nz"
73             nzHeader => $nzHeader, ##-- default="$nzFile.hdr"
74              
75             =cut
76              
77             *PDL::ccs_writefraw = *PDL::CCS::Nd::writefraw = \&ccs_writefraw;
78             sub ccs_writefraw {
79 0     0 1   my ($ccs,$fname,$opts) = @_;
80              
81             ##-- get filenames
82 0   0       my $hFile = $opts->{Header} // "$fname.hdr";
83 0   0       my $ixFile = $opts->{ixFile} // "$fname.ix";
84 0   0       my $nzFile = $opts->{nzFile} // "$fname.nz";
85              
86             ##-- write header
87 0 0         _ccsio_write_header($ccs, $hFile)
88             or confess("ccs_writefraw(): failed to write header-file $hFile: $!");
89              
90             ##-- write pdls
91 0 0         PDL::writefraw($ccs->_whichND, $ixFile, _ccsio_opts_ix($opts))
92             or confess("ccs_writefraw(): failed to write index-file $ixFile: $!");
93 0 0         PDL::writefraw($ccs->_vals, $nzFile, _ccsio_opts_nz($opts))
94             or confess("ccs_writefraw(): failed to write values-file $nzFile: $!");
95              
96 0           return 1;
97             }
98              
99              
100             ##---------------------------------------------------------------
101             ## ccs_readfraw
102             =pod
103              
104             =head2 ccs_readfraw
105              
106             Read a pair of raw binary files using PDL::IO::FastRaw::readfraw().
107              
108             $ccs = ccs_readfraw($fname)
109             $ccs = ccs_readfraw($fname,\%opts)
110              
111             Options %opts:
112              
113             Header => $Header, ##-- default="$fname.hdr"
114             ixFile => $ixFile, ##-- default="$fname.ix"
115             ixHeader => $ixHeader, ##-- default="$ixFile.hdr"
116             nzFile => $nzFile, ##-- default="$fname.nz"
117             nzHeader => $nzHeader, ##-- default="$nzFile.hdr"
118             sorted => $bool, ##-- is data on disk already sorted? (default=1)
119              
120             =cut
121              
122             *PDL::ccs_readfraw = *PDL::CCS::Nd::readfraw = \&ccs_readfraw;
123             sub ccs_readfraw {
124 0 0 0 0 1   shift if (UNIVERSAL::isa($_[0],'PDL') || UNIVERSAL::isa($_[0],'PDL::CCS::Nd'));
125 0           my ($file,$opts) = @_;
126              
127             ##-- get filenames
128 0   0       my $hFile = $opts->{Header} // "$file.hdr";
129 0   0       my $ixFile = $opts->{ixFile} // "$file.ix";
130 0   0       my $nzFile = $opts->{nzFile} // "$file.nz";
131              
132             ##-- read header
133 0 0         my $header = _ccsio_read_header($hFile)
134             or confess("ccs_readfraw(): failed to read header-file $hFile: $!");
135              
136             ##-- read pdls
137 0 0         defined(my $ix = PDL->readfraw($ixFile, _ccsio_opts_ix($opts)))
138             or confess("ccs_readfraw(): failed to read index-file $ixFile: $!");
139 0 0         defined(my $nz = PDL->readfraw($nzFile, _ccsio_opts_nz($opts)))
140             or confess("ccs_readfraw(): failed to read values-file $nzFile: $!");
141              
142             ##-- construct and return
143             return PDL::CCS::Nd->newFromWhich($ix,$nz,
144             pdims=>$header->{pdims},
145             vdims=>$header->{vdims},
146             flags=>$header->{flags},
147 0   0       sorted=>($opts->{sorted}//1),
148             steal=>1);
149             }
150              
151              
152             ##---------------------------------------------------------------
153             ## ccs_mapfraw
154             =pod
155              
156             =head2 ccs_mapfraw
157              
158             Read a pair of raw binary files using PDL::IO::FastRaw::readfraw().
159              
160             $ccs = ccs_mapfraw($fname)
161             $ccs = ccs_mapfraw($fname,\%opts)
162              
163             Global options in %opts:
164              
165             Header => $Header, ##-- default="$fname.hdr"
166             ReadOnly => $bool, ##-- read-only mode?
167             Dims => \@dims, ##-- logical dimensions (~ \@pdims)
168             Datatype => $type, ##-- CCS::Nd datatype
169             Creat => $bool, ##-- create file(s)?
170             Trunc => $bool, ##-- truncate file(s)?
171              
172             CCS::Nd options in %opts:
173              
174             flags => $flags, ##-- CCS::Nd flags
175             nnz => $nnz, ##-- CCS::Nd nnz
176             pdims => \@pdims, ##-- CCS::Nd physical dimensions
177             vdims => \@vdims, ##-- CCS::Nd virtual dimensions
178             sorted => $bool, ##-- is data on disk sorted? (default=1)
179              
180             Component options in %opts, for ${c} in qw(ix nz):
181              
182             "${c}${opt}" => $cValue, ##-- override global option ${opt}
183             "${c}File" => $cFile, ##-- default="$fname.${c}"
184             "${c}Header" => $cHeader, ##-- default="$cFile.hdr"
185              
186             =cut
187              
188             *PDL::ccs_mapfraw = *PDL::CCS::Nd::mapfraw = \&ccs_mapfraw;
189             sub ccs_mapfraw {
190 0 0 0 0 1   shift if (UNIVERSAL::isa($_[0],'PDL') || UNIVERSAL::isa($_[0],'PDL::CCS::Nd'));
191 0           my ($file,$opts) = @_;
192              
193             ##-- get filenames
194 0   0       my $hFile = $opts->{Header} // "$file.hdr";
195 0   0       my $ixFile = $opts->{ixFile} // "$file.ix";
196 0   0       my $nzFile = $opts->{nzFile} // "$file.nz";
197              
198             ##-- get ccs header
199             my $header = {
200             pdims => ($opts->{pdims} // $opts->{Dims}),
201             vdims => $opts->{vdims},
202 0   0       flags => ($opts->{flags} // $PDL::CCS::Nd::CCSND_FLAGS_DEFAULT),
      0        
203             };
204 0 0         if (!defined($header->{pdims})) {
205 0 0         my $hdr = _ccsio_read_header($hFile)
206             or confess("ccs_mapfraw(): failed to read header-file $hFile: $!");
207 0   0       $header->{$_} //= $hdr->{$_} foreach (keys %$hdr);
208             }
209 0 0         $header->{pdims} = PDL->topdl(ccs_indx(),$header->{pdims}) if (!ref($header->{pdims}));
210 0 0         $header->{vdims} = $header->{pdims}->sequence if (!defined($header->{vdims}));
211 0 0         $header->{vdims} = PDL->topdl(ccs_indx(),$header->{vdims}) if (!ref($header->{vdims}));
212              
213             ##-- get component options
214 0           my %defaults = (map {($_=>$opts->{$_})} grep {exists($opts->{$_})} qw(Creat Trunc ReadOnly));
  0            
  0            
215 0           my $nnz = $opts->{nnz};
216 0 0         my $ixopts = _ccsio_opts_ix($opts, {%defaults, (defined($nnz) ? (Dims=>[$header->{pdims}->ndims,$nnz]) : qw())});
217 0 0         my $nzopts = _ccsio_opts_nz($opts, {%defaults, (defined($nnz) ? (Dims=>[$nnz+1]) : qw()), (defined($opts->{Datatype}) ? (Datatype=>$opts->{Datatype}) : qw())});
    0          
218              
219             ##-- map pdls
220 0 0         defined(my $ix = PDL->mapfraw($ixFile, $ixopts))
221             or confess("ccs_mapfraw(): failed to map ix-file $ixFile: $!");
222 0 0         defined(my $nz = PDL->mapfraw($nzFile, $nzopts))
223             or confess("ccs_mapfraw(): failed to map values-file $nzFile: $!");
224              
225             ##-- construct and return
226             return PDL::CCS::Nd->newFromWhich($ix,$nz,
227             pdims=>$header->{pdims},
228             vdims=>$header->{vdims},
229             flags=>$header->{flags},
230 0   0       sorted=>($opts->{sorted}//1),
231             steal=>1);
232             }
233              
234             1; ##-- be happy
235              
236             ##======================================================================
237             ## POD: footer
238             =pod
239              
240             =head1 ACKNOWLEDGEMENTS
241              
242             Perl by Larry Wall.
243              
244             PDL by Karl Glazebrook, Tuomas J. Lukka, Christian Soeller, and others.
245              
246             =cut
247              
248              
249             ##---------------------------------------------------------------------
250             =pod
251              
252             =head1 AUTHOR
253              
254             Bryan Jurish Emoocow@cpan.orgE
255              
256             =head2 Copyright Policy
257              
258             Copyright (C) 2015-2018, Bryan Jurish. All rights reserved.
259              
260             This package is free software, and entirely without warranty.
261             You may redistribute it and/or modify it under the same terms
262             as Perl itself.
263              
264             =head1 SEE ALSO
265              
266             L,
267             L,
268             L,
269             L,
270             L,
271             L,
272             ...
273              
274             =cut
275              
276              
277             1; ##-- make perl happy