PDL-IO-HDF5-0.63/0000755002141500001300000000000011554061516012350 5ustar cerneydbteamPDL-IO-HDF5-0.63/HDF5/0000755002141500001300000000000011554061466013042 5ustar cerneydbteamPDL-IO-HDF5-0.63/HDF5/Dataset.pm0000744002141500001300000012725011516421715014770 0ustar cerneydbteampackage PDL::IO::HDF5::Dataset; use Carp; use strict; # Global mapping variables our ($H5T_STRING, %PDLtoHDF5internalTypeMapping, %HDF5toPDLfileMapping, %PDLtoHDF5fileMapping); =head1 NAME PDL::IO::HDF5::Dataset - PDL::IO::HDF5 Helper Object representing HDF5 datasets. =head1 DESCRIPTION This is a helper-object used by PDL::IO::HDF5 to interface with HDF5 format's dataset objects. Information on the HDF5 Format can be found at the NCSA's web site at http://hdf.ncsa.uiuc.edu/ . =head1 SYNOPSIS See L =head1 MEMBER DATA =over 1 =item ID ID number given to the dataset by the HDF5 library =item name Name of the dataset. =item parent Ref to parent object (group) that owns this dateset. =item fileObj Ref to the L object that owns this object. =back =head1 METHODS ####--------------------------------------------------------- =head2 new =for ref PDL::IO::HDF5::Dataset Constructor - creates new object B =for usage This object will usually be created using the calling format detailed in the L. The following syntax is used by the L object to build the object. $a = new PDL::IO::HDF5:Dataset( name => $name, parent => $parent, fileObj => $fileObj); Args: $name Name of the dataset $parent Parent Object that owns this dataset $fileObj PDL::HDF object that owns this dateset. =cut sub new{ my $type = shift; my %parms = @_; my $self = {}; my @DataMembers = qw( name parent fileObj); my %DataMembers; @DataMembers{ @DataMembers } = @DataMembers; # hash for quick lookup # check for proper supplied names: my $varName; foreach $varName(keys %parms){ unless( defined($DataMembers{$varName})){ carp("Error Calling ".__PACKAGE__." Constuctor\n \'$varName\' not a valid data member\n"); return undef; } unless( defined($parms{$varName})){ carp("Error Calling ".__PACKAGE__." Constuctor\n \'$varName\' not supplied\n"); return undef; } $self->{$varName} = $parms{$varName}; } my $parent = $self->{parent}; my $groupID = $parent->IDget; my $groupName = $parent->nameGet; my $name = $self->{name}; my $datasetID; ##### # Turn Error Reporting off for the following, so H5 lib doesn't complain # if the group isn't found. PDL::IO::HDF5::H5errorOff(); my $rc = PDL::IO::HDF5::H5Gget_objinfo($groupID, $name,1,0); PDL::IO::HDF5::H5errorOn(); # See if the dataset exists: if( $rc >= 0){ #DataSet Exists open it: $datasetID = PDL::IO::HDF5::H5Dopen($groupID, $name); if($datasetID < 0 ){ carp "Error Calling ".__PACKAGE__." Constuctor: Can't open existing dataset '$name'\n"; return undef; } } else{ # dataset didn't exist, set datasetID = 0 ## (Have to put off opening the dataset ### until it is written to (Must know dims, etc to create) $datasetID = 0; } $self->{ID} = $datasetID; bless $self, $type; return $self; } =head2 DESTROY =for ref PDL::IO::HDF5::Dataset Destructor - Closes the dataset object B =for usage No Usage. Automatically called =cut sub DESTROY { my $self = shift; my $datasetID = $self->{ID}; # print "In DataSet DEstroy\n"; if( $datasetID && (PDL::IO::HDF5::H5Dclose($self->{ID}) < 0 )){ warn("Error closing HDF5 Dataset '".$self->{name}."' in file:group: '".$self->{filename}.":".$self->{group}."'\n"); } } =head2 set =for ref Write data to the HDF5 dataset B =for usage $dataset->set($pdl); # Write the array data in the dataset =cut ############################################################################# # Mapping of PDL types to HDF5 types for writing to a dataset # # Mapping of PDL types to what HDF5 calls them while we are dealing with them # outside of the HDF5 file. %PDLtoHDF5internalTypeMapping = ( $PDL::Types::PDL_B => PDL::IO::HDF5::H5T_NATIVE_CHAR(), $PDL::Types::PDL_S => PDL::IO::HDF5::H5T_NATIVE_SHORT(), $PDL::Types::PDL_L => PDL::IO::HDF5::H5T_NATIVE_INT(), $PDL::Types::PDL_LL => PDL::IO::HDF5::H5T_NATIVE_LLONG(), $PDL::Types::PDL_F => PDL::IO::HDF5::H5T_NATIVE_FLOAT(), $PDL::Types::PDL_D => PDL::IO::HDF5::H5T_NATIVE_DOUBLE(), ); # Mapping of PDL types to what types they are written to in the HDF5 file. # For 64 Bit machines, we might need to modify this with some smarts to determine # what is appropriate %PDLtoHDF5fileMapping = ( $PDL::Types::PDL_B => PDL::IO::HDF5::H5T_STD_I8BE(), $PDL::Types::PDL_S => PDL::IO::HDF5::H5T_STD_I16BE(), $PDL::Types::PDL_L => PDL::IO::HDF5::H5T_STD_I32BE(), $PDL::Types::PDL_LL => PDL::IO::HDF5::H5T_STD_I64BE(), $PDL::Types::PDL_F => PDL::IO::HDF5::H5T_IEEE_F32BE(), $PDL::Types::PDL_D => PDL::IO::HDF5::H5T_IEEE_F64BE(), ); sub set{ my $self = shift; my ($pdl) = @_; my $parent = $self->{parent}; my $groupID = $parent->IDget; my $datasetID = $self->{ID}; my $name = $self->{name}; my $internalhdf5_type; # hdf5 type that describes the way data is stored in memory my $hdf5Filetype; # hdf5 type that describes the way data will be stored in the file. my @dims; # hdf5 equivalent dims for the supplied PDL my $type = $pdl->get_datatype; # get PDL datatype if( $pdl->isa('PDL::Char') ){ # Special Case for PDL::Char Objects (fixed length strings) @dims = $pdl->dims; my $length = shift @dims; # String length is the first dim of the PDL for PDL::Char # Create Null-Terminated String Type $internalhdf5_type = PDL::IO::HDF5::H5Tcopy(PDL::IO::HDF5::H5T_C_S1()); PDL::IO::HDF5::H5Tset_size($internalhdf5_type, $length ); # make legth of type eaual to strings $hdf5Filetype = $internalhdf5_type; # memory and file storage will be the same type @dims = reverse(@dims); # HDF5 stores columns/rows in reverse order than pdl } else{ # Other PDL Types unless( defined($PDLtoHDF5internalTypeMapping{$type}) ){ carp "Error Calling ".__PACKAGE__."::set: Can't map PDL type to HDF5 datatype\n"; return undef; } $internalhdf5_type = $PDLtoHDF5internalTypeMapping{$type}; unless( defined($PDLtoHDF5fileMapping{$type}) ){ carp "Error Calling ".__PACKAGE__."::set: Can't map PDL type to HDF5 datatype\n"; return undef; } $hdf5Filetype = $PDLtoHDF5fileMapping{$type}; @dims = reverse($pdl->dims); # HDF5 stores columns/rows in reverse order than pdl } my $dims = PDL::IO::HDF5::packList(@dims); my $dataspaceID = PDL::IO::HDF5::H5Screate_simple(scalar(@dims), $dims , $dims); if( $dataspaceID < 0 ){ carp("Can't Open Dataspace in ".__PACKAGE__.":set\n"); return undef; } if( $datasetID == 0){ # Dataset not created yet # /* Create the dataset. */ $datasetID = PDL::IO::HDF5::H5Dcreate($groupID, $name, $hdf5Filetype, $dataspaceID, PDL::IO::HDF5::H5P_DEFAULT()); if( $datasetID < 0){ carp("Can't Create Dataspace in ".__PACKAGE__.":set\n"); return undef; } $self->{ID} = $datasetID; } # Write the actual data: my $data = ${$pdl->get_dataref}; if( PDL::IO::HDF5::H5Dwrite($datasetID, $internalhdf5_type, PDL::IO::HDF5::H5S_ALL(), PDL::IO::HDF5::H5S_ALL(), PDL::IO::HDF5::H5P_DEFAULT(), $data) < 0 ){ carp("Error Writing to dataset in ".__PACKAGE__.":set\n"); return undef; } # /* Terminate access to the data space. */ carp("Can't close Dataspace in ".__PACKAGE__.":set\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return 1; } =head2 get =for ref Get data from a HDF5 dataset to a PDL B =for usage $pdl = $dataset->get; # Read the Array from the HDF5 dataset, create a PDL from it # and put in $pdl # Assuming $dataset is three dimensional # with dimensions (20,100,90) The I method can also be used to obtain particular slices or hyperslabs of the dataset array. For example, if $dataset is three dimensional with dimensions (20,100,90) then we could do: $start=pdl([0,0,0]); # We begin the slice at the very beggining $end=pdl([19,0,0]); # We take the first vector of the array, $stride=pdl([2,1,1]); # taking only every two values of the vector $pdl = $dataset->get($start,$end,[$stride]); # Read a slice or # hyperslab from the HDF5 dataset. # $start, $end and optionally $stride # should be PDL vectors with length the # number of dimensions of the dataset. # $start gives the starting coordinates # in the array. # $end gives the ending coordinate # in the array # $stride gives the steps taken from one # coordinate to the next of the slice The mapping of HDF5 datatypes in the file to PDL datatypes in memory will be according to the following table. HDF5 File Type PDL Type ------------------------ ----------------- PDL::IO::HDF5::H5T_C_S1() => PDL::Char Object (Special Case for Char Strings) PDL::IO::HDF5::H5T_STD_I8BE() => $PDL::Types::PDL_B PDL::IO::HDF5::H5T_STD_I8LE() => $PDL::Types::PDL_B, PDL::IO::HDF5::H5T_STD_U8BE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_U8LE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_I16BE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_I16LE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_U16BE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_U16LE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_I32BE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_I32LE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_U32LE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_U32BE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_I64LE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_I64BE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_IEEE_F32BE()=> $PDL::Types::PDL_F, PDL::IO::HDF5::H5T_IEEE_F32LE()=> $PDL::Types::PDL_F, PDL::IO::HDF5::H5T_IEEE_F64BE()=> $PDL::Types::PDL_D, PDL::IO::HDF5::H5T_IEEE_F64LE()=> $PDL::Types::PDL_D For HDF5 File types not in this table, this method will attempt to map it to the default PDL type PDL_D. B Character arrays are returned as the special L fixed-length string type. For fixed-length HDF5 string arrays, this is a direct mapping to the PDL::Char datatype. For HDF5 variable-length string arrays, the data is converted to a fixed-length character array, with a string size equal to the maximum size of all the strings in the array. =cut ############################################################################# # Mapping of HDF5 file types to PDL types # For 64 Bit machines, we might need to modify this with some smarts to determine # what is appropriate %HDF5toPDLfileMapping = ( PDL::IO::HDF5::H5T_STD_I8BE() => $PDL::Types::PDL_B, PDL::IO::HDF5::H5T_STD_I8LE() => $PDL::Types::PDL_B, PDL::IO::HDF5::H5T_STD_U8BE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_U8LE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_I16BE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_I16LE() => $PDL::Types::PDL_S, PDL::IO::HDF5::H5T_STD_U16BE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_U16LE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_I32BE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_I32LE() => $PDL::Types::PDL_L, PDL::IO::HDF5::H5T_STD_U32LE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_U32BE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_I64LE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_STD_I64BE() => $PDL::Types::PDL_LL, PDL::IO::HDF5::H5T_IEEE_F32BE() => $PDL::Types::PDL_F, PDL::IO::HDF5::H5T_IEEE_F32LE() => $PDL::Types::PDL_F, PDL::IO::HDF5::H5T_IEEE_F64BE() => $PDL::Types::PDL_D, PDL::IO::HDF5::H5T_IEEE_F64LE() => $PDL::Types::PDL_D ); $H5T_STRING = PDL::IO::HDF5::H5T_STRING(); #HDF5 string type sub get{ my $self = shift; my $start = shift; my $end = shift; my $stride = shift; my $pdl; my $rc; # H5 library call return code my $parent = $self->{parent}; my $groupID = $parent->IDget; my $datasetID = $self->{ID}; my $name = $self->{name}; my $stringSize; # String size, if we are retrieving a string type my $PDLtype; # PDL type that the data will be mapped to my $internalhdf5_type; # Type that represents how HDF5 will store the data in memory (after retreiving from # the file) my $ReturnType = 'PDL'; # Default object returned is PDL. If strings are store, then this will # return PDL::Char # Get the HDF5 file datatype; my $HDF5type = PDL::IO::HDF5::H5Dget_type($datasetID ); unless( $HDF5type >= 0 ){ carp "Error Calling ".__PACKAGE__."::get: Can't get HDF5 Dataset type.\n"; return undef; } # Check for string type: my $varLenString = 0; # Flag = 1 if reading variable-length string array if( PDL::IO::HDF5::H5Tget_class($HDF5type ) == $H5T_STRING ){ # String type # Check for variable length string" if( ! PDL::IO::HDF5::H5Tis_variable_str($HDF5type ) ){ # Not a variable length string $stringSize = PDL::IO::HDF5::H5Tget_size($HDF5type); unless( $stringSize >= 0 ){ carp "Error Calling ".__PACKAGE__."::get: Can't get HDF5 String Datatype Size.\n"; carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); return undef; } $internalhdf5_type = $HDF5type; # internal storage the same as the file storage. } else{ # Variable-length String, set flag $varLenString = 1; # Create variable-length type for reading from the file $internalhdf5_type = PDL::IO::HDF5::H5Tcopy(PDL::IO::HDF5::H5T_C_S1() ); PDL::IO::HDF5::H5Tset_size( $internalhdf5_type, PDL::IO::HDF5::H5T_VARIABLE() ); } $PDLtype = $PDL::Types::PDL_B; $ReturnType = 'PDL::Char'; # For strings, we return a PDL::Char } else{ # Normal Numeric Type # Map the HDF5 file datatype to a PDL datatype $PDLtype = $PDL::Types::PDL_D; # Default type is double my $defaultType; foreach $defaultType( keys %HDF5toPDLfileMapping){ if( PDL::IO::HDF5::H5Tequal($defaultType,$HDF5type) > 0){ $PDLtype = $HDF5toPDLfileMapping{$defaultType}; last; } } # Get the HDF5 internal datatype that corresponds to the PDL type unless( defined($PDLtoHDF5internalTypeMapping{$PDLtype}) ){ carp "Error Calling ".__PACKAGE__."::set: Can't map PDL type to HDF5 datatype\n"; return undef; } $internalhdf5_type = $PDLtoHDF5internalTypeMapping{$PDLtype}; } my $dataspaceID = PDL::IO::HDF5::H5Dget_space($datasetID); if( $dataspaceID < 0 ){ carp("Can't Open Dataspace in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); return undef; } # Get the number of dims: my $Ndims = PDL::IO::HDF5::H5Sget_simple_extent_ndims($dataspaceID); if( $Ndims < 0 ){ carp("Can't Get Number of Dims in Dataspace in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } my @dims = ( 0..($Ndims-1)); my ($mem_space,$file_space); if (not defined $start) { # Initialize Dims structure: my $dims = PDL::IO::HDF5::packList(@dims); my $dims2 = PDL::IO::HDF5::packList(@dims); my $rc = PDL::IO::HDF5::H5Sget_simple_extent_dims($dataspaceID, $dims, $dims2 ); if( $rc != $Ndims){ carp("Error getting number of dims in dataspace in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } @dims = PDL::IO::HDF5::unpackList($dims); # get the dim sizes from the binary structure } else { if ( ($start->getndims != 1) || ($start->getdim(0) != $Ndims) ){ carp("Wrong dimensions in start PDL in ".__PACKAGE__."\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } my $start2 = PDL::IO::HDF5::packList(reverse($start->list)); if (not defined $end) { carp("No end supplied in ".__PACKAGE__."\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } if ( ($end->getndims != 1) || ($end->getdim(0) != $Ndims) ) { carp("Wrong dimensions in end PDL in ".__PACKAGE__."\n") ; carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } my $length2; if (defined $stride) { if ( ($stride->getndims != 1) || ($stride->getdim(0) != $Ndims) ) { carp("Wrong dimensions in stride in ".__PACKAGE__."\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } @dims=reverse((($end-$start+1)/$stride)->list); $length2 = PDL::IO::HDF5::packList(@dims); } else { @dims=reverse(($end-$start+1)->list); $length2 = PDL::IO::HDF5::packList(@dims); $stride=PDL::Core::ones($Ndims); } my $mem_dims = PDL::IO::HDF5::packList(@dims); my $stride2 = PDL::IO::HDF5::packList(reverse($stride->list)); my $block=PDL::Core::ones($Ndims); my $block2 = PDL::IO::HDF5::packList(reverse($block->list)); # Slice the data $file_space = PDL::IO::HDF5::H5Dget_space($datasetID); $rc=PDL::IO::HDF5::H5Sselect_hyperslab($file_space, 0, $start2, $stride2, $length2, $block2); if( $rc < 0 ){ carp("Error slicing data from file in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } $mem_space = PDL::IO::HDF5::H5Screate_simple($Ndims, $mem_dims, $mem_dims); } # Create initial PDL null array with the proper datatype $pdl = $ReturnType->null; $pdl->set_datatype($PDLtype); my @pdldims; # dims of the PDL my $datatypeSize; # Size of one element of data stored if( defined( $stringSize )){ # Fixed-Length String types @pdldims = ($stringSize,reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl, # 1st PDL dim is the string length (for PDL::Char) $datatypeSize = PDL::howbig($pdl->get_datatype); } elsif( $varLenString ){ # Variable-length String # (Variable length string arrays will be converted to fixed-length strings later) @pdldims = (reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl # Variable length strings are stored as arrays of string pointers, so get that size # This will by 4 bytes on 32-bit machines, and 8 bytes on 64-bit machines. $datatypeSize = PDL::IO::HDF5::bufPtrSize(); } else{ # Normal Numeric types # (Variable length string arrays will be converted to fixed-length strings later) @pdldims = (reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl $datatypeSize = PDL::howbig($pdl->get_datatype); } my $nelems = 1; foreach (@pdldims){ $nelems *= $_; }; # calculate the number of elements my $datasize = $nelems * $datatypeSize; # Create empty space for the data # Incrementally, to get around problem on win32 my $howBig = $datatypeSize; my $data = ' ' x $howBig; foreach my $dim(@pdldims){ $data = $data x $dim; } # Read the data: if (not defined $start) { $rc = PDL::IO::HDF5::H5Dread($datasetID, $internalhdf5_type, PDL::IO::HDF5::H5S_ALL(), PDL::IO::HDF5::H5S_ALL(), PDL::IO::HDF5::H5P_DEFAULT(), $data); } else { $rc = PDL::IO::HDF5::H5Dread($datasetID, $internalhdf5_type, $mem_space, $file_space, PDL::IO::HDF5::H5P_DEFAULT(), $data); } if( $rc < 0 ){ carp("Error reading data from file in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } if( $varLenString ){ # Convert variable-length string to fixed-length string, to be compatible with the PDL::Char type my $maxsize = PDL::IO::HDF5::findMaxVarLenSize($data, $nelems); # Create empty space for the fixed-length data # Incrementally, to get around problem on win32 my $howBig = $maxsize + 1; # Adding one to include the null string terminator my $fixeddata = ' ' x $howBig; foreach my $dim(@pdldims){ $fixeddata = $fixeddata x $dim; } PDL::IO::HDF5::copyVarLenToFixed($data, $fixeddata, $nelems, $maxsize); # Reclaim data from HDF5 system (HDF5 allocates memory when it reads variable-length strings) $rc = PDL::IO::HDF5::H5Dvlen_reclaim ($internalhdf5_type, $dataspaceID, PDL::IO::HDF5::H5P_DEFAULT(), $data); if( $rc < 0 ){ carp("Error reclaiming memeory while reading data from file in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } # Adjust for fixed-length PDL creation $data = $fixeddata; unshift @pdldims, ($maxsize+1); } # Setup the PDL with the proper dimensions and data $pdl->setdims(\@pdldims); # Update the PDL data with the data read from the file ${$pdl->get_dataref()} = $data; $pdl->upd_data(); # /* Terminate access to the data space. */ carp("Can't close Dataspace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); # /* Terminate access to the data type. */ carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); return $pdl; } =head2 dims =for ref Get the dims for a HDF5 dataset. For example, a 3 x 4 array would return a perl array (3,4); B =for usage @pdl = $dataset->dims; # Get an array of dims. =cut sub dims{ my $self = shift; my $parent = $self->{parent}; my $groupID = $parent->IDget; my $datasetID = $self->{ID}; my $name = $self->{name}; my $dataspaceID = PDL::IO::HDF5::H5Dget_space($datasetID); if( $dataspaceID < 0 ){ carp("Can't Open Dataspace in ".__PACKAGE__.":get\n"); return undef; } # Get the number of dims: my $Ndims = PDL::IO::HDF5::H5Sget_simple_extent_ndims($dataspaceID); if( $Ndims < 0 ){ carp("Can't Get Number of Dims in Dataspace in ".__PACKAGE__.":get\n"); return undef; } # Initialize Dims structure: my @dims = ( 0..($Ndims-1)); my $dims = PDL::IO::HDF5::packList(@dims); my $dims2 = PDL::IO::HDF5::packList(@dims); my $rc = PDL::IO::HDF5::H5Sget_simple_extent_dims($dataspaceID, $dims, $dims2 ); if( $rc != $Ndims){ carp("Error getting number of dims in dataspace in ".__PACKAGE__.":get\n"); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } @dims = PDL::IO::HDF5::unpackList($dims); # get the dim sizes from the binary structure return reverse @dims; # return dims in the order that PDL will store them } =head2 attrSet =for ref Set the value of an attribute(s) Attribute types supported are null-terminated strings and PDL matrices B =for usage $dataset->attrSet( 'attr1' => 'attr1Value', 'attr2' => 'attr2 value', 'attr3' => $pdl, . . . ); Returns undef on failure, 1 on success. =cut sub attrSet { my $self = shift; my %attrs = @_; # get atribute hash my $datasetID = $self->{ID}; unless( $datasetID){ # Error checking carp("Can't Set Attribute for empty dataset. Try writing some data to it first:\n"); carp(" in file:group: '".$self->{filename}.":".$self->{group}."'\n"); return undef; } my($key,$value); my $typeID; # id used for attribute my $dataspaceID; # id used for the attribute dataspace my $attrID; foreach $key( sort keys %attrs){ $value = $attrs{$key}; if (ref($value) =~ /^PDL/) { my $internalhdf5_type; # hdf5 type that describes the way data is stored in memory my @dims; # hdf5 equivalent dims for the supplied PDL my $type = $value->get_datatype; # get PDL datatype if( $value->isa('PDL::Char') ){ # Special Case for PDL::Char Objects (fixed length strings) @dims = $value->dims; my $length = shift @dims; # String length is the first dim of the PDL for PDL::Char # Create Null-Terminated String Type $internalhdf5_type = PDL::IO::HDF5::H5Tcopy(PDL::IO::HDF5::H5T_C_S1()); PDL::IO::HDF5::H5Tset_size($internalhdf5_type, $length ); # make legth of type eaual to strings $typeID = $internalhdf5_type; # memory and file storage will be the same type @dims = reverse(@dims); # HDF5 stores columns/rows in reverse order than pdl } else { # Other PDL Types unless( defined($PDLtoHDF5internalTypeMapping{$type}) ){ carp "Error Calling ".__PACKAGE__."::set: Can't map PDL type to HDF5 datatype\n"; return undef; } $internalhdf5_type = $PDLtoHDF5internalTypeMapping{$type}; $typeID = PDL::IO::HDF5::H5Tcopy($internalhdf5_type); @dims = reverse($value->dims); # HDF5 stores columns/rows in reverse order than pdl } my $dims = PDL::IO::HDF5::packList(@dims); $value = ${$value->get_dataref}; $dataspaceID = PDL::IO::HDF5::H5Screate_simple(scalar(@dims), $dims , $dims); if( $dataspaceID < 0 ){ carp("Can't Open Dataspace in ".__PACKAGE__.":set\n"); return undef; } } else { # Create Null-Terminated String Type $typeID = PDL::IO::HDF5::H5Tcopy(PDL::IO::HDF5::H5T_C_S1()); PDL::IO::HDF5::H5Tset_size($typeID, length($value) || 1 ); # make legth of type eaual to length of $value or 1 if zero $dataspaceID = PDL::IO::HDF5::H5Screate_simple(0, 0, 0); } #Note: If a attr already exists, then it will be deleted an re-written # Delete the attribute first PDL::IO::HDF5::H5errorOff(); # keep h5 lib from complaining PDL::IO::HDF5::H5Adelete($datasetID, $key); PDL::IO::HDF5::H5errorOn(); $attrID = PDL::IO::HDF5::H5Acreate($datasetID, $key, $typeID, $dataspaceID, PDL::IO::HDF5::H5P_DEFAULT()); if($attrID < 0 ){ carp "Error in ".__PACKAGE__." attrSet; Can't create attribute '$key'\n"; PDL::IO::HDF5::H5Sclose($dataspaceID); PDL::IO::HDF5::H5Tclose($typeID); # Cleanup return undef; } # Write the attribute data. if( PDL::IO::HDF5::H5Awrite($attrID, $typeID, $value) < 0){ carp "Error in ".__PACKAGE__." attrSet; Can't write attribute '$key'\n"; PDL::IO::HDF5::H5Aclose($attrID); PDL::IO::HDF5::H5Sclose($dataspaceID); PDL::IO::HDF5::H5Tclose($typeID); # Cleanup return undef; } # Cleanup PDL::IO::HDF5::H5Aclose($attrID); PDL::IO::HDF5::H5Sclose($dataspaceID); PDL::IO::HDF5::H5Tclose($typeID); } # Clear-out the attribute index, it is no longer valid with the updates # we just made. $self->{fileObj}->clearAttrIndex; return 1; } =head2 attrDel =for ref Delete attribute(s) B =for usage $dataset->attrDel( 'attr1', 'attr2', . . . ); Returns undef on failure, 1 on success. =cut sub attrDel { my $self = shift; my @attrs = @_; # get atribute names my $datasetID = $self->{ID}; my $attr; my $rc; #Return code returned by H5Adelete foreach $attr( @attrs ){ # Note: We don't consider errors here as cause for aborting, we just # complain using carp if( PDL::IO::HDF5::H5Adelete($datasetID, $attr) < 0){ carp "Error in ".__PACKAGE__." attrDel; Error Deleting attribute '$attr'\n"; } } # Clear-out the attribute index, it is no longer valid with the updates # we just made. $self->{fileObj}->clearAttrIndex; return 1; } =head2 attrs =for ref Get a list of all attribute names associated with a dataset B =for usage @attrs = $dataset->attrs; =cut sub attrs { my $self = shift; my $datasetID = $self->{ID}; my $defaultMaxSize = 256; # default max size of a attribute name my $noAttr = PDL::IO::HDF5::H5Aget_num_attrs($datasetID); # get the number of attributes my $attrIndex = 0; # attribute Index my @attrNames = (); my $attributeID; my $attrNameSize; # size of the attribute name my $attrName; # attribute name # Go thru each attribute and get the name for( $attrIndex = 0; $attrIndex < $noAttr; $attrIndex++){ $attributeID = PDL::IO::HDF5::H5Aopen_idx($datasetID, $attrIndex ); if( $attributeID < 0){ carp "Error in ".__PACKAGE__." attrs; Error Opening attribute number $attrIndex\n"; next; } #init attrname to 256 length string (Maybe this not necessary with # the typemap) $attrName = ' ' x 256; # Get the name $attrNameSize = PDL::IO::HDF5::H5Aget_name($attributeID, 256, $attrName ); # If the name is greater than 256, try again with the proper size: if( $attrNameSize > 256 ){ $attrName = ' ' x $attrNameSize; $attrNameSize = PDL::IO::HDF5::H5Aget_name($attributeID, $attrNameSize, $attrName ); } push @attrNames, $attrName; # Close the attr: PDL::IO::HDF5::H5Aclose($attributeID); } return @attrNames; } =head2 attrGet =for ref Get the value of an attribute(s) Currently the attribute types supported are null-terminated strings and PDLs. B =for usage my @attrs = $dataset->attrGet( 'attr1', 'attr2'); =cut sub attrGet { my $self = shift; my @attrs = @_; # get atribute array my $datasetID = $self->{ID}; my($attrName,$attrValue); my @attrValues; #return array my $typeID; # id used for attribute my $dataspaceID; # id used for the attribute dataspace my $attrID; foreach $attrName( @attrs){ $attrValue = undef; # Open the Attribute $attrID = PDL::IO::HDF5::H5Aopen_name($datasetID, $attrName ); unless( $attrID >= 0){ carp "Error Calling ".__PACKAGE__."::attrget: Can't open HDF5 Attribute name '$attrName'.\n"; next; } # Open the data-space $dataspaceID = PDL::IO::HDF5::H5Aget_space($attrID); if( $dataspaceID < 0 ){ carp("Can't Open Dataspace for Attribute name '$attrName' in ".__PACKAGE__."::attrget\n"); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } # Check to see if the dataspace is simple if( PDL::IO::HDF5::H5Sis_simple($dataspaceID) < 0 ){ carp("Warning: Non-Simple Dataspace for Attribute name '$attrName' ".__PACKAGE__."::attrget\n"); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } # Get the number of dims: my $Ndims = PDL::IO::HDF5::H5Sget_simple_extent_ndims($dataspaceID); unless( $Ndims >= 0){ if( $Ndims < 0 ){ carp("Warning: Can't Get Number of Dims in Attribute name '$attrName' Dataspace in ".__PACKAGE__.":get\n"); } #if( $Ndims > 0 ){ # carp("Warning: Non-Scalar Dataspace for Attribute name '$attrName' Dataspace in ".__PACKAGE__.":get\n"); #} carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } my $HDF5type; if ($Ndims == 0) { # If it is a scalar we do this # Get the HDF5 dataset datatype; $HDF5type = PDL::IO::HDF5::H5Aget_type($attrID ); unless( $HDF5type >= 0 ){ carp "Error Calling ".__PACKAGE__."::attrGet: Can't get HDF5 Dataset type in Attribute name '$attrName'.\n"; carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } # Get the size so we can allocate space for it my $size = PDL::IO::HDF5::H5Tget_size($HDF5type); unless( $size){ carp "Error Calling ".__PACKAGE__."::attrGet: Can't get HDF5 Dataset type size in Attribute name '$attrName'.\n"; carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } #init attr value to the length of the type $attrValue = ' ' x ($size); if( PDL::IO::HDF5::H5Aread($attrID, $HDF5type, $attrValue) < 0 ){ carp "Error Calling ".__PACKAGE__."::attrGet: Can't read Attribute Value for Attribute name '$attrName'.\n"; carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } # End of scalar option } else { # This is a PDL # Get the HDF5 dataset datatype; $HDF5type = PDL::IO::HDF5::H5Aget_type($attrID ); unless( $HDF5type >= 0 ){ carp "Error Calling ".__PACKAGE__."::attrGet: Can't get HDF5 Dataset type in Attribute name '$attrName'.\n"; carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); next; } #********************************************************* my $stringSize; my $PDLtype; my $internalhdf5_type; my $typeID; my $ReturnType = 'PDL'; # Default object returned is PDL. If strings are store, then this will # return PDL::Char # Check for string type: my $varLenString = 0; # Flag = 1 if reading variable-length string array if( PDL::IO::HDF5::H5Tget_class($HDF5type ) == $H5T_STRING ){ # String type # Check for variable length string" if( ! PDL::IO::HDF5::H5Tis_variable_str($HDF5type ) ){ # Not a variable length string $stringSize = PDL::IO::HDF5::H5Tget_size($HDF5type); unless( $stringSize >= 0 ){ carp "Error Calling ".__PACKAGE__."::get: Can't get HDF5 String Datatype Size.\n"; carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); return undef; } $internalhdf5_type = $HDF5type; # internal storage the same as the file storage. } else{ # Variable-length String, set flag $varLenString = 1; # Create variable-length type for reading from the file $internalhdf5_type = PDL::IO::HDF5::H5Tcopy(PDL::IO::HDF5::H5T_C_S1() ); PDL::IO::HDF5::H5Tset_size( $internalhdf5_type, PDL::IO::HDF5::H5T_VARIABLE() ); } $PDLtype = $PDL::Types::PDL_B; $typeID=$HDF5type; $ReturnType = 'PDL::Char'; # For strings, we return a PDL::Char } else{ # Normal Numeric Type # Map the HDF5 file datatype to a PDL datatype $PDLtype = $PDL::Types::PDL_D; # Default type is double my $defaultType; foreach $defaultType( keys %HDF5toPDLfileMapping){ if( PDL::IO::HDF5::H5Tequal($defaultType,$HDF5type) > 0){ $PDLtype = $HDF5toPDLfileMapping{$defaultType}; last; } } # Get the HDF5 internal datatype that corresponds to the PDL type unless( defined($PDLtoHDF5internalTypeMapping{$PDLtype}) ){ carp "Error Calling ".__PACKAGE__."::set: Can't map PDL type to HDF5 datatype\n"; carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); return undef; } $internalhdf5_type = $PDLtoHDF5internalTypeMapping{$PDLtype}; #$internalhdf5_type = $HDF5type; # internal storage the same as the file storage. #$typeID = PDL::IO::HDF5::H5Tcopy($internalhdf5_type); $typeID = $internalhdf5_type; } # End of String or Numeric type # Initialize Dims structure: my @dims = ( 0..($Ndims-1)); my $dims = PDL::IO::HDF5::packList(@dims); my $dims2 = PDL::IO::HDF5::packList(@dims); my $rc = PDL::IO::HDF5::H5Sget_simple_extent_dims($dataspaceID, $dims, $dims2 ); if( $rc != $Ndims){ carp("Error getting number of dims in dataspace in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); return undef; } @dims = PDL::IO::HDF5::unpackList($dims); # get the dim sizes from the binary structure # Create initial PDL null array with the proper datatype $attrValue = $ReturnType->null; $attrValue->set_datatype($PDLtype); my @pdldims; # dims of the PDL my $datatypeSize; # Size of one element of data stored if( defined( $stringSize )){ # Fixed-Length String types @pdldims = ($stringSize,reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl, # 1st PDL dim is the string length (for PDL::Char) $datatypeSize = PDL::howbig($attrValue->get_datatype); } elsif( $varLenString ){ # Variable-length String # (Variable length string arrays will be converted to fixed-length strings later) @pdldims = (reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl # Variable length strings are stored as arrays of string pointers, so get that size # This will by 4 bytes on 32-bit machines, and 8 bytes on 64-bit machines. $datatypeSize = PDL::IO::HDF5::bufPtrSize(); } else{ # Normal Numeric types @pdldims = (reverse(@dims)); # HDF5 stores columns/rows in reverse order than pdl, $datatypeSize = PDL::howbig($attrValue->get_datatype); } my $nelems = 1; foreach (@pdldims){ $nelems *= $_; }; # calculate the number of elements my $datasize = $nelems * $datatypeSize; # Create empty space for the data # Incrementally, to get around problem on win32 my $howBig = $datatypeSize; my $data = ' ' x $howBig; foreach my $dim(@pdldims){ $data = $data x $dim; } # Read the data: $rc = PDL::IO::HDF5::H5Aread($attrID,$internalhdf5_type,$data); if( $rc < 0 ){ carp("Error reading data from file in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); return undef; } if( $varLenString ){ # Convert variable-length string to fixed-length string, to be compatible with the PDL::Char type my $maxsize = PDL::IO::HDF5::findMaxVarLenSize($data, $nelems); # Create empty space for the fixed-length data # Incrementally, to get around problem on win32 my $howBig = $maxsize + 1; # Adding one to include the null string terminator my $fixeddata = ' ' x $howBig; foreach my $dim(@pdldims){ $fixeddata = $fixeddata x $dim; } PDL::IO::HDF5::copyVarLenToFixed($data, $fixeddata, $nelems, $maxsize); # Reclaim data from HDF5 system (HDF5 allocates memory when it reads variable-length strings) $rc = PDL::IO::HDF5::H5Dvlen_reclaim ($internalhdf5_type, $dataspaceID, PDL::IO::HDF5::H5P_DEFAULT(), $data); if( $rc < 0 ){ carp("Error reclaiming memeory while reading data from file in ".__PACKAGE__.":get\n"); carp("Can't close Datatype in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":get\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); return undef; } # Adjust for fixed-length PDL creation $data = $fixeddata; unshift @pdldims, ($maxsize+1); } # Setup the PDL with the proper dimensions and data $attrValue->setdims(\@pdldims); ${$attrValue->get_dataref()} = $data; $attrValue->upd_data(); #************************************************ } # End of PDL option # Cleanup carp("Can't close Datatype in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Tclose($HDF5type) < 0); carp("Can't close DataSpace in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Sclose($dataspaceID) < 0); carp("Can't close Attribute in ".__PACKAGE__.":attrGet\n") if( PDL::IO::HDF5::H5Aclose($attrID) < 0); } continue{ push @attrValues, $attrValue; } return @attrValues; } =head2 IDget =for ref Returns the HDF5 library ID for this object B =for usage my $ID = $dataSetObj->IDget; =cut sub IDget{ my $self = shift; return $self->{ID}; } =head2 nameGet =for ref Returns the HDF5 Dataset Name for this object. B =for usage my $name = $datasetObj->nameGet; =cut sub nameGet{ my $self = shift; return $self->{name}; } 1; PDL-IO-HDF5-0.63/HDF5/Group.pm0000744002141500001300000002360311554061206014471 0ustar cerneydbteampackage PDL::IO::HDF5::Group; use Carp; use strict; =head1 NAME PDL::IO::HDF5::Group - PDL::IO::HDF5 Helper Object representing HDF5 groups. =head1 DESCRIPTION This is a helper-object used by PDL::IO::HDF5 to interface with HDF5 format's group objects. Information on the HDF5 Format can be found at the NCSA's web site at http://hdf.ncsa.uiuc.edu/ . =head1 SYNOPSIS See L =head1 MEMBER DATA =over 1 =item ID ID number given to the group by the HDF5 library =item name Name of the group. (Absolute to the root group '/'. e.g. /maingroup/subgroup) =item parent Ref to parent object (file or group) that owns this group. =item fileObj Ref to the L object that owns this object. =back =head1 METHODS ####--------------------------------------------------------- =head2 new =for ref PDL::IO::HDF5::Group Constructor - creates new object B =for usage This object will usually be created using the calling format detailed in the L. The following syntax is used by the L object to build the object. $a = new PDL::IO::HDF5:Group( name => $name, parent => $parent, fileObj => $fileObj ); Args: $name Name of the group (relative to the parent) $parent Parent Object that owns this group $fileObj PDL::HDF (Top Level) object that owns this group. =cut sub new{ my $type = shift; my %parms = @_; my $self = {}; my @DataMembers = qw( name parent fileObj); my %DataMembers; @DataMembers{ @DataMembers } = @DataMembers; # hash for quick lookup # check for proper supplied names: my $varName; foreach $varName(keys %parms){ unless( defined($DataMembers{$varName})){ carp("Error Calling ".__PACKAGE__." Constuctor\n \'$varName\' not a valid data member\n"); return undef; } $self->{$varName} = $parms{$varName}; } my $parent = $self->{parent}; my $parentID = $parent->IDget; my $parentName = $parent->nameGet; my $groupName = $self->{name}; my $groupID; # Adjust groupname to be absolute: if( $parentName ne '/') { # Parent is not the root group $self->{name} = "$parentName/$groupName"; } else{ # Parent is root group $self->{name} = "$parentName$groupName"; } # Turn Error Reporting off for the following, so H5 lib doesn't complain # if the group isn't found. PDL::IO::HDF5::H5errorOff(); my $rc = PDL::IO::HDF5::H5Gget_objinfo($parentID, $groupName,1,0); PDL::IO::HDF5::H5errorOn(); # See if the group exists: if( $rc >= 0){ #Group Exists open it: $groupID = PDL::IO::HDF5::H5Gopen($parentID, $groupName); } else{ # group didn't exist, create it: $groupID = PDL::IO::HDF5::H5Gcreate($parentID, $groupName, 0); # Clear-out the attribute index, it is no longer valid with the updates # we just made. $self->{fileObj}->clearAttrIndex; } # Try Opening the Group First (Assume it already exists) if($groupID < 0 ){ carp "Error Calling ".__PACKAGE__." Constuctor: Can't open or create group '$groupName'\n"; return undef; } $self->{ID} = $groupID; bless $self, $type; return $self; } =head2 DESTROY =for ref PDL::IO::HDF5 Destructor - Closes the HDF5::Group Object. B =for usage No Usage. Automatically called =cut sub DESTROY { my $self = shift; #print "In Group DEstroy\n"; if( PDL::IO::HDF5::H5Gclose($self->{ID}) < 0){ warn("Error closing HDF5 Group '".$self->{name}."' in file '".$self->{parentName}."'\n"); } } =head2 attrSet =for ref Set the value of an attribute(s) Attribute types supported are null-terminated strings and PDL matrices B =for usage $group->attrSet( 'attr1' => 'attr1Value', 'attr2' => 'attr2 value', 'attr3' => $pdl, . . . ); Returns undef on failure, 1 on success. =cut sub attrSet { my $self = shift; # Attribute setting for groups is exactly like datasets # Call datasets directly (This breaks OO inheritance, but is # better than duplicating code from the dataset object here return $self->PDL::IO::HDF5::Dataset::attrSet(@_); } =head2 attrGet =for ref Get the value of an attribute(s) Currently the only attribute types supported are null-terminated strings. B =for usage my @attrs = $group->attrGet( 'attr1', 'attr2'); =cut sub attrGet { my $self = shift; # Attribute reading for groups is exactly like datasets # Call datasets directly (This breaks OO inheritance, but is # better than duplicating code from the dataset object here return $self->PDL::IO::HDF5::Dataset::attrGet(@_); } =head2 attrDel =for ref Delete attribute(s) B =for usage $group->attrDel( 'attr1', 'attr2', . . . ); Returns undef on failure, 1 on success. =cut sub attrDel { my $self = shift; my @attrs = @_; # get atribute names my $groupID = $self->{ID}; my $attr; my $rc; #Return code returned by H5Adelete foreach $attr( @attrs ){ # Note: We don't consider errors here as cause for aborting, we just # complain using carp if( PDL::IO::HDF5::H5Adelete($groupID, $attr) < 0){ carp "Error in ".__PACKAGE__." attrDel; Error Deleting attribute '$attr'\n"; } } # Clear-out the attribute index, it is no longer valid with the updates # we just made. $self->{fileObj}->clearAttrIndex; return 1; } =head2 attrs =for ref Get a list of all attribute names in a group B =for usage @attrs = $group->attrs; =cut sub attrs { my $self = shift; my $groupID = $self->{ID}; my $defaultMaxSize = 256; # default max size of a attribute name my $noAttr = PDL::IO::HDF5::H5Aget_num_attrs($groupID); # get the number of attributes my $attrIndex = 0; # attribute Index my @attrNames = (); my $attributeID; my $attrNameSize; # size of the attribute name my $attrName; # attribute name # Go thru each attribute and get the name for( $attrIndex = 0; $attrIndex < $noAttr; $attrIndex++){ $attributeID = PDL::IO::HDF5::H5Aopen_idx($groupID, $attrIndex ); if( $attributeID < 0){ carp "Error in ".__PACKAGE__." attrs; Error Opening attribute number $attrIndex\n"; next; } #init attrname to 256 length string (Maybe this not necessary with # the typemap) $attrName = ' ' x 256; # Get the name $attrNameSize = PDL::IO::HDF5::H5Aget_name($attributeID, 256, $attrName ); # If the name is greater than 256, try again with the proper size: if( $attrNameSize > 256 ){ $attrName = ' ' x $attrNameSize; $attrNameSize = PDL::IO::HDF5::H5Aget_name($attributeID, $attrNameSize, $attrName ); } push @attrNames, $attrName; # Close the attr: PDL::IO::HDF5::H5Aclose($attributeID); } return @attrNames; } =head2 dataset =for ref Open an existing or create a new dataset in a group. B =for usage $dataset = $group->dataset('newdataset'); Returns undef on failure, 1 on success. =cut sub dataset { my $self = shift; my $name = $_[0]; my $groupID = $self->{ID}; # get the group name of the current group my $dataset = PDL::IO::HDF5::Dataset->new( name=> $name, parent => $self, fileObj => $self->{fileObj} ); } =head2 datasets =for ref Get a list of all dataset names in a group. (Relative to the current group) B =for usage @datasets = $group->datasets; =cut sub datasets { my $self = shift; my $groupID = $self->{ID}; my @totalDatasets = PDL::IO::HDF5::H5GgetDatasetNames($groupID,"."); return @totalDatasets; } =head2 group =for ref Open an existing or create a new group in an existing group. B =for usage $newgroup = $oldgroup->group("newgroup"); Returns undef on failure, 1 on success. =cut sub group { my $self = shift; my $name = $_[0]; # get the group name my $group = new PDL::IO::HDF5::Group( name=> $name, parent => $self, fileObj => $self->{fileObj} ); return $group; } =head2 groups =for ref Get a list of all group names in a group. (Relative to the current group) B =for usage @groupNames = $group->groups; =cut sub groups { my $self = shift; my $groupID = $self->{ID}; my @totalgroups = PDL::IO::HDF5::H5GgetGroupNames($groupID,'.'); return @totalgroups; } =head2 _buildAttrIndex =for ref Internal Recursive Method to build the attribute index hash for the object For the purposes of indexing groups by their attributes, the attributes are applied hierarchial. i.e. any attributes of the higher level groups are assumed to be apply for the lower level groups. B =for usage $group->_buildAttrIndex($index, $currentAttrs); Input/Output: $index: Total Index hash ref $currentAttrs: Hash refs of the attributes valid for the current group. =cut sub _buildAttrIndex{ my ($self, $index, $currentAttrs) = @_; # Take care of any attributes in the current group my @attrs = $self->attrs; my @attrValues = $self->attrGet(@attrs); # Get the group name my $groupName = $self->nameGet; my %indexElement; # element of the index for this group %indexElement = %$currentAttrs; # Initialize index element # with attributes valid at the # group above # Add (or overwrite) attributes for this group # i.e. local group attributes take precedence over # higher-level attributes @indexElement{@attrs} = @attrValues; $index->{$groupName} = \%indexElement; # Now Do any subgroups: my @subGroups = $self->groups; my $subGroup; foreach $subGroup(@subGroups){ $self->group($subGroup)->_buildAttrIndex($index,\%indexElement); } } =head2 IDget =for ref Returns the HDF5 library ID for this object B =for usage my $ID = $groupObj->IDget; =cut sub IDget{ my $self = shift; return $self->{ID}; } =head2 nameGet =for ref Returns the HDF5 Group Name for this object. (Relative to the root group) B =for usage my $name = $groupObj->nameGet; =cut sub nameGet{ my $self = shift; return $self->{name}; } 1; PDL-IO-HDF5-0.63/HDF5/tkview.pm0000755002141500001300000001536707524226707014733 0ustar cerneydbteam#!/usr/local/bin/perl -w package PDL::IO::HDF5::tkview; # Experimental module to view HDF5 using perl/tk and PDL::IO::HDF5 modules use Tk 800; use Tk::Tree; use IO::File; =head1 NAME PDL::IO::HDF5::tkview - View HDF5 files using perl/tk and PDL::IO::HDF5 modules =head1 DESCRIPTION This is a experimental object to view HDF5 files the PDL::IO::HDF5 module. The HDF files are displayed in a tree structure using Tk::Tree =head1 SYNOPSIS use Tk; use PDL::IO::HDF5::tkview use PDL::IO::HDF5; my $mw = MainWindow->new; my $h5 = new PDL::IO::HDF5('datafile.h5'); # open HDF5 file object my $tkview = new PDL::IO::HDF5::tkview( $mw, $h5); MainLoop; =head1 MEMBER DATA =over 1 =item mw Tk window where the file structure is displayed. =item H5obj PDL::IO::HDF5 Object =item hl Tk Hlist object =item dataDisplaySub Sub ref to execute when a dataset is double-clicked. This defaults to a print of the dataset. See L for details. Tk Hlist object =back =head1 METHODS ####--------------------------------------------------------- =head2 new =for ref PDL::IO::HDF5::tkview Constructor - creates new object B =for usage $tkview = new PDL::IO::HDF5::tkview( $mw, $H5obj); Where: $mw Tk window $H5obj PDL::IO::HDF5::Object =cut # Cube Image Pixmap (ppm) format. raw data string $cubeImage = '/* XPM */ static char * cube_xpm[] = { "12 12 3 1", " c #FFFFFFFFFFFF", ". c #000000000000", "X c #FFFFFFFF0000", " ........", " .XXXXXX..", " .XXXXXX.X.", " ........XX.", " .XXXXXX.XX.", " .XXXXXX.XX.", " .XXXXXX.XX.", " .XXXXXX.XX.", " .XXXXXX.X. ", " .XXXXXX.. ", " ........ ", " "};'; # ----------------------------------------------- # Routine to create the array_display window sub new{ my $type = shift; # get the class type my $mw = $_[0]; my $H5obj = $_[1]; my $self = {}; # setup member variables: $self->{mw} = $mw; $self->{H5obj} = $H5obj; bless $self, $type; # setup the window if (defined $H5obj){ my $hl = $mw->Scrolled('Tree',-separator => $;,-drawbranch => 1, -width => '15', -bg => 'white'); $hl->configure(-opencmd => [\&More,$self, $hl]); $hl->configure(-command => [\&activateCmd,$self]); # command to called when entry double-clicked my $name = $H5obj->filename; $hl->add($name, -text => $name, -data => $H5obj, -itemtype => 'imagetext'); $hl->setmode($name => 'close'); # Get Images for display $self->{groupImage} = $mw->Pixmap(-file => Tk->findINC('winfolder.xpm') ); $self->{cubeImage} = $mw->Pixmap(-data => $cubeImage ); AddChildren($self,$hl,$name,$H5obj); $hl->pack(-expand=> 1, -fill => 'both'); $self->{hl} = $hl; # Set Default dataDisplaySub $self->{dataDisplaySub} = sub{ print $_[0]}; } return $self; } # sub to add elements to the hlist after an element in the list has been expanded (i.e. clicked-on) sub AddChildren { my $self = shift; my ($hl,$path,$data) = @_; # hl list object, location, data my $w; my $name; my $text; if( ref($data) =~ /Group/ || !($path =~ /$;/ ) ){ # Current Item to expand is a group or top level of file # Display any Attributes First: my @attrs; # attributes stored my %attrs; @attrs = sort $data->attrs; if( @attrs){ # set attribute hash if there are attributes @attrs{@attrs} = $data->attrGet(@attrs); # attrget not defined yet } my ($attr, $attrValue); foreach $attr(@attrs){ # add each attribute to the display $attrValue = $attrs{$attr}; $text = "$attr: $attrValue"; $hl->add("$path$;"."_Attr$attr", -text => $text, -data => $attrValue); } # Display Datasets next: my @datasets; # dataset names stored @datasets = sort $data->datasets; # get list of datasets in the current group/file my ($dataset, @dims); foreach $dataset(@datasets){ # add each attribute to the display my $datasetData = $data->dataset($dataset); @dims = $datasetData->dims; # get the dims of the dataset if( @dims){ # > 0-dimensional dataset $text = "$dataset: Dims ".join(", ",@dims); } else{ # zero-dimensional dataset $text = "$dataset: ".$datasetData->get; } $hl->add("$path$;"."_Dset$dataset", -image => $self->{cubeImage}, -text => $text, -data => $data); } # Display Groups Next my @groups; # groups stored @groups = sort $data->groups; my ($group, $groupName); foreach $groupName(@groups){ # Add each group to the display # data element is the parent object and the group name. $hl->add("$path$;"."_Group$groupName", -image => $self->{groupImage}, -text => $groupName, -data => [ $data,$groupName] ); $hl->setmode( "$path$;"."_Group$groupName", "open"); } } } # This Sub called when a element of the H-list is expanded/collapsed. (i.e. clicked-on) sub More { my $self = shift; my ($w,$item) = @_; # hl list object, hlist item name if( defined $w->info('children',$item) > 0){ #get rid of old elements if it has already been opened # print "Has children\n"; $w->delete('offsprings',$item); } # print "item = $item\n"; my $data = $w->entrycget($item,'-data'); #get the data ref for this entry my @levels = split($;,$item); if( @levels && ( $levels[-1] =~ /^_Group/) ){ # if this is a group then get the group object my ($obj, $groupName) = @$data; $data = $obj->group($groupName); } $self->AddChildren($w,$item,$data); } =head2 dataDisplaySubSet =for ref Set the dataDisplaySub data member. B =for usage # Data Display sub to call when a dataset is double-clicked my $dataDisplay = sub{ my $data = $_[0]; print "I'm Displaying This $data\n";}; $tkview->dataDisplaySubSet($dataDisplay); The dataDisplaySub data member is a perl sub ref that is called when a dataset is double-clicked. This data member is initially set to just print the dataset's data to the command line. Using the L method, different actions for displaying the data can be "plugged-in". =cut sub dataDisplaySubSet { my ($self, $subref) = @_; $self->{dataDisplaySub} = $subref; } #------------------------------------------------------------------- =head2 activateCmd =for ref Internal Display method invoked whenever a tree element is activated (i.e. double-clicked). This method does nothing unless a dataset element has been selected. It that cases it calls $self->dataDisplaySub with the data. =cut sub activateCmd{ my $self = shift; my ($name) = (@_); # Name of the hlist element that was selected return unless($name =~ /$;_Dset(.+)$/); # only process datasets my $datasetName = $1; my $hlist = $self->{hl}; my $group = $hlist->entrycget($name,'-data'); my $PDL = $group->dataset($datasetName)->get; my $dataDisplaySub = $self->{dataDisplaySub}; &$dataDisplaySub($PDL) } 1; PDL-IO-HDF5-0.63/COPYRIGHT0000644002141500001300000000032010411054216013624 0ustar cerneydbteamFor the PDL version of the HDF5 interface: Copyright (c) 2001 John Cerney. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. PDL-IO-HDF5-0.63/Makefile.PL0000744002141500001300000001061111516422525014321 0ustar cerneydbteam# Makefile.PL for a package defined by PP code. # Check for a PDL installation BEGIN { eval{ require PDL::Core::Dev }; if( $@ ){ print "\n#### Error requiring 'PDL::Core::Dev': Perhaps you don't have PDL installed ###\n"; print "#### This module requires a PDL installation ###\n"; require ExtUtils::MakeMaker; import ExtUtils::MakeMaker; # Write out a simple makefile with PREREQ_PM, so CPAN will at least detect our # prerequesites. WriteMakefile( 'VERSION_FROM' => 'hdf5.pd', 'NAME' => 'PDL::IO::HDF5', 'DISTNAME' => "PDL-IO=HDF5", 'PREREQ_PM' => { PDL => 2.1 } ); exit(); } } use PDL::Core::Dev; # Pick up development utilities use ExtUtils::MakeMaker; use Config; # ## Search for hdf5 library and include file # $ENV{'HOME'} = '' unless defined( $ENV{'HOME'} ) ; foreach my $libdir ( '/usr/local/hdf5/lib', '/usr/local/lib', '/opt/local/lib', '/usr/lib', '/opt/lib', "$ENV{HOME}/hdf5/lib", # for local hdf5 installs # Add new library paths here!! ) { if (-e "$libdir/libhdf5.so") { $hdf5_lib_path = $libdir; print "Found libhdf5.so at $libdir/libhdf5.so\n"; last; } if (-e "$libdir/libhdf5.a") { $hdf5_lib_path = $libdir; print "Found libhdf5.a at $libdir/libhdf5.a\n"; last; } } # We don't do a die here, because we would get bogus emails from CPAN testers unless(defined ($hdf5_lib_path) ){ print "####### Cannot find hdf5 library, libhdf5.so or libhdf5.a. ####### Please add the correct library path to Makefile.PL or install HDF\n"; exit(); } foreach my $incdir ( '/usr/local/hdf5/include', '/usr/local/include', '/opt/local/include', '/usr/include', '/opt/include', "$ENV{HOME}/hdf5/include", # for local hdf5 installs # Add new header paths here!! ) { if (-e "$incdir/hdf5.h") { $hdf5_include_path = $incdir; print "Found hdf5.h at $incdir/hdf5.h\n"; last; } } # We don't do a die here, because we would get bogus emails from CPAN testers unless ( defined ($hdf5_include_path) ){ print "####### Cannot find hdf5 header file, hdf5.h. ####### Please add the correct library path to Makefile.PL or install HDF5\n"; exit(); } # Flags to include jpeg and/or zlib during compilation $jpegLib = 0; $zLib = 0; if( -e "$hdf5_include_path/H5config.h"){ open( H5CONFIG, "$hdf5_include_path/H5config.h") or die("Can't Open Include File '$hdf5_include_path/H5config.h'\n"); while(defined( $_ = )){ $jpegLib = 1 if( /^\s*\#define\s+HAVE_LIBJPEG\s+1/ ); $zLib = 1 if( /^\s*\#define\s+HAVE_LIBZ\s+1/ ); } } # The following code was originally in the PDL::netCDF Makefile.PL # (Not sure if it is really needed here) # Check if compiled under gcc/Linux. In which case, define bool for the compiler $define_bool = ''; if ($Config{'osname'} =~ /linux/) { $define_bool = '-Dbool=int'; print "Defining bool=int (linux seems to need this)\n"; } #If in win32, add the required defined for the HDF5 libs to work: $define_win32HDF = ''; if ($Config{'osname'} =~ /win32/i) { $define_win32HDF = '-D _HDF5USEDLL_ -D HASATTRIBUTE '; print "Defining _HDF5USEDLL_ for win32\n"; } $LIBS = "-L$hdf5_lib_path -lhdf5 "; $LIBS .= " -lz" if($zLib); $LIBS .= " -ljpeg" if($jpegLib); $LIBS .= " -lm"; $package = ["hdf5.pd",HDF5,PDL::IO::HDF5]; WriteMakefile( 'NAME' => 'PDL::IO::HDF5', 'CCFLAGS' => "$define_bool $define_win32HDF -DH5_USE_16_API -g", 'PREREQ_PM' => { PDL => 2.1 }, 'VERSION_FROM' => 'hdf5.pd', 'TYPEMAPS' => [&PDL_TYPEMAP()], 'OBJECT' => 'HDF5.o ', 'PM' => { 'HDF5.pm' => '$(INST_LIBDIR)/HDF5.pm', 'HDF5/Group.pm' => '$(INST_LIBDIR)/HDF5/Group.pm', 'HDF5/Dataset.pm' => '$(INST_LIBDIR)/HDF5/Dataset.pm', 'HDF5/tkview.pm' => '$(INST_LIBDIR)/HDF5/tkview.pm', }, 'INC' => &PDL_INCLUDE()." -I$hdf5_include_path", 'LIBS' => [$LIBS], 'clean' => {'FILES' => 'HDF5.pm HDF5.xs HDF5.o HDF5.c'}, 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' }, ); sub MY::postamble { pdlpp_postamble($package); } PDL-IO-HDF5-0.63/README0000755002141500001300000000227411554061356013242 0ustar cerneydbteamPDL::IO::HDF5, version 0.63 From The Man Pages: ------------------- NAME PDL::IO::HDF5 - PDL Interface to the HDF5 Data Format. DESCRIPTION This package provides an object-oriented interface for the PDL package to the HDF5 data-format. Information on the HDF5 Format can be found at the NCSA's web site at http://hdf.ncsa.uiuc.edu/ . LIMITATIONS Currently this interface only provides a subset of the total HDF5 library's capability. o Only HDF5 Simple datatypes are supported. No HDF5 Compound datatypes are supported since PDL doesn't support them. o Only HDF5 Simple dataspaces are supported. Also Included: -------------- An experimental module for interactive viewing of HDF5 files using perl/tk is also included. The file tkviewtest is a short demo of this capability. The following are required for installation: -------------------------------------------- -- PDL v2.004 -- HDF5 version 1.2.0 Installation: ------------ Installation should be the normal: perl Makefile.PL make make test (as root) make install Acknowledgements ---------------- Tbe idea for this module is based on the code of Doug Hunt's PDL::netCDF module. PDL-IO-HDF5-0.63/hdf5.pd0000744002141500001300000015652711554061356013546 0ustar cerneydbteamuse Config; our $VERSION = 0.63; pp_setversion(0.63); # Necessary includes for .xs file pp_addhdr(<<'EOH'); #include #define PDLchar pdl #define PDLuchar pdl #define PDLshort pdl #define PDLint pdl #define PDLlong pdl #define PDLfloat pdl #define PDLdouble pdl #define uchar unsigned char EOH pp_bless ("PDL::IO::HDF5"); pp_addpm(<<'EOPM'); =head1 NAME PDL::IO::HDF5 - PDL Interface to the HDF5 Data Format. =head1 DESCRIPTION This package provides an object-oriented interface for Ls to the HDF5 data-format. Information on the HDF5 Format can be found at the NCSA's web site at http://www.hdfgroup.org . =head2 LIMITATIONS Currently this interface only provides a subset of the total HDF5 library's capability. =over 1 =item * Only HDF5 Simple datatypes are supported. No HDF5 Compound datatypes are supported since PDL doesn't support them. =item * Only HDF5 Simple dataspaces are supported. =back =head1 SYNOPSIS use PDL::IO::HDF5; # Files ####### my $newfile = new PDL::IO::HDF5("newfile.hdf"); # create new hdf5 or open existing file. my $attrValue = $existingFile->attrGet('AttrName'); # Get attribute value for file $existingFile->attSet('AttrName' => 'AttrValue'); # Set attribute value(s) for file #Groups ###### my $group = $newfile->group("/mygroup"); # create a new or open existing group my @groups = $existingFile->groups; # get a list of all the groups at the root '/' # level. my @groups = $group->groups; # get a list of all the groups at the "mygroup" # level. my $group2 = $group->group('newgroup'); # Create/open a new group in existing group "mygroup" my $attrValue = $group->attrGet('AttrName'); # Get attribute value for a group $group->attrSet('AttrName' => 'AttrValue'); # Set attribute value(s) for a group $group->attrDel('AttrName1', 'AttrName2'); # Delete attribute(s) for a group @attrs = $group->attrs; # Get List of attributes for a group # Data Sets ######## my $dataset = $group->dataset( 'datasetName'); # create a new or open existing dataset # in an existing group my $dataset = $newfile->dataset( 'datasetName'); # create a new or open existing dataset # in the root group of a file my $dataset2 = $newfile->dataset( 'datasetName'); # create a new or open existing dataset # in the root group. my @datasets = $existingFile->datasets; # get a list of all datasets in the root '/' group my @datasets = $group->datasets; # get a list of all datasets in a group @dims = $dataset->dims; # get a list of dimensions for the dataset $pdl = $dataset->get(); # Get the array data in the dataset $pdl = $dataset->get($start,$length,$stride); # Get a slice or hyperslab of the array data in the dataset $dataset->set($pdl); # Set the array data in the dataset my $attrValue = $dataset->attrGet('AttrName'); # Get attribute value for a dataset $dataset->attSet('AttrName' => 'AttrValue'); # Set attribute value(s) for a dataset =head1 MEMBER DATA =over 1 =item ID ID number given to the file by the HDF5 library =item filename Name of the file. =item accessMode Access Mode?? ( read /write etc????) =item attrIndex Quick lookup index of group names to attribute values. Autogenerated as-needed by the L, L, L methods. Any attribute writes or group creations will delete this data member, because it will no longer be valid. The index is of this form: { groupName1 => { attr1 => value, attr2 => value }. groupName2 => { attr1 => value, attr3 => value }. . . . } For the purposes of indexing groups by their attributes, the attributes are applied hierarchically. i.e. any attributes of the higher level groups are assumed to be apply for the lower level groups. =item groupIndex Quick lookup index of attribute names/values group names. This index is used by the L method to quickly find any group(s) that have attribute that match a desired set. The index is of this form: { "attr1\0attt2" => { "value1\0value2' => [ group1, group2, ...], "value3\0value3' => [ groupA ], . . . }, "att1" => { "value1' => [ group1, group2, ...], "value3' => [ groupA ] . . . }, . . . } The first level of the index maps the attribute name combinations that have indexes built to their index. The second level maps the corresponding attribute values with the group(s) where these attributes take on these values. groupName1 => { attr1 => value, attr2 => value }. groupName2 => { attr1 => value, attr3 => value }. . . . } For the purposes of indexing groups by their attributes, the attributes are applied hierarchically. i.e. any attributes of the higher level groups are assumed to be apply for the lower level groups. =back =head1 METHODS =head2 new =for ref PDL::IO::HDF5 constructor - creates PDL::IO::HDF5 object for reading or writing data. B =for usage $a = new PDL::IO::HDF5( $filename ); Arguments: 1) The name of the file. If this file exists and you want to write to it, prepend the name with the '>' character: ">name.nc" Returns undef on failure. B =for example $hdf5obj = new PDL::IO::HDF5( "file.hdf" ); =cut sub new { my $type = shift; my $file = shift; my $self = {}; my $rc; my $write; if (substr($file, 0, 1) eq '>') { # open for writing $file = substr ($file, 1); # chop off > $write = 1; } my $fileID; # HDF file id if (-e $file) { # Existing File if ($write) { $fileID = H5Fopen($file, H5F_ACC_RDWR(), H5P_DEFAULT()); if( $fileID < 0){ carp("Can't Open Existing HDF file '$file' for writing\n"); return undef; } $self->{accessMode} = 'w'; } else { # Open read-only $fileID = H5Fopen($file, H5F_ACC_RDONLY(), H5P_DEFAULT()); if( $fileID < 0){ carp("Can't Open Existing HDF file '$file' for reading\n"); return undef; } $self->{accessMode} = 'r'; } } else{ # File doesn't exist, create it: $fileID = H5Fcreate($file, H5F_ACC_TRUNC(), H5P_DEFAULT(), H5P_DEFAULT()); if( $fileID < 0){ carp("Can't Open New HDF file '$file' for writing\n"); return undef; } $self->{accessMode} = 'w'; } # Record file name, ID $self->{filename} = $file; $self->{ID} = $fileID; $self->{attrIndex} = undef; # Initialize attrIndex $self->{groupIndex} = undef; # Initialize groupIndex bless $self, $type; } =head2 filename =for ref Get the filename for the HDF5 file B =for usage my $filename = $HDFfile->filename; =cut sub filename { my $self = shift; return $self->{filename}; } =head2 group =for ref Open or create a group in the root "/" group (i.e. top level) of the HDF5 file. B =for usage $HDFfile->group("groupName"); Returns undef on failure, 1 on success. =cut sub group { my $self = shift; my $name = $_[0]; # get the group name my $parentID = $self->{ID}; my $parentName = ''; my $group = new PDL::IO::HDF5::Group( 'name'=> $name, parent => $self, fileObj => $self ); } =head2 groups =for ref Get a list of groups in the root "/" group (i.e. top level) of the HDF5 file. B =for usage @groups = $HDFfile->groups; =cut sub groups { my $self = shift; my @groups = $self->group("/")->groups; return @groups; } =head2 dataset =for ref Open or create a dataset in the root "/" group (i.e. top level) of the HDF5 file. B =for usage $HDFfile->dataset("groupName"); Returns undef on failure, 1 on success. Note: This is a convienence method that is equivalent to: $HDFfile->group("/")->dataset("groupName"); =cut sub dataset { my $self = shift; my $name = $_[0]; # get the dataset name return $self->group("/")->dataset($name); } =head2 datasets =for ref Get a list of all dataset names in the root "/" group. B =for usage @datasets = $HDF5file->datasets; Note: This is a convienence method that is equivalent to: $HDFfile->group("/")->datasets; =cut sub datasets{ my $self = shift; my $name = $_[0]; # get the dataset name return $self->group("/")->datasets; } =head2 attrSet =for ref Set the value of an attribute(s) in the root '/' group of the file. Currently attribute types supported are null-terminated strings and any PDL type. B =for usage $HDFfile->attrSet( 'attr1' => 'attr1Value', 'attr2' => 'attr2 value', 'attr3' => $pdl, . . . ); Returns undef on failure, 1 on success. Note: This is a convienence method that is equivalent to: $HDFfile->group("/")->attrSet( 'attr1' => 'attr1Value', 'attr2' => 'attr2 value', 'attr3' => $pdl, . . . ); =cut sub attrSet { my $self = shift; my %attrs = @_; # get atribute hash return $self->group("/")->attrSet(%attrs); } =head2 attrGet =for ref Get the value of an attribute(s) in the root '/' group of the file. Currently the attribute types supported are null-terminated strings and PDLs. B =for usage @attrValues = $HDFfile->attrGet( 'attr1', 'attr2' ); =cut sub attrGet { my $self = shift; my @attrs = @_; # get atribute hash return $self->group("/")->attrGet(@attrs); } =head2 attrDel =for ref Delete attribute(s) in the root "/" group of the file. B =for usage $HDFfile->attrDel( 'attr1', 'attr2', . . . ); Returns undef on failure, 1 on success. Note: This is a convienence method that is equivalent to: $HDFfile->group("/")->attrDel( 'attr1', 'attr2', . . . ); =cut sub attrDel { my $self = shift; my @attrs = @_; # get atribute names return $self->group("/")->attrDel(@attrs); } =head2 attrs =for ref Get a list of all attribute names in the root "/" group of the file. B =for usage @attrs = $HDFfile->attrs; Note: This is a convienence method that is equivalent to: $HDFfile->group("/")->attrs =cut sub attrs { my $self = shift; return $self->group("/")->attrs; } =head2 _buildAttrIndex =for ref Internal Method to build the attribute index hash for the object B =for usage $hdf5obj->_buildAttrIndex; Output: Updated attrIndex data member =cut sub _buildAttrIndex{ my ($self) = @_; # Take care of any attributes in the current group my @attrs = $self->attrs; my @attrValues = $self->attrGet(@attrs); my $index = $self->{attrIndex} = {}; my %indexElement; # element of the index for this group @indexElement{@attrs} = @attrValues; $index->{'/'} = \%indexElement; my $topLevelAttrs = { %indexElement }; # Now Do any subgroups: my @subGroups = $self->groups; my $subGroup; foreach $subGroup(@subGroups){ $self->group($subGroup)->_buildAttrIndex($index,$topLevelAttrs); } } =head2 clearAttrIndex =for ref Method to clear the attribute index hash for the object. This is a mostly internal method that is called whenever some part of the HDF5 file has changed and the L index is no longer valid. B =for usage $hdf5obj->clearAttrIndex; =cut sub clearAttrIndex{ my $self = shift; $self->{attrIndex} = undef; } =head2 _buildGroupIndex =for ref Internal Method to build the groupIndex hash for the object B =for usage $hdf5obj->_buildGroupIndex(@attrs); where: @attrs List of attribute names to build a group index on. Output: Updated groupIndex data member =cut sub _buildGroupIndex{ my ($self,@attrs) = @_; @attrs = sort @attrs; # Sort the attributes so the order won't matter # Generate attrIndex if not there yet defined( $self->{attrIndex}) || $self->_buildAttrIndex; my $attrIndex = $self->{attrIndex}; my $groupIndexElement = {}; # Element of the group index that we will build my $group; my $attrIndexElement; # Attr index for the current group my @attrValues; # attr values corresponding to @attrs for the current group my $key; # group index key # Go Thru All Groups foreach $group(sort keys %$attrIndex){ $attrIndexElement = $attrIndex->{$group}; @attrValues = map defined($_) ? $_ : '_undef_', @$attrIndexElement{@attrs}; # Groups with undefined attr will get a '_undef_' string for the value # Use multi-dimensional array emulation for the hash # key here because it should be quicker. if( defined( $groupIndexElement->{$key = join($;,@attrValues)}) ) { # if already defined, add to the list push @{$groupIndexElement->{$key}}, $group; } else{ # not already defined create new element $groupIndexElement->{$key} = [ $group ]; } } # initialize group index if it doesn't exist. unless( defined $self->{groupIndex} ){ $self->{groupIndex} = {} }; # Use multi-dimensional array emulation for the hash # key here because it should be quicker. $self->{groupIndex}{join($;,@attrs)} = $groupIndexElement; } =head2 clearGroupIndex =for ref Method to clear the group index hash for the object. This is a mostly internal method that is called whenever some part of the HDF5 file has changed and the L index is no longer valid. B =for usage $hdf5obj->clearGroupIndex; =cut sub clearGroupIndex{ my $self = shift; $self->{groupIndex} = undef; } =head2 getGroupsByAttr =for ref Get the group names which attributes match a given set of values. This method enables database-like queries to be made. I.e. you can get answers to questions like 'Which groups have attr1 = value1, and attr3 = value2?'. B =for usage @groupNames = $hdf5Obj->getGroupsByAttr( 'attr1' => 'value1', 'attr2' => 'value2' ); =cut sub getGroupsByAttr{ my $self = shift; my %attrHash = @_; my @keys = sort keys %attrHash; # Use multi-dimensional array emulation for the hash # key here because it should be quicker. my $compositeKey = join($;, @keys); # Generate groupIndex if not there yet defined( $self->{groupIndex}{$compositeKey} ) || $self->_buildGroupIndex(@keys); $groupIndex = $self->{groupIndex}{$compositeKey}; my @values = @attrHash{@keys}; my $compositeValues = join($;, @values); if( defined($groupIndex->{$compositeValues} )){ return @{$groupIndex->{$compositeValues}}; } else{ return (); } } =head2 allAttrValues =for ref Returns information about group attributes defined in the HDF5 datafile. B =for usage # Single Attr Usage. Returns an array of all # values of attribute 'attrName' in the file. $hdf5obj->allAttrValues('attrName'); # Multiple Attr Usage. Returns an 2D array of all # values of attributes 'attr1', 'attr2' in the file. # Higher-Level $hdf5obj->allAttrValues('attr1', 'attr2'); =cut sub allAttrValues{ my $self = shift; my @attrs = @_; # Generate attrIndex if not there yet defined( $self->{attrIndex}) || $self->_buildAttrIndex; my $attrIndex = $self->{attrIndex}; if( @attrs == 1) { # Single Argument Processing my $attr = $attrs[0]; my $group; my @values; my $grpAttrHash; # attr hash for a particular group # Go thru each group and look for instances of $attr foreach $group( keys %$attrIndex){ $grpAttrHash = $attrIndex->{$group}; if( defined($grpAttrHash->{$attr})){ push @values, $grpAttrHash->{$attr}; } } return @values; } else{ # Multiple argument processing my $group; my @values; my $grpAttrHash; # attr hash for a particular group my $attr; # individual attr name my $allAttrSeen; # flag = 0 if we have not seen all of the # desired attributes in the current group my $value; # Current value of the @values array that we # will return # Go thru each group and look for instances of $attr foreach $group( keys %$attrIndex){ $grpAttrHash = $attrIndex->{$group}; # Go thru each attribute $allAttrSeen = 1; # assume we will se all atributes, set to zero if we don't $value = []; foreach $attr(@attrs){ if( defined($grpAttrHash->{$attr})){ push @$value, $grpAttrHash->{$attr}; } else{ $allAttrSeen = 0; } } push @values, $value if $allAttrSeen; #add to values array if we got anything } return @values; } } =head2 allAttrNames =for ref Returns a sorted list of all the group attribute names that are defined in the file. B =for usage my @attrNames = $hdf5obj->allAttrNames; =cut sub allAttrNames{ my $self = shift; # Generate attrIndex if not there yet defined( $self->{attrIndex}) || $self->_buildAttrIndex; my $attrIndex = $self->{attrIndex}; my $group; my %names; my $grpAttrHash; # attr hash for a particular group my @currentNames; # Go thru each group and look for instances of $attr foreach $group( keys %$attrIndex){ $grpAttrHash = $attrIndex->{$group}; @currentNames = keys %$grpAttrHash; @names{@currentNames} = @currentNames; } return sort keys %names; } =head2 IDget =for ref Returns the HDF5 library ID for this object B =for usage my $ID = $hdf5obj->IDget; =cut sub IDget{ my $self = shift; return $self->{ID}; } =head2 nameGet =for ref Returns the HDF5 Group Name for this object. (Always '/', i.e. the root group for this top-level object) B =for usage my $name = $hdf5obj->nameGet; =cut sub nameGet{ my $self = shift; return '/'; } =head2 DESTROY =for ref PDL::IO::HDF5 Desctructor - Closes the HDF5 file B =for usage No Usage. Automatically called =cut sub DESTROY { my $self = shift; if( H5Fclose($self->{ID}) < 0){ warn("Error closing HDF5 file ".$self->{filename}."\n"); } } # # Utility function (Not a Method!!!) # to pack a perl list into a binary structure # to be interpereted as a C array of long longs. This code is build # during the make process to do the Right Thing for big and little # endian machines sub packList{ my @list = @_; if(ref($_[0])){ croak(__PACKAGE__."::packList is not a method!\n"); } EOPM # Packing of long int array structure differs depending on # if the current machine is little or big endian. This logic # probably won't work for 'weird' byte order machine, but for most # others (intel, vax, sun, etc) it should be OK. # if( $Config{'byteorder'} =~ /^1/){ # little endian pp_addpm("\t".'@list = map (( $_,0 ), @list); # Intersperse zeros to make 64 bit hsize_t'); } else{ # Big Endian Machine pp_addpm("\t".'@list = map (( 0,$_ ), @list); # Intersperse zeros to make 64 bit hsize_t'); } pp_addpm(<<'EOPM'); my $list = pack ("L*", @list); return $list; } EOPM pp_addpm(<<'EOPM'); # # Utility function (Not a Method!!!) # to unpack a perl list from a binary structure # that is a C array of long longs. This code is build # during the make process to do the Right Thing for big and little # endian machines sub unpackList{ if(ref($_[0])){ croak(__PACKAGE__."::unpackList is not a method!\n"); } my ($binaryStruct) = (@_); # input binary structure my $listLength = length($binaryStruct) / 8; # list returned will be the # number of bytes in the input struct/8, since # the output numbers are 64bit. EOPM # UnPacking of long int array structure differs depending on # if the current machine is little or big endian. This logic # probably won't work for 'weird' byte order machine, but for most # others (intel, vax, sun, etc) it should be OK. # if( $Config{'byteorder'} =~ /^1/){ # little endian pp_addpm("\t".'my $unpackString = "Lxxxx" x $listLength; # 4 xxxx used to toss upper 32 bits'); } else{ # Big Endian Machine pp_addpm("\t".'my $unpackString = "xxxxL" x $listLength; # 4 xxxx used to toss upper 32 bits'); } pp_addpm(<<'EOPM'); my @list = unpack( $unpackString, $binaryStruct ); return @list; } =head1 AUTHOR John Cerney, j-cerney1@raytheon.com EOPM # Read in a modified hdf.h file. Define # a low-level perl interface to hdf from these definitions. sub create_low_level { # This file must be modified to only include # hdf5 3 function definitions. # Also, all C function declarations must be on one line. my $defn = shift; my @lines = split (/\n/, $defn); foreach (@lines) { next if (/^\#/); # Skip commented out lines next if (/^\s*$/); # Skip blank lines my ($return_type, $func_name, $parms) = /^(\w+\**)\s+(\w+)\s*\((.*?)\)\;/; my @parms = split (/,/, $parms); my @vars = (); my @types = (); my %output = (); foreach $parm (@parms) { my ($varname) = ($parm =~ /(\w+)$/); $parm =~ s/$varname$//; # parm now contains the full C type $output{$varname} = 1 if (($parm =~ /\*/) && ($parm !~ /const/)); $parm =~ s/const //; # get rid of 'const' in C type $parm =~ s/^\s+//; $parm =~ s/\s+$//; # pare off the variable type from 'parm' push (@vars, $varname); push (@types, $parm); } my $xsout = ''; $xsout .= "$return_type\n"; $xsout .= "$func_name (" . join (", ", @vars) . ")\n"; for (my $i=0;$i<@vars;$i++) { $xsout .= "\t$types[$i]\t$vars[$i]\n"; } $xsout .= "CODE:\n"; $xsout .= "\tRETVAL = $func_name ("; for (my $i=0;$i<@vars;$i++) { if ($types[$i] =~ /PDL/) { ($type = $types[$i]) =~ s/PDL//; # Get rid of PDL type when writine xs CODE section $xsout .= "($type)$vars[$i]"."->data,"; } else { $xsout .= "$vars[$i],"; } } chop ($xsout) if( $xsout =~ /\,$/s); # remove last comma, if present $xsout .= ");\n"; $xsout .= "OUTPUT:\n"; $xsout .= "\tRETVAL\n"; foreach $var (keys %output) { $xsout .= "\t$var\n"; } $xsout .= "\n\n"; pp_addxs ('', $xsout); } } #------------------------------------------------------------------------- # Create low level interface from edited hdr5 header file. #------------------------------------------------------------------------- create_low_level (<<'EODEF'); # HDF5 Functions we create an interface to using the perl XS code # # Note: H5Gget_objinfo arg statbuf has been changed from a H5G_stat_t type to # a const void type to avoid compilation errors. This function only used # to determine if a group exists, so the statbuf variable is not used as # I/O variable as stated in the HDF5 docs. hid_t H5Fcreate (const char *name, unsigned flags, hid_t create_id, hid_t access_id); hid_t H5Fopen (const char *name, unsigned flags, hid_t access_id); herr_t H5Fclose (hid_t file_id); # # Dataspace functions hid_t H5Screate_simple (int rank, const hsize_t * dims, const hsize_t * maxdims); herr_t H5Sclose(hid_t space_id); int H5Sget_simple_extent_ndims(hid_t space_id); int H5Sget_simple_extent_dims(hid_t space_id, hsize_t *dims, hsize_t *maxdims); herr_t H5Sselect_hyperslab(hid_t space_id, int op, const hsize_t *start, const hsize_t *stride, const hsize_t *count, const hsize_t *block); # # # Dataset Functions hid_t H5Dcreate (hid_t loc_id, const char *name, hid_t type_id, hid_t space_id, hid_t create_plist_id); hid_t H5Dopen (hid_t loc_id, const char *name); herr_t H5Dwrite (hid_t dataset_id, hid_t mem_type_id, hid_t mem_space_id, hid_t file_space_id, hid_t xfer_plist_id, const char * buf); # H5Dread buf type changed from void * to I8 * so that is can be catergorized separately in the # typemap as a T_PVI traslation herr_t H5Dread (hid_t dataset_id, hid_t mem_type_id, hid_t mem_space_id, hid_t file_space_id, hid_t xfer_plist_id, I8 * buf); hid_t H5Dclose (hid_t dataset_id); hid_t H5Dget_type(hid_t dataset_id); hid_t H5Dget_space(hid_t dataset_id); # H5Dvlen_reclaim buf type changed from void * to I8 * so that is can be catergorized separately in the # typemap as a T_PVI traslation herr_t H5Dvlen_reclaim(hid_t type_id, hid_t space_id, hid_t plist_id, I8 *buf); hid_t H5Gcreate(hid_t loc_id, const char *name, size_t size_hint); hid_t H5Gopen(hid_t loc_id, const char *name); herr_t H5Gclose(hid_t group_id); herr_t H5Gget_objinfo(hid_t loc_id, const char *name, hbool_t follow_link, const void *statbuf); herr_t H5errorOn(); herr_t H5errorOff(); # # Attribute Functions hid_t H5Aopen_name(hid_t loc_id, const char *name); hid_t H5Acreate(hid_t loc_id, const char *name, hid_t type_id, hid_t space_id, hid_t create_plist); # Note: attrib write only supports char buffer right now herr_t H5Awrite (hid_t attr_id, hid_t mem_type_id, I8 * buf); herr_t H5Adelete(hid_t loc_id, const char * name); herr_t H5Aclose(hid_t attr_id); int H5Aget_num_attrs(hid_t loc_id); hid_t H5Aopen_idx(hid_t loc_id, unsigned int idx); ssize_t H5Aget_name(hid_t attr_id, size_t buf_size, char *buf); htri_t H5Sis_simple(hid_t space_id); hid_t H5Aget_space(hid_t attr_id); hid_t H5Aget_type(hid_t attr_id); # The Attrib read only supports char buffer right now herr_t H5Aread(hid_t attr_id, hid_t mem_type_id, I8 *buf); # Type Functions: herr_t H5Tset_size(hid_t type_id, size_t size); herr_t H5Tclose(hid_t type_id); hid_t H5Tcopy(hid_t type_id); size_t H5Tget_size(hid_t type_id); #hid_t H5Tget_super(hid_t type); htri_t H5Tequal(hid_t type_id1, hid_t type_id2); H5T_class_t H5Tget_class(hid_t type_id); htri_t H5Tis_variable_str(hid_t type_id); EODEF # Add Optional HDF Constants to export list. pp_add_exported('', <<'EOPM'); H5F_ACC_DEBUG H5F_ACC_EXCL H5F_ACC_RDONLY H5F_ACC_RDWR H5F_ACC_TRUNC H5P_DEFAULT H5S_ALL H5S_UNLIMITED H5T_ALPHA_B16 H5T_ALPHA_B32 H5T_ALPHA_B64 H5T_ALPHA_B8 H5T_ALPHA_F32 H5T_ALPHA_F64 H5T_ALPHA_I16 H5T_ALPHA_I32 H5T_ALPHA_I64 H5T_ALPHA_I8 H5T_ALPHA_U16 H5T_ALPHA_U32 H5T_ALPHA_U64 H5T_ALPHA_U8 H5T_C_S1 H5T_FORTRAN_S1 H5T_IEEE_F32BE H5T_IEEE_F32LE H5T_IEEE_F64BE H5T_IEEE_F64LE H5T_INTEL_B16 H5T_INTEL_B32 H5T_INTEL_B64 H5T_INTEL_B8 H5T_INTEL_F32 H5T_INTEL_F64 H5T_INTEL_I16 H5T_INTEL_I32 H5T_INTEL_I64 H5T_INTEL_I8 H5T_INTEL_U16 H5T_INTEL_U32 H5T_INTEL_U64 H5T_INTEL_U8 H5T_MIPS_B16 H5T_MIPS_B32 H5T_MIPS_B64 H5T_MIPS_B8 H5T_MIPS_F32 H5T_MIPS_F64 H5T_MIPS_I16 H5T_MIPS_I32 H5T_MIPS_I64 H5T_MIPS_I8 H5T_MIPS_U16 H5T_MIPS_U32 H5T_MIPS_U64 H5T_MIPS_U8 H5T_NATIVE_B16 H5T_NATIVE_B32 H5T_NATIVE_B64 H5T_NATIVE_B8 H5T_NATIVE_CHAR H5T_NATIVE_DOUBLE H5T_NATIVE_FLOAT H5T_NATIVE_HBOOL H5T_NATIVE_HERR H5T_NATIVE_HSIZE H5T_NATIVE_HSSIZE H5T_NATIVE_INT H5T_NATIVE_INT16 H5T_NATIVE_INT32 H5T_NATIVE_INT64 H5T_NATIVE_INT8 H5T_NATIVE_INT_FAST16 H5T_NATIVE_INT_FAST32 H5T_NATIVE_INT_FAST64 H5T_NATIVE_INT_FAST8 H5T_NATIVE_INT_LEAST16 H5T_NATIVE_INT_LEAST32 H5T_NATIVE_INT_LEAST64 H5T_NATIVE_INT_LEAST8 H5T_NATIVE_LDOUBLE H5T_NATIVE_LLONG H5T_NATIVE_LONG H5T_NATIVE_OPAQUE H5T_NATIVE_SCHAR H5T_NATIVE_SHORT H5T_NATIVE_UCHAR H5T_NATIVE_UINT H5T_NATIVE_UINT16 H5T_NATIVE_UINT32 H5T_NATIVE_UINT64 H5T_NATIVE_UINT8 H5T_NATIVE_UINT_FAST16 H5T_NATIVE_UINT_FAST32 H5T_NATIVE_UINT_FAST64 H5T_NATIVE_UINT_FAST8 H5T_NATIVE_UINT_LEAST16 H5T_NATIVE_UINT_LEAST32 H5T_NATIVE_UINT_LEAST64 H5T_NATIVE_UINT_LEAST8 H5T_NATIVE_ULLONG H5T_NATIVE_ULONG H5T_NATIVE_USHORT H5T_STD_B16BE H5T_STD_B16LE H5T_STD_B32BE H5T_STD_B32LE H5T_STD_B64BE H5T_STD_B64LE H5T_STD_B8BE H5T_STD_B8LE H5T_STD_I16BE H5T_STD_I16LE H5T_STD_I32BE H5T_STD_I32LE H5T_STD_I64BE H5T_STD_I64LE H5T_STD_I8BE H5T_STD_I8LE H5T_STD_REF_DSETREG H5T_STD_REF_OBJ H5T_STD_U16BE H5T_STD_U16LE H5T_STD_U32BE H5T_STD_U32LE H5T_STD_U64BE H5T_STD_U64LE H5T_STD_U8BE H5T_STD_U8LE H5T_STRING H5T_UNIX_D32BE H5T_UNIX_D32LE H5T_UNIX_D64BE H5T_UNIX_D64LE EOPM ############################################################### # XS Code that implements self-contained turn-on/off for # the h5 library error reporting. We can turn error reporting # selectively on and off to keep the library from complaining # when we are doing things like checking to see if a particular # group name exists. pp_addhdr(<<'EOXS'); /* ############################################################### # # H5 Library error reporting turn-on/off functions # # */ herr_t H5errorOff() { return H5Eset_auto(NULL, NULL ); } herr_t H5errorOn() { return H5Eset_auto((herr_t(*)(void*))H5Eprint, stderr ); } /* ############################################################### # # Operator Interation Functions (Supplied to and called by 'H5Giterate') # used to get the number of datasets in a group, # and the names of the dataset in the group. # # */ /* * Operator function to get number of datasets */ herr_t incIfDset(hid_t loc_id, const char *name, void *opdata) { H5G_stat_t statbuf; unsigned int * dsetCount; dsetCount = (unsigned int *) opdata; /* * Get type of the object and increment *dsetCount * if it is a dataset * The name of the object is passed to this function by * the Library. Some magic :-) */ H5Gget_objinfo(loc_id, name, FALSE, &statbuf); if( statbuf.type == H5G_DATASET){ (*dsetCount)++; } return 0; } /* * Operator function to fill up char array of dataset names * * opdata is a pointer to an Array of strings (i.e. 2D char array) */ herr_t getName_if_Dset(hid_t loc_id, const char *name, void *opdata) { H5G_stat_t statbuf; char ** datasetName; char *** tempptr; tempptr = (char ***) opdata; datasetName = *tempptr; /* * Get type of the object. * If it is a dataset, get allocate space for it at *datasetName * Increment *tempptr so we will be looking at the next name space when * this function is called again. * * Note: The calling function must take care of freeing memory allocateed * */ H5Gget_objinfo(loc_id, name, FALSE, &statbuf); if( statbuf.type == H5G_DATASET){ *datasetName = (char *) malloc( (strlen(name)+1) * sizeof(char)); if( *datasetName == NULL){ printf("PDL::IO::HDF5; Out of Memory in getName_if_Dset\n"); exit(1); } strcpy(*datasetName,name); (*tempptr)++; } return 0; } /* * Operator function to get number of groups in a particular location */ herr_t incIfGroup(hid_t loc_id, const char *name, void *opdata) { H5G_stat_t statbuf; unsigned int * groupCount; groupCount = (unsigned int *) opdata; /* * Get type of the object and increment *groupCount * if it is a group * The name of the object is passed to this function by * the Library. Some magic :-) */ H5Gget_objinfo(loc_id, name, FALSE, &statbuf); if( statbuf.type == H5G_GROUP){ (*groupCount)++; } return 0; } /* * Operator function to fill up char array of group names * * opdata is a pointer to an Array of strings (i.e. 2D char array) */ herr_t getName_if_Group(hid_t loc_id, const char *name, void *opdata) { H5G_stat_t statbuf; char ** groupName; char *** tempptr; tempptr = (char ***) opdata; groupName = *tempptr; /* * Get type of the object. * If it is a group, get allocate space for it at *groupName * Increment *tempptr so we will be looking at the next name space when * this function is called again. * * Note: The calling function must take care of freeing memory allocateed * */ H5Gget_objinfo(loc_id, name, FALSE, &statbuf); if( statbuf.type == H5G_GROUP){ *groupName = (char *) malloc( (strlen(name)+1) * sizeof(char)); if( *groupName == NULL){ printf("PDL::IO::HDF5; Out of Memory in getName_if_Group\n"); exit(1); } strcpy(*groupName,name); (*tempptr)++; } return 0; } EOXS ############################################################### # XS Code that implements the HDF constants # Using the AUTOLOAD routine, any calls to hdf5 constants, like # H5F_ACC_RDONLY will call the 'constant' routine here and return # the value of the #defined'ed H5F_ACC_RDONLY pp_addhdr(<<'EOXS'); /* ############################################################### # # Functions to handle interfacing HDF5 constants with perl # # This originally generated using h2xs and manually editing # */ static int not_here(s) char *s; { croak("%s not implemented on this architecture", s); return -1; } double constant(name, arg) char *name; int arg; { errno = 0; switch (*name) { case 'A': break; case 'B': break; case 'C': break; case 'D': break; case 'E': break; case 'F': break; case 'G': break; case 'H': if (strEQ(name, "H5F_ACC_DEBUG")) #ifdef H5F_ACC_DEBUG return H5F_ACC_DEBUG; #else goto not_there; #endif if (strEQ(name, "H5F_ACC_EXCL")) #ifdef H5F_ACC_EXCL return H5F_ACC_EXCL; #else goto not_there; #endif if (strEQ(name, "H5F_ACC_RDONLY")) #ifdef H5F_ACC_RDONLY return H5F_ACC_RDONLY; #else goto not_there; #endif if (strEQ(name, "H5F_ACC_RDWR")) #ifdef H5F_ACC_RDWR return H5F_ACC_RDWR; #else goto not_there; #endif if (strEQ(name, "H5F_ACC_TRUNC")) #ifdef H5F_ACC_TRUNC return H5F_ACC_TRUNC; #else goto not_there; #endif if (strEQ(name, "H5P_DEFAULT")) #ifdef H5P_DEFAULT return H5P_DEFAULT; #else goto not_there; #endif if (strEQ(name, "H5S_ALL")) #ifdef H5S_ALL return H5S_ALL; #else goto not_there; #endif if (strEQ(name, "H5S_UNLIMITED")) #ifdef H5S_UNLIMITED return H5S_UNLIMITED; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_B16")) #ifdef H5T_ALPHA_B16 return H5T_ALPHA_B16; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_B32")) #ifdef H5T_ALPHA_B32 return H5T_ALPHA_B32; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_B64")) #ifdef H5T_ALPHA_B64 return H5T_ALPHA_B64; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_B8")) #ifdef H5T_ALPHA_B8 return H5T_ALPHA_B8; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_F32")) #ifdef H5T_ALPHA_F32 return H5T_ALPHA_F32; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_F64")) #ifdef H5T_ALPHA_F64 return H5T_ALPHA_F64; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_I16")) #ifdef H5T_ALPHA_I16 return H5T_ALPHA_I16; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_I32")) #ifdef H5T_ALPHA_I32 return H5T_ALPHA_I32; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_I64")) #ifdef H5T_ALPHA_I64 return H5T_ALPHA_I64; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_I8")) #ifdef H5T_ALPHA_I8 return H5T_ALPHA_I8; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_U16")) #ifdef H5T_ALPHA_U16 return H5T_ALPHA_U16; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_U32")) #ifdef H5T_ALPHA_U32 return H5T_ALPHA_U32; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_U64")) #ifdef H5T_ALPHA_U64 return H5T_ALPHA_U64; #else goto not_there; #endif if (strEQ(name, "H5T_ALPHA_U8")) #ifdef H5T_ALPHA_U8 return H5T_ALPHA_U8; #else goto not_there; #endif if (strEQ(name, "H5T_C_S1")) #ifdef H5T_C_S1 return H5T_C_S1; #else goto not_there; #endif if (strEQ(name, "H5T_FORTRAN_S1")) #ifdef H5T_FORTRAN_S1 return H5T_FORTRAN_S1; #else goto not_there; #endif if (strEQ(name, "H5T_IEEE_F32BE")) #ifdef H5T_IEEE_F32BE return H5T_IEEE_F32BE; #else goto not_there; #endif if (strEQ(name, "H5T_IEEE_F32LE")) #ifdef H5T_IEEE_F32LE return H5T_IEEE_F32LE; #else goto not_there; #endif if (strEQ(name, "H5T_IEEE_F64BE")) #ifdef H5T_IEEE_F64BE return H5T_IEEE_F64BE; #else goto not_there; #endif if (strEQ(name, "H5T_IEEE_F64LE")) #ifdef H5T_IEEE_F64LE return H5T_IEEE_F64LE; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_B16")) #ifdef H5T_INTEL_B16 return H5T_INTEL_B16; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_B32")) #ifdef H5T_INTEL_B32 return H5T_INTEL_B32; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_B64")) #ifdef H5T_INTEL_B64 return H5T_INTEL_B64; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_B8")) #ifdef H5T_INTEL_B8 return H5T_INTEL_B8; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_F32")) #ifdef H5T_INTEL_F32 return H5T_INTEL_F32; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_F64")) #ifdef H5T_INTEL_F64 return H5T_INTEL_F64; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_I16")) #ifdef H5T_INTEL_I16 return H5T_INTEL_I16; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_I32")) #ifdef H5T_INTEL_I32 return H5T_INTEL_I32; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_I64")) #ifdef H5T_INTEL_I64 return H5T_INTEL_I64; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_I8")) #ifdef H5T_INTEL_I8 return H5T_INTEL_I8; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_U16")) #ifdef H5T_INTEL_U16 return H5T_INTEL_U16; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_U32")) #ifdef H5T_INTEL_U32 return H5T_INTEL_U32; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_U64")) #ifdef H5T_INTEL_U64 return H5T_INTEL_U64; #else goto not_there; #endif if (strEQ(name, "H5T_INTEL_U8")) #ifdef H5T_INTEL_U8 return H5T_INTEL_U8; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_B16")) #ifdef H5T_MIPS_B16 return H5T_MIPS_B16; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_B32")) #ifdef H5T_MIPS_B32 return H5T_MIPS_B32; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_B64")) #ifdef H5T_MIPS_B64 return H5T_MIPS_B64; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_B8")) #ifdef H5T_MIPS_B8 return H5T_MIPS_B8; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_F32")) #ifdef H5T_MIPS_F32 return H5T_MIPS_F32; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_F64")) #ifdef H5T_MIPS_F64 return H5T_MIPS_F64; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_I16")) #ifdef H5T_MIPS_I16 return H5T_MIPS_I16; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_I32")) #ifdef H5T_MIPS_I32 return H5T_MIPS_I32; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_I64")) #ifdef H5T_MIPS_I64 return H5T_MIPS_I64; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_I8")) #ifdef H5T_MIPS_I8 return H5T_MIPS_I8; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_U16")) #ifdef H5T_MIPS_U16 return H5T_MIPS_U16; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_U32")) #ifdef H5T_MIPS_U32 return H5T_MIPS_U32; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_U64")) #ifdef H5T_MIPS_U64 return H5T_MIPS_U64; #else goto not_there; #endif if (strEQ(name, "H5T_MIPS_U8")) #ifdef H5T_MIPS_U8 return H5T_MIPS_U8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_B16")) #ifdef H5T_NATIVE_B16 return H5T_NATIVE_B16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_B32")) #ifdef H5T_NATIVE_B32 return H5T_NATIVE_B32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_B64")) #ifdef H5T_NATIVE_B64 return H5T_NATIVE_B64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_B8")) #ifdef H5T_NATIVE_B8 return H5T_NATIVE_B8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_CHAR")) #ifdef H5T_NATIVE_CHAR return H5T_NATIVE_CHAR; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_DOUBLE")) #ifdef H5T_NATIVE_DOUBLE return H5T_NATIVE_DOUBLE; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_FLOAT")) #ifdef H5T_NATIVE_FLOAT return H5T_NATIVE_FLOAT; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_HBOOL")) #ifdef H5T_NATIVE_HBOOL return H5T_NATIVE_HBOOL; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_HERR")) #ifdef H5T_NATIVE_HERR return H5T_NATIVE_HERR; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_HSIZE")) #ifdef H5T_NATIVE_HSIZE return H5T_NATIVE_HSIZE; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_HSSIZE")) #ifdef H5T_NATIVE_HSSIZE return H5T_NATIVE_HSSIZE; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT")) #ifdef H5T_NATIVE_INT return H5T_NATIVE_INT; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT16")) #ifdef H5T_NATIVE_INT16 return H5T_NATIVE_INT16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT32")) #ifdef H5T_NATIVE_INT32 return H5T_NATIVE_INT32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT64")) #ifdef H5T_NATIVE_INT64 return H5T_NATIVE_INT64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT8")) #ifdef H5T_NATIVE_INT8 return H5T_NATIVE_INT8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_FAST16")) #ifdef H5T_NATIVE_INT_FAST16 return H5T_NATIVE_INT_FAST16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_FAST32")) #ifdef H5T_NATIVE_INT_FAST32 return H5T_NATIVE_INT_FAST32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_FAST64")) #ifdef H5T_NATIVE_INT_FAST64 return H5T_NATIVE_INT_FAST64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_FAST8")) #ifdef H5T_NATIVE_INT_FAST8 return H5T_NATIVE_INT_FAST8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_LEAST16")) #ifdef H5T_NATIVE_INT_LEAST16 return H5T_NATIVE_INT_LEAST16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_LEAST32")) #ifdef H5T_NATIVE_INT_LEAST32 return H5T_NATIVE_INT_LEAST32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_LEAST64")) #ifdef H5T_NATIVE_INT_LEAST64 return H5T_NATIVE_INT_LEAST64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_INT_LEAST8")) #ifdef H5T_NATIVE_INT_LEAST8 return H5T_NATIVE_INT_LEAST8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_LDOUBLE")) #ifdef H5T_NATIVE_LDOUBLE return H5T_NATIVE_LDOUBLE; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_LLONG")) #ifdef H5T_NATIVE_LLONG return H5T_NATIVE_LLONG; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_LONG")) #ifdef H5T_NATIVE_LONG return H5T_NATIVE_LONG; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_OPAQUE")) #ifdef H5T_NATIVE_OPAQUE return H5T_NATIVE_OPAQUE; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_SCHAR")) #ifdef H5T_NATIVE_SCHAR return H5T_NATIVE_SCHAR; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_SHORT")) #ifdef H5T_NATIVE_SHORT return H5T_NATIVE_SHORT; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UCHAR")) #ifdef H5T_NATIVE_UCHAR return H5T_NATIVE_UCHAR; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT")) #ifdef H5T_NATIVE_UINT return H5T_NATIVE_UINT; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT16")) #ifdef H5T_NATIVE_UINT16 return H5T_NATIVE_UINT16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT32")) #ifdef H5T_NATIVE_UINT32 return H5T_NATIVE_UINT32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT64")) #ifdef H5T_NATIVE_UINT64 return H5T_NATIVE_UINT64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT8")) #ifdef H5T_NATIVE_UINT8 return H5T_NATIVE_UINT8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_FAST16")) #ifdef H5T_NATIVE_UINT_FAST16 return H5T_NATIVE_UINT_FAST16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_FAST32")) #ifdef H5T_NATIVE_UINT_FAST32 return H5T_NATIVE_UINT_FAST32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_FAST64")) #ifdef H5T_NATIVE_UINT_FAST64 return H5T_NATIVE_UINT_FAST64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_FAST8")) #ifdef H5T_NATIVE_UINT_FAST8 return H5T_NATIVE_UINT_FAST8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_LEAST16")) #ifdef H5T_NATIVE_UINT_LEAST16 return H5T_NATIVE_UINT_LEAST16; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_LEAST32")) #ifdef H5T_NATIVE_UINT_LEAST32 return H5T_NATIVE_UINT_LEAST32; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_LEAST64")) #ifdef H5T_NATIVE_UINT_LEAST64 return H5T_NATIVE_UINT_LEAST64; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_UINT_LEAST8")) #ifdef H5T_NATIVE_UINT_LEAST8 return H5T_NATIVE_UINT_LEAST8; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_ULLONG")) #ifdef H5T_NATIVE_ULLONG return H5T_NATIVE_ULLONG; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_ULONG")) #ifdef H5T_NATIVE_ULONG return H5T_NATIVE_ULONG; #else goto not_there; #endif if (strEQ(name, "H5T_NATIVE_USHORT")) #ifdef H5T_NATIVE_USHORT return H5T_NATIVE_USHORT; #else goto not_there; #endif if (strEQ(name, "H5T_STRING")) return H5T_STRING; /* This was manually enter to get the enumerated type */ if (strEQ(name, "H5T_STD_B16BE")) #ifdef H5T_STD_B16BE return H5T_STD_B16BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B16LE")) #ifdef H5T_STD_B16LE return H5T_STD_B16LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B32BE")) #ifdef H5T_STD_B32BE return H5T_STD_B32BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B32LE")) #ifdef H5T_STD_B32LE return H5T_STD_B32LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B64BE")) #ifdef H5T_STD_B64BE return H5T_STD_B64BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B64LE")) #ifdef H5T_STD_B64LE return H5T_STD_B64LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B8BE")) #ifdef H5T_STD_B8BE return H5T_STD_B8BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_B8LE")) #ifdef H5T_STD_B8LE return H5T_STD_B8LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I16BE")) #ifdef H5T_STD_I16BE return H5T_STD_I16BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I16LE")) #ifdef H5T_STD_I16LE return H5T_STD_I16LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I32BE")) #ifdef H5T_STD_I32BE return H5T_STD_I32BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I32LE")) #ifdef H5T_STD_I32LE return H5T_STD_I32LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I64BE")) #ifdef H5T_STD_I64BE return H5T_STD_I64BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I64LE")) #ifdef H5T_STD_I64LE return H5T_STD_I64LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I8BE")) #ifdef H5T_STD_I8BE return H5T_STD_I8BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_I8LE")) #ifdef H5T_STD_I8LE return H5T_STD_I8LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_REF_DSETREG")) #ifdef H5T_STD_REF_DSETREG return H5T_STD_REF_DSETREG; #else goto not_there; #endif if (strEQ(name, "H5T_STD_REF_OBJ")) #ifdef H5T_STD_REF_OBJ return H5T_STD_REF_OBJ; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U16BE")) #ifdef H5T_STD_U16BE return H5T_STD_U16BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U16LE")) #ifdef H5T_STD_U16LE return H5T_STD_U16LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U32BE")) #ifdef H5T_STD_U32BE return H5T_STD_U32BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U32LE")) #ifdef H5T_STD_U32LE return H5T_STD_U32LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U64BE")) #ifdef H5T_STD_U64BE return H5T_STD_U64BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U64LE")) #ifdef H5T_STD_U64LE return H5T_STD_U64LE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U8BE")) #ifdef H5T_STD_U8BE return H5T_STD_U8BE; #else goto not_there; #endif if (strEQ(name, "H5T_STD_U8LE")) #ifdef H5T_STD_U8LE return H5T_STD_U8LE; #else goto not_there; #endif if (strEQ(name, "H5T_UNIX_D32BE")) #ifdef H5T_UNIX_D32BE return H5T_UNIX_D32BE; #else goto not_there; #endif if (strEQ(name, "H5T_UNIX_D32LE")) #ifdef H5T_UNIX_D32LE return H5T_UNIX_D32LE; #else goto not_there; #endif if (strEQ(name, "H5T_UNIX_D64BE")) #ifdef H5T_UNIX_D64BE return H5T_UNIX_D64BE; #else goto not_there; #endif if (strEQ(name, "H5T_UNIX_D64LE")) #ifdef H5T_UNIX_D64LE return H5T_UNIX_D64LE; #else goto not_there; #endif break; case 'I': break; case 'J': break; case 'K': break; case 'L': break; case 'M': break; case 'N': break; case 'O': break; case 'P': break; case 'Q': break; case 'R': break; case 'S': break; case 'T': break; case 'U': break; case 'V': break; case 'W': break; case 'X': break; case 'Y': break; case 'Z': break; } errno = EINVAL; return 0; not_there: errno = ENOENT; return 0; } /* ############################################################# */ EOXS pp_addxs('',<<'EOXS'); double constant(name,arg) char * name int arg EOXS ############### Add Autoload Routine for the hdf5 constants ########## pp_addpm( {At => Top}, <<'EOPM'); use PDL::Lite; use PDL::Char; use PDL::IO::HDF5::Group; # Require needed here becuase dataset uses some of the XS # calls that are defined in PDL::IO::HDF5 (like PDL::IO::HDF5::H5T_NATIVE_CHAR() ) # Doing a 'use' would make use of the calls before they are defined. # require PDL::IO::HDF5::Dataset; use Carp; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. If a constant is not found then control is passed # to the AUTOLOAD in AutoLoader. my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; croak "& not defined" if $constname eq 'constant'; my $val = constant($constname, @_ ? $_[0] : 0); if ($! != 0) { if ($! =~ /Invalid/) { $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { croak "Your vendor has not defined hdf5 macro $constname"; } } *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } EOPM # Code that implements the dataset count and dataset name functions pp_addxs('',<<'EOXS'); # Code to get the number of datasets in a group int H5GgetDatasetCount( groupID, groupName ) hid_t groupID char * groupName CODE: int dsetCount = 0; H5Giterate(groupID, groupName, NULL, incIfDset, &dsetCount); RETVAL = dsetCount; OUTPUT: RETVAL # Code to get the names of the datasets in a group void H5GgetDatasetNames( groupID, groupName ) hid_t groupID char * groupName PREINIT: int dsetCount = 0; char ** datasetNames; /* Array of dataset names */ char ** datasetPtr; /* temp pointer to datasetNames */ int i; /* Index variable */ PPCODE: /* Get the number of datasets */ H5Giterate(groupID, groupName, NULL, incIfDset, &dsetCount); if( dsetCount > 0){ /* Datasets found */ /* Allocate Space for array of strings */ datasetNames = (char **) malloc( dsetCount * sizeof(char *)); if( datasetNames == NULL){ printf("PDL::IO::HDF5; out of Memory in H5GgetDatasetNames\n"); exit(1); } datasetPtr = datasetNames; H5Giterate(groupID, groupName, NULL, getName_if_Dset, &datasetPtr); EXTEND(SP, dsetCount); /* Make room for results on the return stack */ for( i = 0; i< dsetCount; i++){ /* Push Names onto return stack */ /* printf("Name found = '%s'\n",datasetNames[i]); */ PUSHs(sv_2mortal(newSVpv(datasetNames[i],0))); free(datasetNames[i]); /* Release Memory */ } free(datasetNames); } # Code to get the number of groups in a group/file int H5GgetGroupCount( groupID, groupName ) hid_t groupID char * groupName CODE: int groupCount = 0; H5Giterate(groupID, groupName, NULL, incIfGroup, &groupCount); RETVAL = groupCount; OUTPUT: RETVAL # Code to get the names of the groups in a group/file void H5GgetGroupNames( groupID, groupName ) hid_t groupID char * groupName PREINIT: int groupCount = 0; char ** groupNames; /* Array of group names */ char ** groupPtr; /* temp pointer to groupnames */ int i; /* Index variable */ PPCODE: /* Get the number of datasets */ H5Giterate(groupID, groupName, NULL, incIfGroup, &groupCount); if( groupCount > 0){ /* Groups found */ /* Allocate Space for array of strings */ groupNames = (char **) malloc( groupCount * sizeof(char *)); if( groupNames == NULL){ printf("PDL::IO::HDF5; out of Memory in H5GgetGroupNames\n"); exit(1); } groupPtr = groupNames; H5Giterate(groupID, groupName, NULL, getName_if_Group, &groupPtr); EXTEND(SP, groupCount); /* Make room for results on the return stack */ for( i = 0; i< groupCount; i++){ /* Push Names onto return stack */ /* printf("Name found = '%s'\n",datasetNames[i]); */ PUSHs(sv_2mortal(newSVpv(groupNames[i],0))); free(groupNames[i]); /* Release Memory */ } free(groupNames); } # Code to get the maximum length of strings in a ragged character array int findMaxVarLenSize( buf, numelem ) I8 * buf int numelem CODE: int i; int maxStrSize; int len; char** rdata; /* Convert input generic pointer to character array */ rdata = (char **) buf; /* Find max string length */ maxStrSize = 0; for(i=0; i maxStrSize ) maxStrSize = len; } } /* end for */ RETVAL = maxStrSize; OUTPUT: RETVAL # Function to copy the variable length strings from an input buffer varlenbuff to a supplied # fixed-length string buffer fixedbuf. # Number of elements (numelem) and maximum length of any variable length string (maxVarlensize) # must be supplied. # Output is the number of elements converted int copyVarLenToFixed( varlenbuff, fixedbuf, numelem, maxVarlensize ) I8 * varlenbuff I8 * fixedbuf int numelem int maxVarlensize CODE: int fixlenbufferInc; /* size of strings, including the null byte */ int i; char** rdata; char* tempPtr; fixlenbufferInc = maxVarlensize + 1; /* size of strings, including the null byte */ /* Convert input generic pointer to character array */ rdata = (char **) varlenbuff; tempPtr = (char*) fixedbuf; /* Copy variable length strings to fixed length strings */ for(i=0; inew; my $b = $mw->Balloon; my $h5 = new PDL::IO::HDF5($filename); # open HDF5 file object my $tkview = new PDL::IO::HDF5::tkview( $mw, $h5); my $tree = $tkview->{hl}; my $lastItem = ''; my $mouseItem; my ($pointerX,$pointerY); my @BBox = (0,0,0,0); $b->attach($tree, -balloonposition => 'mouse', -postcommand => sub { #print "Box for $item is ".join(", ",@BBox)."\n"; #print "Box for $mouseItem is ".join(", ",@BBox)."\n"; #print "y = $pointerY\n"; if( ($pointerY >= $BBox[1] ) && ($pointerY <= $BBox[3]) && # Popup balloon if withing bounding box $mouseItem =~ /$;_Dset(.+)$/ ){ # and a dataset item my $datasetName = $1; my $text = $tree->entrycget($mouseItem,'-text'); my $elements = 1; if( $text =~ /\: Dims (.+)$/ ){ my @dims = split(',',$1); my $message; foreach (@dims){ $elements *= $_; } } if( $elements > $maxElements){ $message = "$elements Elements: Too Big To Display"; } else{ my $group = $tree->entrycget($mouseItem,'-data'); my $PDL = $group->dataset($datasetName)->get; $message = "$PDL"; } $b->{"clients"}{$tree}{-balloonmsg} = $message; return 1; } 0; }, -motioncommand => sub { # my $e = $tree->XEvent; # print "xevent is a ".ref($e)."\n"; ($pointerX,$pointerY) = $tree->pointerxy; $pointerX -= $tree->rootx; $pointerY -= $tree->rooty; $mouseItem = $tree->nearest($pointerY); # print "MouseItem = '$mouseItem'\n"; my $infoBBox = $tree->infoBbox($mouseItem); # print "infoBBox = '$infoBBox'\n"; return 1 unless defined($infoBBox); if( ref($infoBBox)){ # Handle the different ways that # tk does the bounding box for 800.015 and 800.018, etc @BBox = @$infoBBox; } else{ @BBox = split(' ', $infoBBox); } # print "Bbox = ".join(", ",@BBox)."\n"; # print "lastItem = '$lastItem', mouseItem = '$mouseItem'\n"; if( ( $lastItem eq $mouseItem ) && ($pointerY >= $BBox[1] ) && ($pointerY <= $BBox[3]) ){ # Same item, and withing it's bounding box don't cancel the Balloon 0; } else{ # New item - cancel it so a new balloon will # be posted $lastItem = $mouseItem; 1; } } ); MainLoop; PDL-IO-HDF5-0.63/typemap0000644002141500001300000000262507263400054013753 0ustar cerneydbteam# Extra type mappings for PDL::NetCDF # basic C types I8 * T_PVI int * T_PVI size_t * T_PVI hid_t T_IV hid_t * T_PVI hsize_t * T_PVI hsize_t T_IV herr_t * T_PVI herr_t T_IV htri_t T_IV H5T_class_t T_IV PDLchar * T_PDL PDLuchar * T_PDL PDLshort * T_PDL PDLint * T_PDL PDLlong * T_PDL PDLfloat * T_PDL PDLdouble * T_PDL hbool_t T_IV ############################################################################# INPUT T_PVI $var = ($type)SvPV($arg,PL_na) T_PDLB $var = (unsigned char *)(PDL->SvPDLV($arg)->data) T_PDLS $var = (short *)(PDL->SvPDLV($arg)->data) T_PDLUS $var = (unsigned short *)(PDL->SvPDLV($arg)->data) T_PDLL $var = (long *)(PDL->SvPDLV($arg)->data) T_PDLF $var = (float *)(PDL->SvPDLV($arg)->data) T_PDLD $var = (double *)(PDL->SvPDLV($arg)->data) ############################################################################# OUTPUT # T_PVI typemap copies the data in $var to $arg, up to the # length of length($arg). This differs from the T_PV typemap # where the data is copied up to a Null char (string terminator) # T_PVI's will be used for getting raw data blocks out of the C-code T_PVI sv_setpvn((SV*)$arg, (char *) $var, SvCUR($arg)); T_PDLB PDL->SetSV_PDL($arg,$var); T_PDLS PDL->SetSV_PDL($arg,$var); T_PDLUS PDL->SetSV_PDL($arg,$var); T_PDLL PDL->SetSV_PDL($arg,$var); T_PDLF PDL->SetSV_PDL($arg,$var); T_PDLD PDL->SetSV_PDL($arg,$var); PDL-IO-HDF5-0.63/varlen.h50000744002141500001300000003000011512426452014065 0ustar cerneydbteam‰HDF  ÿÿÿÿÿÿÿÿ0ÿÿÿÿÿÿÿÿ €`HEAP€DatasetðTREEÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿà €`#*M xAttr1    SNODÐ\U(XGCOLXtesting whether that nation or any nation so conceived and so dedicated can long endure.(Now we are engaged in a great civil war,Uconceived in liberty and dedicated to the proposition that all men are created equal.\Four score and seven years ago our forefathers brought forth on this continent a new nation,xGCOL Attr String 4 Attr String 3 Attr String 2 Attr String 1pPDL-IO-HDF5-0.63/t/0000755002141500001300000000000011554061466012617 5ustar cerneydbteamPDL-IO-HDF5-0.63/t/attribPDL.t0000644002141500001300000000471311554061206014626 0ustar cerneydbteamuse PDL; use PDL::Char; use PDL::IO::HDF5; use PDL::Types; # Test case for HDF5 attributes that are pdls # This is a new feature as-of version 0.6 # print "1..9\n"; my $testNo = 1; my $filename = "newFile.hd5"; # get rid of filename if it already exists unlink $filename if( -e $filename); my $hdf5 = new PDL::IO::HDF5($filename); # Create pdls to store: my $pchar = PDL::Char->new( [['abc', 'def', 'ghi'],['jkl', 'mno', 'pqr']] ); my $bt=pdl([[1.2,1.3,1.4],[1.5,1.6,1.7],[1.8,1.9,2.0]]); my $group=$hdf5->group('Radiometric information'); # Store a dadtaset my $dataset=$group->dataset('SP_BT'); $dataset->set($bt); # Store a scalar and pdl attribute $dataset->attrSet('UNITS'=>'K'); $dataset->attrSet('NUM_COL'=>pdl(long,[[1,2,3],[4,5,6]])); $dataset->attrSet('NUM_ROW'=>$pchar); $dataset->attrSet('SCALING'=>'pepe'); $dataset->attrSet('OFFSET'=>pdl(double,[0.0074])); # Set group attribute $group->attrSet('GroupPDLAttr'=>pdl(long,[[1,2,3],[4,5,6]])); ######## Now Read HDF5 file ##### my $hdf2= new PDL::IO::HDF5($filename); my $group2=$hdf2->group('Radiometric information'); my $dataset2=$group2->dataset('SP_BT'); my $expected; $expected = ' [ [1.2 1.3 1.4] [1.5 1.6 1.7] [1.8 1.9 2] ] '; my $bt2=$dataset2->get(); #print "expoected = '$bt2'\n"; ok($testNo++, "$bt2" eq $expected); $expected = 'K'; my ($units)=$dataset2->attrGet('UNITS'); #print "units '$units'\n"; ok($testNo++, $units eq $expected); $expected = ' [ [1 2 3] [4 5 6] ] '; my ($numcol)=$dataset2->attrGet('NUM_COL'); #print "numcol '$numcol'\n"; ok($testNo++, "$numcol" eq $expected); ok($testNo++, (ref($numcol) && $numcol->isa('PDL')) ); $expected = "[ [ 'abc' 'def' 'ghi' ] [ 'jkl' 'mno' 'pqr' ] ] "; my ($numrow)=$dataset2->attrGet('NUM_ROW'); #print "numrow '$numrow'\n"; ok($testNo++, "$numrow" eq $expected); $expected = 'pepe'; my ($scaling)=$dataset2->attrGet('SCALING'); #print "scaling '$scaling\n"; ok($testNo++, $scaling eq $expected); $expected = '[0.0074]'; my ($offset)=$dataset2->attrGet('OFFSET'); #print "offset '$offset'\n"; ok($testNo++, "$offset" eq $expected); # Check Group PDL Attribute $expected = ' [ [1 2 3] [4 5 6] ] '; my ($numcol2)=$group2->attrGet('GroupPDLAttr'); #print "numcol '$numcol'\n"; ok($testNo++, "$numcol2" eq $expected); ok($testNo++, (ref($numcol2) && $numcol2->isa('PDL')) ); # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } PDL-IO-HDF5-0.63/t/file.t0000644002141500001300000000110407311233652013711 0ustar cerneydbteamuse PDL::IO::HDF5; print "1..3\n"; my $testNo = 1; # New File Check: my $filename = "newFile.hd5"; # get rid of filename if it already exists unlink $filename if( -e $filename); ok($testNo++,new PDL::IO::HDF5("newFile.hd5")); #Existing File for Writing Check ok($testNo++,new PDL::IO::HDF5(">newFile.hd5")); #Existing File for Reading Check ok($testNo++,new PDL::IO::HDF5("newFile.hd5")); # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } print "Completed\n"; PDL-IO-HDF5-0.63/t/group.t0000644002141500001300000000600407311233652014132 0ustar cerneydbteamuse PDL; use PDL::IO::HDF5; use PDL::IO::HDF5::Group; use PDL::IO::HDF5::Dataset; # Script to test the group/dataset object separately. # i.e. not the way they would normally be used as described # in the PDL::IO::HDF5 synopsis print "1..17\n"; my $testNo = 1; # New File Check: my $filename = "newFile.hd5"; # get rid of filename if it already exists unlink $filename if( -e $filename); my $hdfobj; ok($testNo++,$hdfobj = new PDL::IO::HDF5("newFile.hd5")); my $group = new PDL::IO::HDF5::Group( name => '/dude', parent => $hdfobj, fileObj => $hdfobj); # Set attribute for group ok($testNo++, $group->attrSet( 'attr1' => 'dudeman', 'attr2' => 'What??')); # Try Setting attr for an existing attr ok($testNo++,$group->attrSet( 'attr1' => 'dudeman23')); # Add a attribute and then delete it ok($testNo++, $group->attrSet( 'dummyAttr' => 'dummyman', 'dummyAttr2' => 'dummyman')); ok($testNo++, $group->attrDel( 'dummyAttr', 'dummyAttr2' )); # Get list of attributes my @attrs = $group->attrs; ok($testNo++, join(",",sort @attrs) eq 'attr1,attr2' ); # Get a list of attribute values my @attrValues = $group->attrGet(sort @attrs); ok($testNo++, join(",",@attrValues) eq 'dudeman23,What??' ); # print "Attr Values = '".join("', '",@attrValues)."'\n"; # Get a list of datasets (should be none) my @datasets = $group->datasets; ok($testNo++, scalar(@datasets) == 0 ); # Create another group my $group2 = new PDL::IO::HDF5::Group( 'name'=> '/dude2', parent => $hdfobj, fileObj => $hdfobj); # open the root group my $rootGroup = new PDL::IO::HDF5::Group( 'name'=> '/', parent => $hdfobj, fileObj => $hdfobj); # Get a list of groups my @groups = $rootGroup->groups; # print "Root group has these groups '".join(",",sort @groups)."'\n"; ok($testNo++, join(",",sort @groups) eq 'dude,dude2' ); # Get a list of groups in group2 (should be none) @groups = $group2->groups; ok($testNo++, scalar(@groups) == 0 ); # Create a dataset in the root group my $dataset = new PDL::IO::HDF5::Dataset( 'name'=> 'data1', parent => $rootGroup, fileObj => $hdfobj); my $pdl = sequence(5,4); ok($testNo++, $dataset->set($pdl) ); # print "pdl written = \n".$pdl."\n"; my $pdl2 = $dataset->get; # print "pdl read = \n".$pdl2."\n"; ok($testNo++, (($pdl - $pdl2)->sum) < .001 ); # Set attribute for dataset ok($testNo++, $dataset->attrSet( 'attr1' => 'dataset dudeman', 'attr2' => 'Huh What??')); # Try Setting attr for an existing attr ok($testNo++,$dataset->attrSet( 'attr1' => 'dataset dudeman23')); # Add a attribute and then delete it ok($testNo++, $dataset->attrSet( 'dummyAttr' => 'dummyman', 'dummyAttr2' => 'dummyman')); ok($testNo++, $dataset->attrDel( 'dummyAttr', 'dummyAttr2' )); # Get list of attributes @attrs = $dataset->attrs; ok($testNo++, join(",",sort @attrs) eq 'attr1,attr2' ); unlink("newfile.hd5"); print "completed\n"; # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } PDL-IO-HDF5-0.63/t/total.t0000755002141500001300000001227311143122553014124 0ustar cerneydbteamuse PDL; use PDL::Char; use PDL::IO::HDF5; use PDL::Types; # Script to test the PDL::IO::HDF5 objects together in the # way they would normally be used # # i.e. the way they would normally be used as described # in the PDL::IO::HDF5 synopsis print "1..33\n"; my $testNo = 1; # New File Check: my $filename = "newFile.hd5"; # get rid of filename if it already exists unlink $filename if( -e $filename); my $hdfobj; ok($testNo++,$hdfobj = new PDL::IO::HDF5("newFile.hd5")); # Set attribute for file (root group) ok($testNo++, $hdfobj->attrSet( 'attr1' => 'dudeman', 'attr2' => 'What??')); # Try Setting attr for an existing attr ok($testNo++,$hdfobj->attrSet( 'attr1' => 'dudeman23')); # Add a attribute and then delete it ok($testNo++, $hdfobj->attrSet( 'dummyAttr' => 'dummyman', 'dummyAttr2' => 'dummyman')); ok($testNo++, $hdfobj->attrDel( 'dummyAttr', 'dummyAttr2' )); # Get list of attributes my @attrs = $hdfobj->attrs; ok($testNo++, join(",",sort @attrs) eq 'attr1,attr2' ); # Get a list of attribute values my @attrValues = $hdfobj->attrGet(sort @attrs); ok($testNo++, join(",",@attrValues) eq 'dudeman23,What??' ); # print "Attr Values = '".join("', '",@attrValues)."'\n"; ############################################## # Create a dataset in the root group my $dataset = $hdfobj->dataset('rootdataset'); my $pdl = sequence(5,4); ok($testNo++, $dataset->set($pdl) ); # print "pdl written = \n".$pdl."\n"; # Create String dataset using PDL::Char my $dataset2 = $hdfobj->dataset('charData'); my $pdlChar = new PDL::Char( [ ["abccc", "def", "ghi"],["jkl", "mno", 'pqr'] ] ); ok($testNo++,$dataset2->set($pdlChar)); my $pdl2 = $dataset->get; # print "pdl read = \n".$pdl2."\n"; ok($testNo++, (($pdl - $pdl2)->sum) < .001 ); my @dims = $dataset->dims; ok( $testNo++, join(", ",@dims) eq '5, 4' ); # Get a list of datasets (should be two) my @datasets = $hdfobj->datasets; ok($testNo++, scalar(@datasets) == 2 ); ############################################# my $group = $hdfobj->group("mygroup"); my $subgroup = $group->group("subgroup"); ### Try a non-deault data-set type (float) #### # Create a dataset in the subgroup $dataset = $subgroup->dataset('my dataset'); $pdl = sequence(5,4)->float; # Try a non-default data type ok($testNo++, $dataset->set($pdl) ); # print "pdl written = \n".$pdl."\n"; $pdl2 = $dataset->get; # print "pdl read = \n".$pdl2."\n"; ok($testNo++, (($pdl - $pdl2)->sum) < .001 ); # Check for the PDL returned being a float ok($testNo++, ($pdl->get_datatype - $PDL_F) < .001 ); # Get a hyperslab $pdl = $dataset->get(pdl([0,0]), pdl([4,0])); # Get the first vector of the PDL # Check to see if the dims are as expected. my @pdlDims = $pdl->dims; ok( $testNo++, ($pdlDims[0] == 5) && ($pdlDims[1] == 1)); ### Try a non-deault data-set type (int/long) #### # Create a dataset in the subgroup $dataset = $subgroup->dataset('my dataset2'); $pdl = sequence(5,4)->long; # Try a non-default data type ok($testNo++, $dataset->set($pdl) ); # print "pdl written = \n".$pdl."\n"; $pdl2 = $dataset->get; # print "pdl read = \n".$pdl2."\n"; ok($testNo++, (($pdl - $pdl2)->sum) < .001 ); # Check for the PDL returned being a int/long ok($testNo++, ($pdl->get_datatype - $PDL_L) < .001 ); ################ Set Attributes at the Dataset Level ############### # Set attribute for group ok($testNo++, $dataset->attrSet( 'attr1' => 'DSdudeman', 'attr2' => 'DSWhat??')); # Try Setting attr for an existing attr ok($testNo++,$dataset->attrSet( 'attr1' => 'DSdudeman23')); # Add a attribute and then delete it ok($testNo++, $dataset->attrSet( 'dummyAttr' => 'dummyman', 'dummyAttr2' => 'dummyman')); ok($testNo++, $dataset->attrDel( 'dummyAttr', 'dummyAttr2' )); # Get list of attributes @attrs = $dataset->attrs; ok($testNo++, join(",",sort @attrs) eq 'attr1,attr2' ); # Get a list of attribute values @attrValues = $dataset->attrGet(sort @attrs); ok($testNo++, join(",",@attrValues) eq 'DSdudeman23,DSWhat??' ); ################ Set Attributes at the Group Level ############### # Set attribute for group ok($testNo++, $group->attrSet( 'attr1' => 'dudeman', 'attr2' => 'What??')); # Try Setting attr for an existing attr ok($testNo++,$group->attrSet( 'attr1' => 'dudeman23')); # Add a attribute and then delete it ok($testNo++, $group->attrSet( 'dummyAttr' => 'dummyman', 'dummyAttr2' => 'dummyman')); ok($testNo++, $group->attrDel( 'dummyAttr', 'dummyAttr2' )); # Get list of attributes @attrs = $group->attrs; ok($testNo++, join(",",sort @attrs) eq 'attr1,attr2' ); # Get a list of datasets (should be none) @datasets = $group->datasets; ok($testNo++, scalar(@datasets) == 0 ); # Create another group my $group2 = $hdfobj->group("dude2"); # Get a list of groups in the root group my @groups = $hdfobj->groups; # print "Root group has these groups '".join(",",sort @groups)."'\n"; ok($testNo++, join(",",sort @groups) eq 'dude2,mygroup' ); # Get a list of groups in group2 (should be none) @groups = $group2->groups; ok($testNo++, scalar(@groups) == 0 ); # unlink("newfile.hd5"); print "completed\n"; # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } PDL-IO-HDF5-0.63/t/vlenString.t0000744002141500001300000000211311512426456015133 0ustar cerneydbteam # Test case for reading variable-length string arrays. # These are converted to fixed-length PDL::Char types when read use PDL; use PDL::Char; use PDL::IO::HDF5; print "1..5\n"; my $testNo = 1; # New File Check: my $filename = "varlen.h5"; my $h5obj; ok($testNo++,$h5obj = new PDL::IO::HDF5($filename)); my $dataset = $h5obj->dataset("Dataset"); my $pdl = $dataset->get(); my @dims = $pdl->dims; #print "dims = ".join(", ", @dims)."\n"; ok( $testNo++, join(", ", @dims) eq "93, 4"); #print $pdl->atstr(2)."\n"; ok( $testNo++, $pdl->atstr(2) eq "Now we are engaged in a great civil war,"); # print "PDL::Char = $pdl\n"; ###### Now check variable-length string attribute array ### ($pdl) = $dataset->attrGet('Attr1'); @dims = $pdl->dims; #print "dims = ".join(", ", @dims)."\n"; ok( $testNo++, join(", ", @dims) eq "14, 4"); #print $pdl->atstr(2)."\n"; ok( $testNo++, $pdl->atstr(2) eq "Attr String 3"); exit; # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } PDL-IO-HDF5-0.63/t/ztotal_index.t0000755002141500001300000001051007615777016015520 0ustar cerneydbteamuse PDL; use PDL::Char; use PDL::IO::HDF5; use PDL::Types; # Script to test the attribute index functionality of the PDL::IO::HDF5 Class use Data::Dumper; print "1..7\n"; my $testNo = 1; # New File Check: my $filename = "newFile.hd5"; my $hdfobj; ok($testNo++,$hdfobj = new PDL::IO::HDF5("newFile.hd5")); # It is normally a no-no to call a internal method, but we # are just testing here: $hdfobj->_buildAttrIndex; my $result = recursiveDump($hdfobj->{attrIndex}); my $baseline = q!{ / => { attr1 => dudeman23, attr2 => What??, } /dude2 => { attr1 => dudeman23, attr2 => What??, } /mygroup => { attr1 => dudeman23, attr2 => What??, } /mygroup/subgroup => { attr1 => dudeman23, attr2 => What??, } } !; # print $result; ok($testNo++,$baseline eq $result ); # die; my @values = $hdfobj->allAttrValues('attr1'); $baseline = q![ dudeman23, dudeman23, dudeman23, dudeman23, ] !; #print recursiveDump(\@values); $result = recursiveDump(\@values); ok($testNo++,$baseline eq $result ); @values = $hdfobj->allAttrValues('attr1','attr2'); $baseline = q![ [ dudeman23, What??, ] [ dudeman23, What??, ] [ dudeman23, What??, ] [ dudeman23, What??, ] ] !; #print recursiveDump(\@values); $result = recursiveDump(\@values); ok($testNo++,$baseline eq $result ); my @names = $hdfobj->allAttrNames; $baseline = q![ attr1, attr2, ] !; #print recursiveDump(\@names); $result = recursiveDump(\@names); ok($testNo++,$baseline eq $result ); # Test building the groupIndex $hdfobj->_buildGroupIndex('attr1','attr2'); $hdfobj->_buildGroupIndex('attr2'); $hdfobj->_buildGroupIndex('attr1','attr3'); $baseline = "{ attr1$;attr2 => { dudeman23$;What?? => [ /, /dude2, /mygroup, /mygroup/subgroup, ] } attr1$;attr3 => { dudeman23$;_undef_ => [ /, /dude2, /mygroup, /mygroup/subgroup, ] } attr2 => { What?? => [ /, /dude2, /mygroup, /mygroup/subgroup, ] } } "; #print $baseline; #print recursiveDump($hdfobj->{groupIndex}); $result = recursiveDump($hdfobj->{groupIndex}); ok($testNo++,$baseline eq $result ); my @groups = $hdfobj->getGroupsByAttr( 'attr1' => 'dudeman23', 'attr2' => 'What??'); $baseline = q![ /, /dude2, /mygroup, /mygroup/subgroup, ] !; #print recursiveDump(\@groups); $result = recursiveDump(\@groups); ok($testNo++,$baseline eq $result ); print "completed\n"; # Testing utility functions: sub ok { my $no = shift ; my $result = shift ; print "not " unless $result ; print "ok $no\n" ; } # Dump of recursive array/hash. # We Could use Data:Dumper for this but it doesn't # order the keys, which causes problems # in regression testing on different platforsm sub recursiveDump{ my ($ref, $level) = @_; $level = 1 unless( defined($level)); my $returnString; # String to return my $levelspace = ' '; # Space used to indent my $indent = $levelspace x $level; my $unindent = $levelspace x ($level-1) ; my $displayedData = $ref; my $arrayFlag = 0; my @sortedKeys; if( ref $ref eq 'ARRAY'){ # arrays are converted to hashes with indexes numbers # as keys for display $displayedData = {}; @$displayedData{0..$#$ref} = @$ref; $returnString = $unindent."[\n"; $arrayFlag = 1; @sortedKeys = (0..$#$ref); } else{ $returnString = $unindent."{\n"; @sortedKeys = sort keys %$displayedData; } my $value; foreach my $key(@sortedKeys){ $value = $displayedData->{$key}; if( ref( $value) ){ $returnString .= $indent.$key." => " unless( $arrayFlag); # dumping hash Ref $returnString .= recursiveDump($value,$level+1); } else{ $returnString .= $indent.$value.",\n" if( $arrayFlag); # dumping array Ref $returnString .= $indent.$key.' => '.$value.",\n" unless( $arrayFlag); # dumping hash Ref } } $returnString .= $unindent."}\n" unless($arrayFlag); # Dumping hash ref $returnString .= $unindent."]\n" if($arrayFlag); # Dumping aray ref $returnString; } PDL-IO-HDF5-0.63/ChangeLog0000644002141500001300000002424211554061516014126 0ustar cerneydbteam2011-04-21 12:01 tag PDL_IO_HDF5_0_63 2011-04-21 12:01 cerney * README, hdf5.pd: Preparation for next release. 2011-04-21 11:59 cerney * HDF5/Group.pm, t/attribPDL.t: Fixed bug where PDL attributes didn't work for group-level attributes. 2011-01-22 09:25 tag PDL_IO_HDF5_0_62 2011-01-22 09:25 cerney * README, hdf5.pd: Preparation for next release 2011-01-21 18:31 A0182636 * Makefile.PL: Updates for compilation on win32 2011-01-21 18:24 A0182636 * hdf5.pd, HDF5/Dataset.pm: Fixed segfault problem when reading variable-length strings arrays with NULL entries. Added more types to the mapping arrays. 2011-01-10 10:23 tag PDL_IO_HDF5_0_61 2011-01-10 10:23 cerney * README, hdf5.pd: Preparation for next release. 2011-01-10 10:23 cerney * Makefile.PL: Updated to work with HDF5 1.8 (using 1.6 compatibility interface) 2011-01-09 15:48 a0182636 * varlen.h5, t/vlenString.t, HDF5/Dataset.pm: Updated to support variable-length string arrays for attribute arrays. 2011-01-09 09:49 a0182636 * hdf5.pd, varlen.h5, HDF5/Dataset.pm, HDF5/Group.pm, t/vlenString.t: Added capability to read variable-length string arrays into PDL::Char arrays. 2010-12-08 08:40 cerney * hdf5.pd: Updates to the VERSION makes it into the .pm file. 2010-04-27 20:31 tag PDL_IO_HDF5_0_6 2010-04-27 20:31 cerney * README, hdf5.pd: Preparation for release of 0.6 2010-04-27 20:29 cerney * Makefile.PL: Updated Makefile.PL for better compatibility with CPAN in its check for PDL installation and hdf5 libraries 2010-04-27 18:25 cerney * t/attribPDL.t: Test case for store/retreive attributes as PDLs. 2010-04-27 18:24 cerney * hdf5.pd, HDF5/Dataset.pm: Updated to include capability to store/retreive attributes as PDLs. Thanks to a patch from Xavier Calbet. 2009-02-06 15:02 cerney * HDF5/Dataset.pm, t/total.t: Updated so integer (PDL_Long) works with 64-bit machines. Previously 64 bit machines would crash retreiving 32-bit data, because it was mapped to NATIVE_LONG, which the h5 library thinks is 64bit for 64bit machines. 2007-03-12 07:56 cerney * HDF5/Dataset.pm, t/total.t: Updated the dataset hyperslab retreive interface to use the start/end coords instead of the start/lengh coord. (From Xavier Calbet's updated patch) 2007-03-07 07:54 cerney * hdf5.pd, HDF5/Dataset.pm, t/total.t: Added capability to get hyperslabs of the arrays stored in the file. (Thans to path from Xavier Calbet). 2007-01-29 07:05 A0182636 * hdf5.pd: Updated link to the hdf homepage. 2006-03-24 14:37 tag PDL_IO_HDF5_0_5 2006-03-24 14:37 cerney * COPYRIGHT, README, hdf5.pd: Preparation for next release. 2006-01-10 12:57 A0182636 * HDF5/Dataset.pm: Updated to preallocate the data for an array incrementally, rather than all at once. On win32 allocating all at once causes perl to hang when reading large arrays (> 50Meg) 2004-07-02 12:02 cerney * HDF5/Dataset.pm: Fixed bug where Dataset $self variables weren't declared lexical. This could cause the hdf5 objects to hang around longer than they should. 2003-06-19 14:05 tag PDL_IO_HDF5_0_3 2003-06-19 14:05 cerney * hdf5.pd: Preparation for next release. 2003-01-29 10:15 cerney * hdf5.pd, t/ztotal_index.t: Changed index text for attributes not defined from '' to '_undef_'. 2003-01-29 09:48 cerney * hdf5.pd, t/ztotal_index.t: Modified BuildGroupIndex to build the index for all groups, even if some of the groups don't have all the attributes defined. 2002-09-17 12:46 tag DL_IO_HDF5_0_2 2002-09-17 12:46 cerney * README, hdf5.pd: Preparation for next release. 2002-08-07 09:29 cerney * tkviewtest: Modified to not try to calc the number of elements for 0-d datasets 2002-08-07 09:25 cerney * HDF5/tkview.pm: Modified to properly display 0-dim datasets 2002-08-05 15:23 cerney * hdf5.pd: Fixed bug in calling of _buildGruopIndex. 2001-07-10 09:30 tag PDL_IO_HDF5_0_1 2001-07-10 09:30 cerney * COPYRIGHT: Added copyright file. 2001-06-11 16:27 cerney * Makefile.PL, README, hdf5.pd, tkviewtest, HDF5/Dataset.pm, HDF5/Group.pm, HDF5/tkview.pm, t/file.t, t/group.t, t/total.t, t/ztotal_index.t: Changed the name from PDL::HDF5 to PDL::IO::HDF5 to be consistent with other PDL IO interfaces. 2001-04-07 21:40 tag PDL-HDF5_0_1 2001-04-07 21:40 cerney * t/: total_index.t, ztotal_index.t: Renamed total_index.t to ztotal_index.t to ensure that this test is run after total.t creates the hdf5 file. 2001-04-07 21:25 cerney * hdf5.pd, tkviewtest, HDF5/Dataset.pm, HDF5/Group.pm, HDF5/tkview.pm, t/group.t, t/total_index.t: Fixed to work with perl 5.6. Fixed problem with objects getting destroyed before they should. Made member data between the helper objects more consistent 2001-04-06 22:35 cerney * HDF5/: Dataset.pm, Group.pm: Fixed calling of close functions in the object DESTROYS. This creates problems elsewhere, not fixed yet. 2001-04-06 16:30 cerney * hdf5.pd, t/total_index.t: Modified syntax to work with perl 5.6 2001-04-06 16:29 cerney * Makefile.PL: Added -lm to libs (Seems to be needed sometimes) 2001-04-06 12:43 cerney * typemap: Modified to compile with perl5.6 2000-06-08 15:13 cerney * hdf5.pd: Updated the allAttrValues method to only get attr values in groups that have all the requested attributes. (used to be any instead of all) 2000-06-05 07:42 cerney * hdf5.pd, t/total_index.t: Added getGroupsByAttr method. 2000-06-04 10:18 cerney * hdf5.pd, t/total_index.t: Added groupIndex data member and method. 2000-06-02 16:20 cerney * hdf5.pd, t/total_index.t: Added allAttrNames method 2000-06-02 16:07 cerney * hdf5.pd, HDF5/Dataset.pm, HDF5/Group.pm, t/group.t, t/total_index.t: Updated to clear the attrIndex data member when changes are made to the file. 2000-06-02 15:31 cerney * hdf5.pd: POD doco fix 2000-06-02 15:26 cerney * hdf5.pd, t/total_index.t: Added allAttrValues method 2000-06-02 15:05 cerney * hdf5.pd, HDF5/Group.pm, t/total_index.t: Changed the way groups are indexed by their attributes so that attributes at top level apply to lower-level groups. This is consistent with the hierarchy of HDF5 files. 2000-06-02 11:10 cerney * hdf5.pd, HDF5/Group.pm, t/total_index.t: Added attribute index method. 2000-06-02 09:13 cerney * t/total.t: Updated comments 2000-04-22 22:09 cerney * hdf5.pd, HDF5/Dataset.pm, t/total.t: - Modified to properly return the type that is stored in the file. (i.e. a 32-bit IEEE in the file should be returne as a PDL float, etc). - Added test case for proper type being returned. 2000-04-21 21:15 cerney * tkviewtest: Updated to work with Tk800.018 on linux 2000-04-19 07:00 cerney * README, hdf5.pd: Added readme, updated version. 2000-04-18 16:27 cerney * HDF5/tkview.pm: Modified tkview.pm to include action to perform (configurable) if dataset is double-clicked. 2000-04-13 10:00 cerney * tkviewtest: Added Balloon popups 2000-04-13 08:22 cerney * hdf5.pd: Added some 'use's so that the package would work stand-alone. 2000-04-09 20:34 cerney * HDF5/: Dataset.pm, Group.pm: Modified to create length 1 strings storage for 0-length attributes. 2000-04-04 10:45 cerney * hdf5.pd, typemap, HDF5/Dataset.pm: Added support for PDL::Char objects in Dataset::get. 2000-04-04 09:36 cerney * HDF5/Dataset.pm, t/total.t: Added support for PDL::Char objects in Dataset::set. 2000-04-02 21:24 cerney * HDF5/tkview.pm: Changed order of viewing. 2000-04-01 21:55 cerney * tkviewtest, HDF5/tkview.pm: Added experimental HDF5 file viewer using Tk. 2000-04-01 11:33 cerney * HDF5/Dataset.pm, t/total.t: Added attrGet method to dataset object. 2000-04-01 11:01 cerney * t/total.t: Fixed typo 2000-04-01 11:00 cerney * Makefile.PL, hdf5.pd, typemap, HDF5/Dataset.pm, HDF5/Group.pm, t/group.t, t/total.t: Added attrGet method to File and group objects. (Still need to add to dataset) 2000-03-31 14:09 cerney * hdf5.pd, HDF5/Dataset.pm, t/total.t: Added dims method to dataset 2000-03-24 15:19 cerney * hdf5.pd, HDF5/Dataset.pm, HDF5/Group.pm, t/group.t, t/total.t: Finished adding top-level functionality 2000-03-24 13:44 cerney * hdf5.pd, HDF5/Group.pm, t/group.t, t/total.t: Modified group object: Changed fileID/filename to parentID/parentName 2000-03-23 13:52 cerney * hdf5.pd, t/total.t: Added top-level attribute and group functions. 2000-03-23 08:58 cerney * hdf5.pd: Baseline before changing to structure where group and dataset inherits from file. 2000-03-22 07:39 cerney * hdf5.pd, HDF5/Dataset.pm, t/group.t: Cleaned-up Attr methods for Datasets 2000-03-21 07:53 cerney * hdf5.pd, HDF5/Dataset.pm, t/group.t: Added Dataset->get method 2000-03-21 07:52 cerney * typemap: Modified the PVI typemap to deal with output of pointers to data-structures. Previously was treating like character strings, and data was getting cut-off at zeros (char null-termination bytes) Added I8 type. Used in most cases where HDF5 using void * for I/O data. 2000-03-19 20:38 cerney * hdf5.pd: Doco fixes 2000-03-17 13:52 cerney * hdf5.pd, HDF5/Dataset.pm, t/group.t: Got the dataset set method to work correctly. 2000-03-16 16:10 cerney * hdf5.pd: Added packlist utility function 2000-03-16 16:09 cerney * Makefile.PL, hdf5.pd, HDF5/Dataset.pm, t/group.t: Intermediate Checkin while creating dataset helper object 2000-03-16 12:33 cerney * hdf5.pd, HDF5/Group.pm, t/group.t: Added groups method to the group object 2000-03-16 09:47 cerney * hdf5.pd, HDF5/Group.pm, t/group.t: Added datasets method to Groups object. 2000-03-14 14:12 cerney * hdf5.pd, HDF5/Group.pm, t/group.t: Added attrs method to group object. 2000-03-13 08:27 cerney * HDF5.pd: Removed HDF5.pd; Never should have been configure. (hdf5.pd is the correct file.) 2000-03-12 17:59 cerney * hdf5.pd, HDF5/Group.pm, t/group.t: Added group::attrDel method 2000-03-12 17:31 cerney * hdf5.pd, HDF5/Group.pm, t/group.t: Added group::attrset 2000-03-12 11:18 cerney * Makefile.PL, hdf5.pd, typemap, HDF5/Group.pm, t/group.t: Added basic group functionality 2000-03-10 16:13 cerney * HDF5.pd, Makefile.PL, hdf5.pd, typemap, t/file.t: Create Initial main PDL::HDF5 object. 2000-03-10 13:03 cerney * hdf5.pd: Initial Checkin 2000-03-10 13:00 cerney * Makefile.PL: Initial Checkin