"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