"Fossies" - the Fresh Open Source Software Archive 
Member "PDL-2.025/IO/HDF/VS/VS.pd" (19 Nov 2020, 22918 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) C and C++ 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.
See also the latest
Fossies "Diffs" side-by-side code changes report for "VS.pd":
2.024_vs_2.025.
1 pp_addpm({At => Top}, <<'EOD');
2
3 =head1 NAME
4
5 PDL::IO::HDF - An interface library for HDF4 files.
6
7 =head1 SYNOPSIS
8
9 use PDL;
10 use PDL::IO::HDF::VS;
11
12 #### no doc for now ####
13
14 =head1 DESCRIPTION
15
16 This library provides functions to manipulate
17 HDF4 files with VS and V interface (reading, writing, ...)
18
19 For more information on HDF4, see http://www.hdfgroup.org/products/hdf4/
20
21 =head1 FUNCTIONS
22
23 =cut
24
25 EOD
26
27
28 pp_addhdr(<<'EOH');
29
30 #include <hdf.h>
31 #include <mfhdf.h>
32 #include <string.h>
33 #include <stdio.h>
34
35 #include <perl.h>
36 #include <EXTERN.h>
37 #include <XSUB.h>
38
39 #define PDLchar pdl
40 #define PDLuchar pdl
41 #define PDLshort pdl
42 #define PDLint pdl
43 #define PDLlong pdl
44 #define PDLfloat pdl
45 #define PDLdouble pdl
46 #define PDLvoid pdl
47 #define uchar unsigned char
48
49 #define PDLlist pdl
50
51 EOH
52
53 #define AVRef AV
54 #pp_bless ("PDL::IO::HDF::VS");
55
56 use FindBin;
57 use lib "$FindBin::Bin/..";
58 use buildfunc;
59
60
61 #-------------------------------------------------------------------------
62 # Create low level interface from HDF VS and V header file.
63 #-------------------------------------------------------------------------
64
65 create_low_level (<<'EODEF');
66 #
67 # HDF (H) Interface
68 #
69 int Hishdf(const char *filename);
70 int Hopen(const char *filename, int access, int n_dds);
71 int Hclose(int file_id)+1;
72 #
73 # VGROUP/VDATA Interface
74 #
75 int Vstart(int hdfid);
76 int Vend(int hdfid);
77 int Vgetid(int hdfid, int vgroup_ref);
78 int Vattach(int hdfid, int vgroup_ref, const char *access);
79 int Vdetach(int vgroup_id);
80 int Vntagrefs(int vgroup_id);
81
82 int Vgettagref(int vgroup_id, int index, int *tag, int *ref);
83 int Vinquire(int vgroup_id, int *n_entries, char *vgroup_name);
84
85 int Vsetname(int vgroup_id, const char *vgroup_name);
86 int Vsetclass(int vgroup_id, const char *vgroup_class);
87 int Visvg(int vgroup_id, int obj_ref);
88 int Visvs(int vgroup_id, int obj_ref);
89 int Vaddtagref(int vgroup_id, int tag, int ref);
90 int Vinsert(int vgroup_id, int v_id);
91
92 int VSsetname(int vdata_id, const char *vdata_name);
93 int VSsetclass(int vdata_id, const char *vdata_class);
94 int VSgetid(int hdfid, int vdata_ref);
95 int VSattach(int hdfid, int vdata_ref, const char *access);
96 int VSdetach(int vdata_id);
97 int VSelts(int vdata_id);
98 int VSsizeof(int vdata_id, const char *fields);
99 int VSfind(int hdfid, const char *vdata_name);
100 int VFfieldtype(int vdata_id, int field_index);
101 int VFnfields(int vdata_ref);
102 int VFfieldorder(int vdata_ref, int field_index);
103
104 int VSfdefine(int vata_id, const char *fieldname, int data_type, int order)+1;
105 int VSsetfields(int vata_id, const char *fieldname_list)+1;
106 int VSwrite(int vdata_id, const PDLvoid *databuf, int n_records, int interlace_mode);
107 int VSread(int vdata_id, PDLvoid *databuf, int n_records, int interlace_mode);
108 #int VSlone(int file_id, int *ref_array, int max_ref);
109
110 int VSfnattrs(int vdata_id, int field_index);
111 int VSgetattr(int vdata_id, int field_index, int attr_index, PDLlong *values);
112 int VSisattr(int vdata_id);
113
114 int SDstart(const char *filename, int access_mode);
115 int SDreftoindex(int sd_id, int sds_ref);
116 int SDselect(int sd_id, int index);
117 int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_type, int *nattrs);
118 int SDendaccess(int sds_id);
119 int SDend(int sd_id);
120
121 EODEF
122
123 pp_addxs('',<<'ENDOFXS');
124
125 int
126 _WriteMultPDL(VID, nb_records, nb_fields, interlace_mode, ...);
127 int VID
128 int nb_records
129 int nb_fields
130 int interlace_mode
131 PROTOTYPE: @
132 CODE:
133 unsigned char *databuff, *ptrbuff;
134 unsigned long int total_size;
135 int i, j, k, curvalue, cursdim;
136 SV * sizeofPDL;
137 SV * listofPDL;
138 SV * sdimofPDL;
139 SV * * SvTmp1, * * SvTmp2, * * SvTmp3;
140 pdl *curPDL;
141
142 sizeofPDL = SvRV( ST(4) );
143 sdimofPDL = SvRV( ST(5) );
144 listofPDL = SvRV( ST(6) );
145
146 total_size = 0;
147 for(i=0; i<nb_fields; i++)
148 {
149 SvTmp1 = av_fetch((AV*)sizeofPDL, i, 0);
150 curvalue = SvIV( *SvTmp1 );
151
152 SvTmp3 = av_fetch((AV*)sdimofPDL, i, 0);
153 cursdim = SvIV( *SvTmp3 );
154
155 total_size += curvalue * cursdim;
156 }
157
158 total_size *= nb_records;
159 databuff = (unsigned char *)malloc( total_size );
160 if(databuff==NULL)
161 croak("memory allocation error");
162 ptrbuff = databuff;
163
164 if(interlace_mode == 0)
165 {
166 for(i=0; i<nb_records; i++)
167 {
168 for(j=0; j<nb_fields; j++)
169 {
170 SvTmp2 = av_fetch((AV*)listofPDL, j, 0);
171 curPDL = PDL->SvPDLV( *SvTmp2 );
172
173 SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0);
174 cursdim = SvIV( *SvTmp3 );
175
176 SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0);
177 curvalue = SvIV( *SvTmp1 );
178
179 for(k=0; k<cursdim; k++)
180 {
181 #printf("Value %d= %d\n", k, *(int *)(curPDL->data + curvalue*i + curvalue*k*nb_records));
182 memcpy( ptrbuff, (unsigned char *)(curPDL->data + curvalue*i + curvalue*k*nb_records), curvalue );
183
184 #printf("Value %d=%d\n", k, *(int *)(curPDL->data + curvalue*i*cursdim + curvalue*k));
185 #memcpy( ptrbuff, (unsigned char *)(curPDL->data + curvalue*i*cursdim + curvalue*k), curvalue );
186
187 #printf("buffer %d= %d\n", k, *(int *)ptrbuff);
188 ptrbuff += curvalue;
189 }
190 }
191 }
192 }
193 else
194 {
195 for(j=0; j<nb_fields; j++)
196 {
197 SvTmp2 = av_fetch((AV*)listofPDL, j, 0);
198 curPDL = PDL->SvPDLV( *SvTmp2 );
199
200 SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0);
201 curvalue = SvIV( *SvTmp1 );
202
203 SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0);
204 cursdim = SvIV( *SvTmp3 );
205
206 memcpy( ptrbuff, (unsigned char *)(curPDL->data), curvalue*nb_records*cursdim );
207 ptrbuff += curvalue*nb_records*cursdim;
208 #printf("buffer %d= %d\n", k, curvalue*nb_records*cursdim);
209 }
210 interlace_mode = 1;
211 }
212 fprintf(stderr, "Calling VSwrite(VID=%d, databuff=%p, nb_records=%d, interlace_mode=%d)...\n",
213 VID, databuff, nb_records, interlace_mode);
214 RETVAL = VSwrite(VID, databuff, nb_records, interlace_mode);
215 OUTPUT:
216 RETVAL
217
218 void
219 _Vgetname(vgroup_id, vgroup_name);
220 int vgroup_id
221 char *vgroup_name
222 CODE:
223 vgroup_name=(char *)malloc(VGNAMELENMAX);
224 Vgetname(vgroup_id,vgroup_name);
225 OUTPUT:
226 vgroup_name
227
228 void
229 _VSgetname(vdata_id, vdata_name);
230 int vdata_id
231 char *vdata_name
232 CODE:
233 vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char));
234 VSgetname(vdata_id,vdata_name);
235 OUTPUT:
236 vdata_name
237
238 void
239 _Vgetclass(vgroup_id, vgroup_class);
240 int vgroup_id
241 char *vgroup_class
242 CODE:
243 vgroup_class=(char *)malloc(VGNAMELENMAX*sizeof(char));
244 Vgetclass(vgroup_id,vgroup_class);
245 OUTPUT:
246 vgroup_class
247
248 void
249 _VSgetclass(vdata_id, vdata_class);
250 int vdata_id
251 char *vdata_class
252 CODE:
253 vdata_class=(char *)malloc(VGNAMELENMAX*sizeof(char));
254 VSgetclass(vdata_id,vdata_class);
255 OUTPUT:
256 vdata_class
257
258 int
259 _VSgetfields(vdata_id, fields);
260 int vdata_id
261 char *fields
262 CODE:
263 char *tmpfields;
264 int len;
265 tmpfields=(char *)malloc(10000*sizeof(char));
266 RETVAL=VSgetfields(vdata_id, tmpfields);
267 len=strlen(tmpfields);
268 fields=(char *)malloc(len*sizeof(char)+1);
269 strcpy(fields,tmpfields);
270 OUTPUT:
271 RETVAL
272 fields
273
274 AV *
275 _VSlone(file_id);
276 int file_id;
277 CODE:
278 AV *ref_vdata_list;
279 int *ref_array;
280 SV *ref_vdata;
281 int32 nlone;
282 ref_vdata_list=newAV();
283 ref_array=(int *)malloc(MAX_FIELD_SIZE*sizeof(int));
284 nlone = VSlone(file_id, ref_array, MAX_FIELD_SIZE);
285 int32 i;
286 for(i=0;i<nlone;i++){
287 ref_vdata=newSViv((IV)ref_array[i]);
288 av_push(ref_vdata_list, ref_vdata);
289 }
290 RETVAL=ref_vdata_list;
291 OUTPUT:
292 RETVAL
293
294
295 int
296 _VSinquire(vdata_id, n_records, interlace, fields, vdata_size, vdata_name);
297 int vdata_id
298 int *n_records
299 int *interlace
300 char *fields
301 int *vdata_size
302 char *vdata_name
303 CODE:
304 char *tmpfields;
305 int len;
306 vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char));
307 tmpfields=(char *)malloc(10000*sizeof(char));
308 RETVAL=VSinquire(vdata_id, n_records, interlace, tmpfields, vdata_size, vdata_name)+1;
309 len=strlen(tmpfields);
310 fields=(char *)malloc(len*sizeof(char)+1);
311 strcpy(fields,tmpfields);
312 OUTPUT:
313 RETVAL
314 n_records
315 interlace
316 fields
317 vdata_size
318 vdata_name
319
320 ENDOFXS
321
322 pp_addpm(<<'EOPM');
323
324 use PDL::Primitive;
325 use PDL::Basic;
326 use strict;
327
328 use PDL::IO::HDF;
329
330 my $TMAP = {
331 PDL::byte->[0] => 1,
332 PDL::short->[0] => 2,
333 PDL::ushort->[0] => 2,
334 PDL::long->[0] => 4,
335 PDL::float->[0] => 4,
336 PDL::double->[0] => 8
337 };
338
339 sub _pkg_name
340 { return "PDL::IO::HDF::VS::" . shift() . "()"; }
341
342 =head2 new
343
344 =for ref
345
346 Open or create a new HDF object with VS and V interface.
347
348 =for usage
349
350 Arguments:
351 1 : The name of the HDF file.
352 If you want to write to it, prepend the name with the '+' character : "+name.hdf"
353 If you want to create it, prepend the name with the '-' character : "-name.hdf"
354 Otherwise the file will be opened in read only mode.
355
356 Returns the hdf object (die on error)
357
358 =for example
359
360 my $hdf = PDL::IO::HDF::VS->new("file.hdf");
361
362 =cut
363
364 sub new
365 {
366 # general
367 my $type = shift;
368 my $filename = shift;
369
370 my $self = {};
371
372 if (substr($filename, 0, 1) eq '+')
373 { # open for writing
374 $filename = substr ($filename, 1); # chop off +
375 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ;
376 }
377 if (substr($filename, 0, 1) eq '-')
378 { # Creating
379 $filename = substr ($filename, 1); # chop off -
380 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE;
381 }
382
383 unless( defined($self->{ACCESS_MODE}) )
384 {
385 $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ;
386 }
387
388 $self->{FILE_NAME} = $filename;
389
390 $self->{HID} = PDL::IO::HDF::VS::_Hopen( $self->{FILE_NAME}, $self->{ACCESS_MODE}, 20 );
391 if ($self->{HID})
392 {
393 PDL::IO::HDF::VS::_Vstart( $self->{HID} );
394
395 my $SDID = PDL::IO::HDF::VS::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} );
396
397 #### search for vgroup
398 my $vgroup = {};
399
400 my $vg_ref = -1;
401 while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL)
402 {
403 my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' );
404
405 my $n_entries = 0;
406
407 my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
408 my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );
409
410 my $vg_class = "";
411 PDL::IO::HDF::VS::_Vgetclass( $vg_id, $vg_class );
412
413 $vgroup->{$vg_name}->{ref} = $vg_ref;
414 $vgroup->{$vg_name}->{class} = $vg_class;
415
416 my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );
417
418 for ( 0 .. $n_pairs-1 )
419 {
420 my ($tag, $ref);
421 $res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );
422 if($tag == 1965)
423 { # Vgroup
424 my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );
425 my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
426 my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );
427 PDL::IO::HDF::VS::_Vdetach( $id );
428 $vgroup->{$vg_name}->{children}->{$name} = $ref;
429 $vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;
430 }
431 elsif($tag == 1962)
432 { # Vdata
433 my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r' );
434 my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
435 my $res = PDL::IO::HDF::VS::_VSgetname( $id, $name );
436 my $class = "";
437 PDL::IO::HDF::VS::_VSgetclass( $id, $class );
438 PDL::IO::HDF::VS::_VSdetach( $id );
439 $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';
440 $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
441 $vgroup->{$vg_name}->{attach}->{$name}->{class} = $class
442 if( $class ne '' );
443 }
444 if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)
445 {
446 my $i = _SDreftoindex( $SDID, $ref );
447 my $sds_ID = _SDselect( $SDID, $i );
448
449 my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
450 my $rank = 0;
451 my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 );
452 my $numtype = 0;
453 my $nattrs = 0;
454
455 $res = _SDgetinfo( $sds_ID, $name, $rank, $dimsize , $numtype, $nattrs );
456
457 $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'SDS_Data';
458 $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
459 }
460 } # for each pair...
461
462 PDL::IO::HDF::VS::_Vdetach( $vg_id );
463 } # while vg_ref...
464
465 PDL::IO::HDF::VS::_SDend( $SDID );
466 $self->{VGROUP} = $vgroup;
467
468 #### search for vdata
469 my $vdata_ref=-1;
470 my $vdata_id=-1;
471 my $vdata = {};
472
473 # get lone vdata (not member of a vgroup)
474 my $lone=PDL::IO::HDF::VS::_VSlone($self->{HID});
475
476 my $MAX_REF = 0;
477 while ( $vdata_ref = shift @$lone )
478 {
479 my $mode="r";
480 if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )
481 {
482 $mode="w";
483 }
484 $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $mode );
485 my $vdata_size = 0;
486 my $n_records = 0;
487 my $interlace = 0;
488 my $fields = "";
489 my $vdata_name = "";
490
491 my $status = PDL::IO::HDF::VS::_VSinquire(
492 $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
493 die "PDL::IO::HDF::VS::_VSinquire (vdata_id=$vdata_id)"
494 unless $status;
495 $vdata->{$vdata_name}->{REF} = $vdata_ref;
496 $vdata->{$vdata_name}->{NREC} = $n_records;
497 $vdata->{$vdata_name}->{INTERLACE} = $interlace;
498
499 $vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdata_id );
500
501 my $field_index = 0;
502 foreach my $onefield ( split( ",", $fields ) )
503 {
504 $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =
505 PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, $field_index );
506 $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{INDEX} = $field_index;
507 $field_index++;
508 }
509
510 PDL::IO::HDF::VS::_VSdetach( $vdata_id );
511 } # while vdata_ref...
512
513 $self->{VDATA} = $vdata;
514 } # if $self->{HDID}...
515
516 bless($self, $type);
517 } # End of new()...
518
519 sub Vgetchildren
520 {
521 my ($self, $name) = @_;
522 return( undef )
523 unless defined( $self->{VGROUP}->{$name}->{children} );
524
525 return keys %{$self->{VGROUP}->{$name}->{children}};
526 } # End of Vgetchildren()...
527 # Now defunct:
528 sub Vgetchilds
529 {
530 my $self = shift;
531 return $self->Vgetchildren( @_ );
532 } # End of Vgetchilds()...
533
534 sub Vgetattach
535 {
536 my ($self, $name) = @_;
537 return( undef )
538 unless defined( $self->{VGROUP}->{$name}->{attach} );
539
540 return keys %{$self->{VGROUP}->{$name}->{children}};
541 } # End of Vgetattach()...
542
543 sub Vgetparents
544 {
545 my ($self, $name) = @_;
546 return( undef )
547 unless defined( $self->{VGROUP}->{$name}->{parents} );
548
549 return keys %{$self->{VGROUP}->{$name}->{parents}};
550 } # End of Vgetparents()...
551
552 sub Vgetmains
553 {
554 my ($self) = @_;
555 my @rlist;
556 foreach( keys %{$self->{VGROUP}} )
557 {
558 push(@rlist, $_)
559 unless defined( $self->{VGROUP}->{$_}->{parents} );
560 }
561 return @rlist;
562 } # End of Vgetmains()...
563
564 sub Vcreate
565 {
566 my($self, $name, $class, $where) = @_;
567
568 my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, -1, 'w' );
569 return( undef )
570 if( $id == PDL::IO::HDF->FAIL );
571
572 my $res = _Vsetname($id, $name);
573 $res = _Vsetclass($id, $class)
574 if defined( $class );
575
576 $self->{VGROUP}->{$name}->{ref} = '???';
577 $self->{VGROUP}->{$name}->{class} = $class
578 if defined( $class );
579
580 if( defined( $where ) )
581 {
582 return( undef )
583 unless defined( $self->{VGROUP}->{$where} );
584
585 my $ref = $self->{VGROUP}->{$where}->{ref};
586
587 my $Pid = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'w' );
588 my $index = PDL::IO::HDF::VS::_Vinsert( $Pid, $id );
589 my ($t, $r) = (0, 0);
590 $res = PDL::IO::HDF::VS::_Vgettagref( $Pid, $index, $t, $r );
591 PDL::IO::HDF::VS::_Vdetach( $Pid );
592
593 $self->{VGROUP}->{$name}->{parents}->{$where} = $ref;
594 $self->{VGROUP}->{$where}->{children}->{$name} = $r;
595 $self->{VGROUP}->{$name}->{ref} = $r;
596 }
597 return( _Vdetach( $id ) + 1 );
598 } # End of Vcreate()...
599
600 =head2 close
601
602 =for ref
603
604 Close the VS interface.
605
606 =for usage
607
608 no arguments
609
610 =for example
611
612 my $result = $hdf->close();
613
614 =cut
615
616 sub close
617 {
618 my $self = shift;
619 _Vend( $self->{HID} );
620 my $Hid = $self->{HID};
621 $self = undef;
622 return( _Hclose($Hid) + 1 );
623 } # End of close()...
624
625 sub VSisattr
626 {
627 my($self, $name) = @_;
628
629 return undef
630 unless defined( $self->{VDATA}->{$name} );
631
632 return $self->{VDATA}->{$name}->{ISATTR};
633 } # End of VSisattr()...
634
635 sub VSgetnames
636 {
637 my $self = shift;
638 return keys %{$self->{VDATA}};
639 } # End of VSgetnames()...
640
641 sub VSgetfieldnames
642 {
643 my ( $self, $name ) = @_;
644
645 my $sub = _pkg_name( 'VSgetfieldnames' );
646
647 die "$sub: vdata name $name doesn't exist!\n"
648 unless defined( $self->{VDATA}->{$name} );
649
650 return keys %{$self->{VDATA}->{$name}->{FIELDS}};
651 } # End of VSgetfieldnames()...
652 # Now defunct:
653 sub VSgetfieldsnames
654 {
655 my $self = shift;
656 return $self->VSgetfieldnames( @_ );
657 } # End of VSgetfieldsnames()...
658
659
660 sub VSread
661 {
662 my ( $self, $name, $field ) = @_;
663 my $sub = _pkg_name( 'VSread' );
664
665 my $data = null;
666 my $vdata_ref = PDL::IO::HDF::VS::_VSfind( $self->{HID}, $name );
667
668 die "$sub: vdata name $name doesn't exist!\n"
669 unless $vdata_ref;
670
671 my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );
672 my $vdata_size = 0;
673 my $n_records = 0;
674 my $interlace = 0;
675 my $fields = "";
676 my $vdata_name = "";
677 my $status = PDL::IO::HDF::VS::_VSinquire(
678 $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
679 my $data_type = PDL::IO::HDF::VS::_VFfieldtype(
680 $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
681
682 die "$sub: data_type $data_type not implemented!\n"
683 unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );
684
685 my $order = PDL::IO::HDF::VS::_VFfieldorder(
686 $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
687
688 if($order == 1)
689 {
690 $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );
691 }
692 else
693 {
694 $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $order );
695 }
696 $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );
697
698 die "$sub: _VSsetfields\n"
699 unless $status;
700
701 $status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace);
702
703 PDL::IO::HDF::VS::_VSdetach( $vdata_id );
704 return $data;
705 } # End of VSread()...
706
707 sub VSwrite
708 {
709 my($self, $name, $mode, $field, $value) = @_;
710
711 return( undef )
712 if( $$value[0]->getndims > 2); #too many dims
713
714 my $VD_id;
715 my $res;
716 my @foo = split( /:/, $name );
717
718 return( undef )
719 if defined( $self->{VDATA}->{$foo[0]} );
720
721 $VD_id = _VSattach( $self->{HID}, -1, 'w' );
722
723 return( undef )
724 if( $VD_id == PDL::IO::HDF->FAIL );
725
726 $res = _VSsetname( $VD_id, $foo[0] );
727 return( undef )
728 if( $res == PDL::IO::HDF->FAIL );
729
730 $res = _VSsetclass( $VD_id, $foo[1] )
731 if defined( $foo[1] );
732 return( undef )
733 if( $res == PDL::IO::HDF->FAIL );
734
735 my @listfield = split( /,/, $field );
736 for( my $i = 0; $i <= $#$value; $i++ )
737 {
738 my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$$value[$i]->get_datatype()};
739 $res = _VSfdefine( $VD_id, $listfield[$i], $HDFtype, $$value[$i]->getdim(1) );
740 return( undef )
741 unless $res;
742 }
743
744 $res = _VSsetfields( $VD_id, $field );
745 return( undef )
746 unless $res;
747
748 my @sizeofPDL;
749 my @sdimofPDL;
750 foreach ( @$value )
751 {
752 push(@sdimofPDL, $_->getdim(1));
753 push(@sizeofPDL, $TMAP->{$_->get_datatype()});
754 }
755 $res = _WriteMultPDL( $VD_id, $$value[0]->getdim(0), $#$value+1, $mode, \@sizeofPDL, \@sdimofPDL, $value);
756
757 return( undef )
758 if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL );
759 return $res;
760 } # End of VSwrite()...
761
762
763 sub DESTROY
764 {
765 my $self = shift;
766 $self->close;
767 } # End of DESTROY()...
768
769 EOPM
770
771 #
772 # Add the tail of the docs:
773 #
774 pp_addpm(<<'EOD');
775
776 =head1 CURRENT AUTHOR & MAINTAINER
777
778 Judd Taylor, Orbital Systems, Ltd.
779 judd dot t at orbitalsystems dot com
780
781 =head1 PREVIOUS AUTHORS
782
783 Olivier Archer olivier.archer@ifremer.fr
784 contribs of Patrick Leilde patrick.leilde@ifremer.fr
785
786 =head1 SEE ALSO
787
788 perl(1), PDL(1), PDL::IO::HDF(1).
789
790 =cut
791
792
793 EOD
794
795 pp_done();