"Fossies" - the Fresh Open Source Software Archive 
Member "PDL-2.025/GENERATED/PDL/IO/HDF.pm" (19 Nov 2020, 13988 Bytes) of package /linux/misc/PDL-2.025.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
For more information about "HDF.pm" see the
Fossies "Dox" file reference documentation and the latest
Fossies "Diffs" side-by-side code changes report:
2.024_vs_2.025.
1
2 #
3 # GENERATED WITH PDL::PP! Don't modify!
4 #
5 package PDL::IO::HDF;
6
7 @EXPORT_OK = qw( );
8 %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
9
10 use PDL::Core;
11 use PDL::Exporter;
12 use DynaLoader;
13
14
15
16
17 @ISA = ( 'PDL::Exporter','DynaLoader' );
18 push @PDL::Core::PP, __PACKAGE__;
19 bootstrap PDL::IO::HDF ;
20
21
22
23
24
25 =head1 NAME
26
27 PDL::IO::HDF - An interface library for HDF4 files.
28
29 =head1 SYNOPSIS
30
31 use PDL;
32 use PDL::IO::HDF::VS;
33
34 #### no doc for now ####
35
36 =head1 DESCRIPTION
37
38 This library provides functions to manipulate
39 HDF4 files with VS and V interface (reading, writing, ...)
40
41 For more information on HDF4, see http://www.hdfgroup.org/products/hdf4/
42
43 =head1 FUNCTIONS
44
45 =cut
46
47
48
49
50
51
52
53
54 use PDL::Primitive;
55 use PDL::Basic;
56 use strict;
57
58 use PDL::IO::HDF;
59
60 my $TMAP = {
61 PDL::byte->[0] => 1,
62 PDL::short->[0] => 2,
63 PDL::ushort->[0] => 2,
64 PDL::long->[0] => 4,
65 PDL::float->[0] => 4,
66 PDL::double->[0] => 8
67 };
68
69 sub _pkg_name
70 { return "PDL::IO::HDF::VS::" . shift() . "()"; }
71
72 =head2 new
73
74 =for ref
75
76 Open or create a new HDF object with VS and V interface.
77
78 =for usage
79
80 Arguments:
81 1 : The name of the HDF file.
82 If you want to write to it, prepend the name with the '+' character : "+name.hdf"
83 If you want to create it, prepend the name with the '-' character : "-name.hdf"
84 Otherwise the file will be opened in read only mode.
85
86 Returns the hdf object (die on error)
87
88 =for example
89
90 my $hdf = PDL::IO::HDF::VS->new("file.hdf");
91
92 =cut
93
94 sub new
95 {
96 # general
97 my $type = shift;
98 my $filename = shift;
99
100 my $self = {};
101
102 if (substr($filename, 0, 1) eq '+')
103 { # open for writing
104 $filename = substr ($filename, 1); # chop off +
105 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ;
106 }
107 if (substr($filename, 0, 1) eq '-')
108 { # Creating
109 $filename = substr ($filename, 1); # chop off -
110 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE;
111 }
112
113 unless( defined($self->{ACCESS_MODE}) )
114 {
115 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ;
116 }
117
118 $self->{FILE_NAME} = $filename;
119
120 $self->{HID} = PDL::IO::HDF::VS::_Hopen( $self->{FILE_NAME}, $self->{ACCESS_MODE}, 20 );
121 if ($self->{HID})
122 {
123 PDL::IO::HDF::VS::_Vstart( $self->{HID} );
124
125 my $SDID = PDL::IO::HDF::VS::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} );
126
127 #### search for vgroup
128 my $vgroup = {};
129
130 my $vg_ref = -1;
131 while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL)
132 {
133 my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' );
134
135 my $n_entries = 0;
136
137 my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
138 my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );
139
140 my $vg_class = "";
141 PDL::IO::HDF::VS::_Vgetclass( $vg_id, $vg_class );
142
143 $vgroup->{$vg_name}->{ref} = $vg_ref;
144 $vgroup->{$vg_name}->{class} = $vg_class;
145
146 my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );
147
148 for ( 0 .. $n_pairs-1 )
149 {
150 my ($tag, $ref);
151 $res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );
152 if($tag == 1965)
153 { # Vgroup
154 my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );
155 my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
156 my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );
157 PDL::IO::HDF::VS::_Vdetach( $id );
158 $vgroup->{$vg_name}->{children}->{$name} = $ref;
159 $vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;
160 }
161 elsif($tag == 1962)
162 { # Vdata
163 my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r' );
164 my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
165 my $res = PDL::IO::HDF::VS::_VSgetname( $id, $name );
166 my $class = "";
167 PDL::IO::HDF::VS::_VSgetclass( $id, $class );
168 PDL::IO::HDF::VS::_VSdetach( $id );
169 $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';
170 $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
171 $vgroup->{$vg_name}->{attach}->{$name}->{class} = $class
172 if( $class ne '' );
173 }
174 if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)
175 {
176 my $i = _SDreftoindex( $SDID, $ref );
177 my $sds_ID = _SDselect( $SDID, $i );
178
179 my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
180 my $rank = 0;
181 my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 );
182 my $numtype = 0;
183 my $nattrs = 0;
184
185 $res = _SDgetinfo( $sds_ID, $name, $rank, $dimsize , $numtype, $nattrs );
186
187 $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'SDS_Data';
188 $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
189 }
190 } # for each pair...
191
192 PDL::IO::HDF::VS::_Vdetach( $vg_id );
193 } # while vg_ref...
194
195 PDL::IO::HDF::VS::_SDend( $SDID );
196 $self->{VGROUP} = $vgroup;
197
198 #### search for vdata
199 my $vdata_ref=-1;
200 my $vdata_id=-1;
201 my $vdata = {};
202
203 # get lone vdata (not member of a vgroup)
204 my $lone=PDL::IO::HDF::VS::_VSlone($self->{HID});
205
206 my $MAX_REF = 0;
207 while ( $vdata_ref = shift @$lone )
208 {
209 my $mode="r";
210 if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )
211 {
212 $mode="w";
213 }
214 $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $mode );
215 my $vdata_size = 0;
216 my $n_records = 0;
217 my $interlace = 0;
218 my $fields = "";
219 my $vdata_name = "";
220
221 my $status = PDL::IO::HDF::VS::_VSinquire(
222 $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
223 die "PDL::IO::HDF::VS::_VSinquire (vdata_id=$vdata_id)"
224 unless $status;
225 $vdata->{$vdata_name}->{REF} = $vdata_ref;
226 $vdata->{$vdata_name}->{NREC} = $n_records;
227 $vdata->{$vdata_name}->{INTERLACE} = $interlace;
228
229 $vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdata_id );
230
231 my $field_index = 0;
232 foreach my $onefield ( split( ",", $fields ) )
233 {
234 $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =
235 PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, $field_index );
236 $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{INDEX} = $field_index;
237 $field_index++;
238 }
239
240 PDL::IO::HDF::VS::_VSdetach( $vdata_id );
241 } # while vdata_ref...
242
243 $self->{VDATA} = $vdata;
244 } # if $self->{HDID}...
245
246 bless($self, $type);
247 } # End of new()...
248
249 sub Vgetchildren
250 {
251 my ($self, $name) = @_;
252 return( undef )
253 unless defined( $self->{VGROUP}->{$name}->{children} );
254
255 return keys %{$self->{VGROUP}->{$name}->{children}};
256 } # End of Vgetchildren()...
257 # Now defunct:
258 sub Vgetchilds
259 {
260 my $self = shift;
261 return $self->Vgetchildren( @_ );
262 } # End of Vgetchilds()...
263
264 sub Vgetattach
265 {
266 my ($self, $name) = @_;
267 return( undef )
268 unless defined( $self->{VGROUP}->{$name}->{attach} );
269
270 return keys %{$self->{VGROUP}->{$name}->{children}};
271 } # End of Vgetattach()...
272
273 sub Vgetparents
274 {
275 my ($self, $name) = @_;
276 return( undef )
277 unless defined( $self->{VGROUP}->{$name}->{parents} );
278
279 return keys %{$self->{VGROUP}->{$name}->{parents}};
280 } # End of Vgetparents()...
281
282 sub Vgetmains
283 {
284 my ($self) = @_;
285 my @rlist;
286 foreach( keys %{$self->{VGROUP}} )
287 {
288 push(@rlist, $_)
289 unless defined( $self->{VGROUP}->{$_}->{parents} );
290 }
291 return @rlist;
292 } # End of Vgetmains()...
293
294 sub Vcreate
295 {
296 my($self, $name, $class, $where) = @_;
297
298 my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, -1, 'w' );
299 return( undef )
300 if( $id == PDL::IO::HDF->FAIL );
301
302 my $res = _Vsetname($id, $name);
303 $res = _Vsetclass($id, $class)
304 if defined( $class );
305
306 $self->{VGROUP}->{$name}->{ref} = '???';
307 $self->{VGROUP}->{$name}->{class} = $class
308 if defined( $class );
309
310 if( defined( $where ) )
311 {
312 return( undef )
313 unless defined( $self->{VGROUP}->{$where} );
314
315 my $ref = $self->{VGROUP}->{$where}->{ref};
316
317 my $Pid = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'w' );
318 my $index = PDL::IO::HDF::VS::_Vinsert( $Pid, $id );
319 my ($t, $r) = (0, 0);
320 $res = PDL::IO::HDF::VS::_Vgettagref( $Pid, $index, $t, $r );
321 PDL::IO::HDF::VS::_Vdetach( $Pid );
322
323 $self->{VGROUP}->{$name}->{parents}->{$where} = $ref;
324 $self->{VGROUP}->{$where}->{children}->{$name} = $r;
325 $self->{VGROUP}->{$name}->{ref} = $r;
326 }
327 return( _Vdetach( $id ) + 1 );
328 } # End of Vcreate()...
329
330 =head2 close
331
332 =for ref
333
334 Close the VS interface.
335
336 =for usage
337
338 no arguments
339
340 =for example
341
342 my $result = $hdf->close();
343
344 =cut
345
346 sub close
347 {
348 my $self = shift;
349 _Vend( $self->{HID} );
350 my $Hid = $self->{HID};
351 $self = undef;
352 return( _Hclose($Hid) + 1 );
353 } # End of close()...
354
355 sub VSisattr
356 {
357 my($self, $name) = @_;
358
359 return undef
360 unless defined( $self->{VDATA}->{$name} );
361
362 return $self->{VDATA}->{$name}->{ISATTR};
363 } # End of VSisattr()...
364
365 sub VSgetnames
366 {
367 my $self = shift;
368 return keys %{$self->{VDATA}};
369 } # End of VSgetnames()...
370
371 sub VSgetfieldnames
372 {
373 my ( $self, $name ) = @_;
374
375 my $sub = _pkg_name( 'VSgetfieldnames' );
376
377 die "$sub: vdata name $name doesn't exist!\n"
378 unless defined( $self->{VDATA}->{$name} );
379
380 return keys %{$self->{VDATA}->{$name}->{FIELDS}};
381 } # End of VSgetfieldnames()...
382 # Now defunct:
383 sub VSgetfieldsnames
384 {
385 my $self = shift;
386 return $self->VSgetfieldnames( @_ );
387 } # End of VSgetfieldsnames()...
388
389
390 sub VSread
391 {
392 my ( $self, $name, $field ) = @_;
393 my $sub = _pkg_name( 'VSread' );
394
395 my $data = null;
396 my $vdata_ref = PDL::IO::HDF::VS::_VSfind( $self->{HID}, $name );
397
398 die "$sub: vdata name $name doesn't exist!\n"
399 unless $vdata_ref;
400
401 my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );
402 my $vdata_size = 0;
403 my $n_records = 0;
404 my $interlace = 0;
405 my $fields = "";
406 my $vdata_name = "";
407 my $status = PDL::IO::HDF::VS::_VSinquire(
408 $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
409 my $data_type = PDL::IO::HDF::VS::_VFfieldtype(
410 $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
411
412 die "$sub: data_type $data_type not implemented!\n"
413 unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );
414
415 my $order = PDL::IO::HDF::VS::_VFfieldorder(
416 $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
417
418 if($order == 1)
419 {
420 $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );
421 }
422 else
423 {
424 $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $order );
425 }
426 $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );
427
428 die "$sub: _VSsetfields\n"
429 unless $status;
430
431 $status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace);
432
433 PDL::IO::HDF::VS::_VSdetach( $vdata_id );
434 return $data;
435 } # End of VSread()...
436
437 sub VSwrite
438 {
439 my($self, $name, $mode, $field, $value) = @_;
440
441 return( undef )
442 if( $$value[0]->getndims > 2); #too many dims
443
444 my $VD_id;
445 my $res;
446 my @foo = split( /:/, $name );
447
448 return( undef )
449 if defined( $self->{VDATA}->{$foo[0]} );
450
451 $VD_id = _VSattach( $self->{HID}, -1, 'w' );
452
453 return( undef )
454 if( $VD_id == PDL::IO::HDF->FAIL );
455
456 $res = _VSsetname( $VD_id, $foo[0] );
457 return( undef )
458 if( $res == PDL::IO::HDF->FAIL );
459
460 $res = _VSsetclass( $VD_id, $foo[1] )
461 if defined( $foo[1] );
462 return( undef )
463 if( $res == PDL::IO::HDF->FAIL );
464
465 my @listfield = split( /,/, $field );
466 for( my $i = 0; $i <= $#$value; $i++ )
467 {
468 my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$$value[$i]->get_datatype()};
469 $res = _VSfdefine( $VD_id, $listfield[$i], $HDFtype, $$value[$i]->getdim(1) );
470 return( undef )
471 unless $res;
472 }
473
474 $res = _VSsetfields( $VD_id, $field );
475 return( undef )
476 unless $res;
477
478 my @sizeofPDL;
479 my @sdimofPDL;
480 foreach ( @$value )
481 {
482 push(@sdimofPDL, $_->getdim(1));
483 push(@sizeofPDL, $TMAP->{$_->get_datatype()});
484 }
485 $res = _WriteMultPDL( $VD_id, $$value[0]->getdim(0), $#$value+1, $mode, \@sizeofPDL, \@sdimofPDL, $value);
486
487 return( undef )
488 if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL );
489 return $res;
490 } # End of VSwrite()...
491
492
493 sub DESTROY
494 {
495 my $self = shift;
496 $self->close;
497 } # End of DESTROY()...
498
499
500
501
502 =head1 CURRENT AUTHOR & MAINTAINER
503
504 Judd Taylor, Orbital Systems, Ltd.
505 judd dot t at orbitalsystems dot com
506
507 =head1 PREVIOUS AUTHORS
508
509 Olivier Archer olivier.archer@ifremer.fr
510 contribs of Patrick Leilde patrick.leilde@ifremer.fr
511
512 =head1 SEE ALSO
513
514 perl(1), PDL(1), PDL::IO::HDF(1).
515
516 =cut
517
518
519
520
521 ;
522
523
524
525 # Exit with OK status
526
527 1;
528
529