use Config;
our $VERSION = 0.63;
pp_setversion(0.63);
# Necessary includes for .xs file
pp_addhdr(<<'EOH');
#include <hdf5.h>
#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 L<PDL>s 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<allAttrValues>, L<allAttrNames>, L<getGroupByAttr> 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<getGroupByAttr> 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<Usage:>
=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<Example:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<attrIndex> index is no longer valid.
B<Usage:>
=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<Usage:>
=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<groupIndex> index is no longer valid.
B<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<Usage:>
=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<numelem; i++) {
if( rdata[i] ){ /* Ignore null entries */
/* printf("String %d = '%s'\n", i, rdata[i]); */
len = strlen(rdata[i]);
if( len > 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; i<numelem; i++, tempPtr += fixlenbufferInc ) {
if( rdata[i] ){ /* Only copy non-null strings */
strncpy(tempPtr, rdata[i], fixlenbufferInc);
}
else{ /* Null Strings: Copy as zero length */
strncpy(tempPtr, "", fixlenbufferInc);
}
}
RETVAL = numelem;
OUTPUT:
RETVAL
# Code size of a pointer for the current platform
# This should return 4 on 32bit machines and 8 on 64bit machines
int
bufPtrSize()
CODE:
RETVAL = sizeof(void *);
OUTPUT:
RETVAL
# Sub to add the H5T_VARIABLE constant
# This is added manually here, rather than regenerate the constant function above
int
H5T_VARIABLE()
CODE:
RETVAL = H5T_VARIABLE;
OUTPUT:
RETVAL
EOXS
# Don't import anything from core but barf
# (Don't wan't to pollute our namespace)
pp_core_importList(' qw/ barf/');
# set to not export anything. (This is a OO package, it doesn't need to export any methods.)
pp_export_nothing;
pp_done();