diff --git a/Changes b/Changes index 215baa851..a8946f6d8 100644 --- a/Changes +++ b/Changes @@ -20,6 +20,7 @@ - fixed overly-rigid parsing of ASCII STL files (#504) - thanks Shugo for report - split PDL::Complex out to separate distro - move combcoords attract repulse from Graphics::TriD::Rout to ImageND +- split PDL::IO::HDF out to separate distro 2.095 2024-11-03 - add PDL_GENTYPE_IS_{REAL,FLOATREAL,COMPLEX,SIGNED,UNSIGNED}_##ppsym (#502) diff --git a/IO/HDF/Changes b/IO/HDF/Changes deleted file mode 100644 index 2ac151fcb..000000000 --- a/IO/HDF/Changes +++ /dev/null @@ -1,76 +0,0 @@ -Revision history for Perl extension PDL::HDF -0.01 13/02/01 - - original version - -2.0 27 March 2006 (Judd Taylor, judd@marine.usf.edu) - - - New version I've taken over from the previous authors. - - - There has been several minor fixes to the old version that I have fixed over the years, - and I can't remember them all to document here. Any new functionality has been documented, - however. - - - "Chunking" functionality added. This is an internal tiling and compression on the SD - datasets done by the HDF library. This is on by default, and can be - inquired/changed through ->Chunking() member function (pass it 0 for off, true for on). - The actual chunking section automatically determines a tile size for the dataset, but - this may not be optimal for some datasets. Down the road I'll provide better control of - this feature. - - - I've defuncted several functions that had strange (perhaps French) spellings. The originals - are still there for the time being, but a future version will come with warnings, and - finally be removed from the library even further out. - - SDgetvariablename -> SDgetvariablenames - SDgetattribut -> SDgetattribute - SDgetattributname -> SDgetattributenames - SDgetdimsizeunlimit -> SDgetunlimiteddimsize - SDgetdimname -> SDgetdimnames - Vgetchilds -> Vgetchildren - VSgetfieldsnames -> VSgetfieldnames - - - Umm... I don't like fortran array dim order, so I use C order. This may be a concern for - you, but I can't verify the problem for everyone since all of my code works fine. - I generally save things as X, Y, Z in my code (think an image, for instance), and then - when I open the HDF with image viewers, everything is fine. That's not how HDF saves - the data, however, so there's a dim reverse in the code for SDget and SDput, but that - should (theoretically) be transparent to you. NOTE: there is no reformatting of memory - necessary (it's time consuming, and has been avoided), since the C style dim order - is how a linear array maps into memory anyways (that's the main reason I like C style - over fortran). - If this causes _huge_ problems for you, then maybe I can make the ordering optional and - you can have it your backwards way if you want :) - - - I migrated all of the failure codes to return 'undef' instead of the mix they were returning - before. This should allow old code to be left alone. - - - I migrated all of the perl hashes to anonymous hashes. - - - I removed and internally doc'd several places where buffer overflows are possible, and did - my best shot at making the buffer overflows impossible, using the new constants below. - NOTE: this is not total elimination of the problem! Look for that in a later version with - updates perlXS code on those function to use the C constants. - The constants used in the code are cool with the HDF4.2r1 version, assuming you didn't - change anything before you compiled the HDF library. The HDF people could theoretically - change those values at a later point, so they should be read directly from the HDF system - headers, rather than hard coded in this module. - - - I moved the constants over to 'use constant', so instead of using '$PDL::IO::HDF:DFACC_CREATE', - you now would use : 'PDL::IO::HDF->DFACC_CREATE'. This is how constants work in Perl, so get - over it and fix your old code that uses things the old way. - - - I added a couple of constants (all only usefull for allocating memory internally): - MAX_NC_NAME => HDF's constant to hold the max name length for an attr/sds/dim - MAX_VAR_DIMS => HDF's constant to hold the max number of dims for a HDF variable - VNAMELENMAX => HDF's constant for the max length of VS interface names - FAIL => HDF's constant failure return code - - - I moved all of the tests over to 'use Test', for easier clarity and to get them working again. I - also modified the tests to clean up their test files when they are no longer needed (some tests - use outputs from earlier tests). - - - I added tests for the SDS chunking features. - - - - \ No newline at end of file diff --git a/IO/HDF/HDF.pm b/IO/HDF/HDF.pm deleted file mode 100644 index e235fc783..000000000 --- a/IO/HDF/HDF.pm +++ /dev/null @@ -1,290 +0,0 @@ -package PDL::IO::HDF; - -=head1 NAME - -PDL::IO::HDF - A PDL interface to the HDF4 library. - -=head1 SYNOPSIS - - use PDL; - use PDL::IO::HDF; - - # Open file 'foo.hdf' with all hdf interface: - my $HDF = PDL::IO::HDF->new("foo.hdf"); - - # You can call functions from either the SD or VS interfaces: - $HDF->{SD}->SDget("Foo_data"); - $HDF->{VS}->VSgetnames(); - - # To close the file: - $HDF->close(); - -=head1 DESCRIPTION - -This library provides functions to manipulate HDF files with the -SD, VS, and V HDF interfaces. - -For more information on HDF, see http://hdf.ncsa.uiuc.edu/ - -The 'new' function of this package uses the 'new' functions for the -individual HDF interfaces. This allows you to use all of the interfaces -at one time (if you don't mind the extended syntax). - -Actually using the HDF files comes down to using one of the particular -interfaces, for that see the docs on those modules. - -=cut - -use strict; -use warnings; -our $VERSION = '2.0'; -$VERSION = eval $VERSION; - -use PDL::Primitive; -use PDL::Basic; - -use PDL::IO::HDF::SD; -use PDL::IO::HDF::VS; - -=head1 CONSTANTS - -These constants are now implemented using the perl 'use constant' pragma. - -Previously, they were just scalars that were changeable (which is a no-no). - -See constant(1) for more info on how to use these in your code. - -=head2 Access Modes - -=over 8 - -=item DFACC_READ - -Open the file in read-only mode. - -=item DFACC_WRITE - -Open the file in write-only mode. - -=item DFACC_CREATE - -Clobber the file (create it if it doesn't exist, and then open with RW mode). - -=item DFACC_ALL - -Open the file in read-write mode. - -=item DFACC_RDONLY - -Same as DFACC_READ - -=item DFACC_RDWR - -Open the file in read-write mode. - -=back - -=cut - -# Access modes: -use constant { - DFACC_READ => 1, - DFACC_WRITE => 2, - DFACC_CREATE => 4, - DFACC_ALL => 7, - DFACC_RDONLY => 1, - DFACC_RDWR => 3, -}; - -=head2 VS Interface Interlacing Modes - -=over 8 - -=item FULL_INTERLACE - -=item NO_INTERLACE - -=back - -=cut -# VS interlace modes: -use constant { - FULL_INTERLACE => 0, - NO_INTERLACE => 1, -}; - -=head2 HDF4 Data Type Codes: - -=over 8 - -=item DFNT_UCHAR - -HDF's unsigned char ~= PDL's byte - -=item DFNT_CHAR - -HDF's char ~= PDL's byte - -=item DFNT_FLOAT32 - -HDF's 32-bit float ~= PDL's float - -=item DFNT_FLOAT64 - -HDF's 64-bit float ~= PDL's double - -=item DFNT_INT8 - -HDF's 8-bit integer ~= PDL's byte - -=item DFNT_UINT8 - -HDF's 8-bit unsigned integer ~= PDL's byte - -=item DFNT_INT16 - -HDF's 16-bit integer ~= PDL's short - -=item DFNT_UINT16 - -HDF's 16-bit unsigned integer ~= PDL's ushort - -=item DFNT_INT32 - -HDF's 32-bit integer ~= PDL's long - -=item DFNT_INT64 - -HDF's 32-bit integer ~= PDL's long - -=back - -=cut -# HDF Data type numbers: -use constant { - DFNT_UCHAR => 3, - DFNT_CHAR => 4, - DFNT_FLOAT32 => 5, - DFNT_FLOAT64 => 6, - DFNT_INT8 => 20, - DFNT_UINT8 => 21, - DFNT_INT16 => 22, - DFNT_UINT16 => 23, - DFNT_INT32 => 24, - DFNT_INT64 => 25, -}; - -=head2 Misc. HDF Library Constants: - -=over 8 - -=item MAX_NC_NAME - -This is the max name length for SDS variables, attribtues, and just about anything else. - -=item MAX_VAR_DIMS - -This is the max number of dims a HDF variable can have. - -=back - -=cut - -# These are current with HDF4.2r1: -# - -# Maximum Attr/SDS/VS name length: -use constant MAX_NC_NAME => 256; - -# Maximum variable dims (use for alloc'ing mem for the low level calls that return dims: -use constant MAX_VAR_DIMS => 32; - -use constant FAIL => -1; - -# Declaration of the different 'typemap' globals - -# NOTE: Since the keys & values below are constants, we need the () around them: - -#typemap pour convertir typePDL->typeHDF -our $SDtypeTMAP = { - PDL::byte->[0] => (DFNT_UINT8), - PDL::short->[0] => (DFNT_INT16), - PDL::ushort->[0] => (DFNT_UINT16), - PDL::long->[0] => (DFNT_INT32), - PDL::float->[0] => (DFNT_FLOAT32), - PDL::double->[0] => (DFNT_FLOAT64), - #PDL::byte->[0] => $DFNT_UCHAR ###attention PDL::byte 2x -}; - -#typemap pour convertir typeHDF->typePDL -our $SDinvtypeTMAP = { - (DFNT_INT8) => sub { PDL::byte(@_); }, #badtype - (DFNT_UINT8) => sub { PDL::byte(@_); }, - (DFNT_INT16) => sub { PDL::short(@_); }, - (DFNT_UINT16) => sub { PDL::ushort(@_); }, - (DFNT_INT32) => sub { PDL::long(@_); }, - (DFNT_INT64) => sub { PDL::long(@_); }, #badtype - (DFNT_FLOAT32) => sub { PDL::float(@_); }, - (DFNT_FLOAT64) => sub { PDL::double(@_); }, - (DFNT_UCHAR) => sub { PDL::byte(@_); }, - (DFNT_CHAR) => sub { PDL::byte(@_); } #badtype -}; - -our $SDinvtypeTMAP2 = { - (DFNT_INT8) => PDL::byte, - (DFNT_UINT8) => PDL::byte, - (DFNT_INT16) => PDL::short, - (DFNT_UINT16) => PDL::ushort, - (DFNT_INT32) => PDL::long, - (DFNT_INT64) => PDL::long, - (DFNT_FLOAT32) => PDL::float, - (DFNT_FLOAT64) => PDL::double, - (DFNT_UCHAR) => PDL::byte, - (DFNT_CHAR) => PDL::byte, -}; - -sub new -{ - my $type = shift; - my $file = shift; - - my $obj = {}; - - $obj->{SD} = PDL::IO::HDF::SD->new( $file ); - $obj->{VS} = PDL::IO::HDF::VS->new( $file ); - - bless $obj, $type; -} # End of new()... - -sub close -{ - my $self = shift; - $self->{SD}->close; - $self->{VS}->close; -} # End of close()... - - -sub DESTROY -{ - my $self = shift; - $self->close; -} # End of DESTROY()... - - -=head1 CURRENT AUTHOR & MAINTAINER - -Judd Taylor, Orbital Systems, Ltd. -judd dot t at orbitalsystems dot com - -=head1 PREVIOUS AUTHORS - -Patrick Leilde patrick.leilde@ifremer.fr -contribs of Olivier Archer olivier.archer@ifremer.fr - -=head1 SEE ALSO - -perl(1), PDL(1), PDL::IO::HDF::SD(1), PDL::IO::HDF::VS(1), constant(1). - -=cut - - diff --git a/IO/HDF/Makefile.PL b/IO/HDF/Makefile.PL deleted file mode 100644 index fc77aa88b..000000000 --- a/IO/HDF/Makefile.PL +++ /dev/null @@ -1,24 +0,0 @@ -use strict; -use warnings; -use ExtUtils::MakeMaker; - -# Make sure everything we wanted is found: -if (!eval { require ExtUtils::Depends; ExtUtils::Depends->new(qw(PDL::IO::HDF Alien::HDF4)) }) { - my $msg = "Error loading Alien::HDF4: '$@'\n"; - $msg .= "Skipping build of PDL::IO::HDF.\n"; - write_dummy_make( $msg ); - return; -} - -WriteMakefile( - NAME => 'PDL::IO::HDF', - VERSION_FROM => 'HDF.pm', - PM => { - 'HDF.pm' => '$(INST_LIBDIR)/HDF.pm', - }, - dist => { - COMPRESS => 'gzip', - SUFFIX => 'gz', - }, - NO_MYMETA => 1, -); diff --git a/IO/HDF/SD/.gitignore b/IO/HDF/SD/.gitignore deleted file mode 100644 index 09dbed78e..000000000 --- a/IO/HDF/SD/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -SD.c -SD.pm -SD.xs diff --git a/IO/HDF/SD/Changes b/IO/HDF/SD/Changes deleted file mode 100644 index 4e8b2e0b0..000000000 --- a/IO/HDF/SD/Changes +++ /dev/null @@ -1,3 +0,0 @@ -Revision history for Perl extension PDL::HDF -0.01 13/02/01 - - original version diff --git a/IO/HDF/SD/Makefile.PL b/IO/HDF/SD/Makefile.PL deleted file mode 100644 index dbcc34916..000000000 --- a/IO/HDF/SD/Makefile.PL +++ /dev/null @@ -1,29 +0,0 @@ -use strict; -use warnings; -use ExtUtils::MakeMaker; -use Config; - -my $package = [ qw(SD.pd SD PDL::IO::HDF::SD) ]; -my $pkg = ExtUtils::Depends->new(qw(PDL::IO::HDF::SD Alien::HDF4)); -$pkg->set_inc(&PDL_INCLUDE()); -$pkg->add_typemaps(&PDL_TYPEMAP()); -$pkg->add_pm( - 'SD.pm' => '$(INST_LIBDIR)/SD.pm', -); - -undef &MY::postamble; # suppress warning -*MY::postamble = sub { pdlpp_postamble_int($package); }; - -WriteMakefile( - NAME => 'PDL::IO::HDF::SD', - OBJECT => 'SD$(OBJ_EXT) ', - $pkg->get_makefile_vars, - clean => { - FILES => 'SD.pm SD.xs SD$(OBJ_EXT) SD.c', - }, - dist => { - COMPRESS => 'gzip', - SUFFIX => 'gz' - }, - NO_MYMETA => 1, -); diff --git a/IO/HDF/SD/SD.pd b/IO/HDF/SD/SD.pd deleted file mode 100644 index 0366d5254..000000000 --- a/IO/HDF/SD/SD.pd +++ /dev/null @@ -1,1624 +0,0 @@ -use strict; -use warnings; -pp_addpm({At => 'Top'}, <<'EOD'); - -=head1 NAME - -PDL::IO::HDF::SD - PDL interface to the HDF4 SD library. - -=head1 SYNOPSIS - - use PDL; - use PDL::IO::HDF::SD; - - # - # Creating and writing an HDF file - # - - # Create an HDF file: - my $hdf = PDL::IO::HDF::SD->new("-test.hdf"); - - # Define some data - my $data = sequence(short, 500, 5); - - # Put data in file as 'myData' dataset with the names - # of dimensions ('dim1' and 'dim2') - $hdf->SDput("myData", $data , ['dim1','dim2']); - - # Put some local attributes in 'myData' - # - # Set the fill value to 0 - my $res = $hdf->SDsetfillvalue("myData", 0); - # Set the valid range from 0 to 2000 - $res = $hdf->SDsetrange("myData", [0, 2000]); - # Set the default calibration for 'myData' (scale factor = 1, other = 0) - $res = $hdf->SDsetcal("myData"); - - # Set a global text attribute - $res = $hdf->SDsettextattr('This is a global text test!!', "myGText" ); - # Set a local text attribute for 'myData' - $res = $hdf->SDsettextattr('This is a local text testl!!', "myLText", "myData" ); - - # Set a global value attribute (you can put all values you want) - $res = $hdf->SDsetvalueattr( PDL::short( 20 ), "myGValue"); - - # Set a local value attribute (you can put all values you want) - $res = $hdf->SDsetvalueattr( PDL::long( [20, 15, 36] ), "myLValues", "myData" ); - - # Close the file - $hdf->close(); - - # - # Reading from an HDF file: - # - - # Open an HDF file in read only mode: - my $hdf = PDL::IO::HDF::SD->new("test.hdf"); - - # Get a list of all datasets: - my @dataset_list = $hdf->SDgetvariablename(); - - # Get a list of the names of all global attributes: - my @globattr_list = $hdf->SDgetattributenames(); - - # Get a list of the names of all local attributes for a dataset: - my @locattr_list = $hdf->SDgetattributenames("myData"); - - # Get the value of local attribute for a dataset: - my $value = $hdf->SDgetattribut("myLText","myData"); - - # Get a PDL var of the entire dataset 'myData': - my $data = $hdf->SDget("myData"); - - # Apply the scale factor of 'myData' - $data *= $hdf->SDgetscalefactor("myData"); - - # Get the fill value and fill the PDL var in with BAD: - $data->inplace->setvaltobad( $hdf->SDgetfillvalue("myData") ); - - # Get the valid range of a dataset: - my @range = $hdf->SDgetrange("myData"); - - #Now you can do what you want with your data - $hdf->close(); - - -=head1 DESCRIPTION - -This library provides functions to read, write, and manipulate -HDF4 files with HDF's SD interface. - -For more information on HDF4, see http://hdf.ncsa.uiuc.edu/ - -There have been a lot of changes starting with version 2.0, and these may affect -your code. PLEASE see the 'Changes' file for a detailed description of what -has been changed. If your code used to work with the circa 2002 version of this -module, and does not work anymore, reading the 'Changes' is your best bet. - -In the documentation, the terms dataset and SDS (Scientific Data Set) are used -interchangeably. - -=cut - -use strict; -use warnings; - -EOD - - -pp_addhdr(<<'EOH'); - -#include -#include -#include -#include - -#define PDLchar pdl -#define PDLuchar pdl -#define PDLshort pdl -#define PDLint pdl -#define PDLlong pdl -#define PDLfloat pdl -#define PDLdouble pdl -#define PDLvoid pdl -#define uchar unsigned char - - -#define COMP_CODE_NONE 0 -#define COMP_CODE_RLE 1 -#define COMP_CODE_SKPHUFF 3 -#define COMP_CODE_DEFLATE 4 - -EOH - -use FindBin; -use lib "$FindBin::Bin/.."; -use buildfunc; - -#------------------------------------------------------------------------- -# Create low level interface from HDF SD header file. -#------------------------------------------------------------------------- - -create_low_level (<<'EODEF'); -# -# SDS Interface -# -int SDstart(const char *filename, int access_mode); -int SDfileinfo(int sd_id, int *ndatasets, int *global_attr); -int SDattrinfo(int s_id, int attr_index, char *attr_name, int *number_type, int *count); -#int SDreadattr(int s_id, int attr_index, void *data); -int SDreadattr(int s_id, int attr_index, PDLvoid *data); -int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_type, int *nattrs); -int SDselect(int sd_id, int index); -int SDgetdimid(int sds_id, int dim_number); -int SDdiminfo(int dim_id, char *name, int *count, int *number_type, int *nattrs); -int SDnametoindex(int sd_id, const char *sds_name); -#int SDreaddata(int sds_id, int *start, int *stride, int *edge, void *buffer); -int SDreaddata(int sds_id, int *start, int *stride, int *edge, PDLvoid *buffer); -#int SDsetfillvalue(int sds_id, const void *fill_val); -int SDsetfillvalue(int sds_id, const PDLvoid *fill_val); -#int SDsetrange(int sds_id, const void *max, const void *min); -int SDsetrange(int sds_id, const PDLvoid *max, const PDLvoid *min); -#int SDwritedata(int sds_id, const int *start, const int *stride, const int *edge, const void *data); -int SDwritedata(int sds_id, const int *start, const int *stride, const int *edge, const PDLvoid *data); -int SDsetexternalfile(int sds_id, const char *filename, int offset); -int SDsetdimstrs(int dim_id, const char *label, const char *unit, const char *format); -int SDsetdimscale(int dim_id, int count, int number_type, const void *data); -int SDsetdimname(int dim_id, const char *dim_name); -int SDsetdatastrs(int sds_id, const char *label, const char *unit, const char *format, const char *coordsys); -int SDsetcal(int sds_id, double cal, double cal_err, double offset, double offset_err, int number_type); -#int SDsetcal(int sds_id, float cal, float cal_err, float offset, float offset_err, int number_type); -int SDsetattr(int s_id, const char *attr_name, int num_type, int count, const void *values); -int SDreftoindex(int sd_id, int sds_ref); -int SDiscoordvar(int sds_id); -int SDidtoref(int sds_id); -int SDgetdimstrs(int dim_id, char *label, char *unit, char *format, int len); -int SDgetdimscale(int dim_id, void *data); -int SDgetdatastrs(int sds_id, char *label, char *unit, char *format, char *coordsys, int len); - - -#ORIG: -#int SDgetcal(int sds_id, double cal, double cal_err, double offset, double offset_err, double number_type); -#int SDgetcal(int sds_id, float cal, float cal_err, float offset, float offset_err, int number_type); -#int SDgetcal(int sds_id, double *cal, double *cal_err, float64 *offset, float64 *offset_err, int *number_type); - -int SDendaccess(int sds_id); -int SDend(int sd_id); -int SDcreate(int sd_id, const char *name, int number_type, int rank, const int *dimsizes); - -int SDwritechunk(int sds_id, const int* origin, const PDLvoid *data); -int SDsetchunkcache(int sds_id, int maxcache, int flag); - -EODEF - -pp_addxs('',<<'ENDXS'); - -void -_HEprint(int level) - CODE: - HEprint(stderr, level); - -int -_SDgetcal(sds_id, cal, cal_err, offset, offset_err, number_type) - int sds_id - double cal - double cal_err - double offset - double offset_err - int* number_type - CODE: - RETVAL = SDgetcal(sds_id, &cal, &cal_err, &offset, &offset_err, number_type); - OUTPUT: - RETVAL - -void -UnpackSBigEndianPDL(size, buff, p) - int size - unsigned char * buff - PDLint * p - CODE: - int i, INTtmp; - unsigned char bch1, bch2; - int * data; - - data = p->data; - - for(i=0; i= 32768 ) - { INTtmp -= 65536; } - - data[i] = INTtmp; - } - OUTPUT: - p - -int -_SDsetcompress(sd_id, ldef); - int sd_id - int ldef - CODE: - comp_info c_info; - c_info.deflate.level = ldef; - RETVAL = SDsetcompress(sd_id, COMP_CODE_DEFLATE, &c_info) + 1; - OUTPUT: - RETVAL - -int -_SDsetchunk(sds_id, rank, chunk_lengths); - int sds_id - int rank - int* chunk_lengths - CODE: - HDF_CHUNK_DEF c_def; - int i; - int32 status = FAIL; - for(i = 0; i < rank; i++) - { - /* fprintf(stderr, "_SDsetchunk(): chunk_lengths[%d] = %d\n", i , chunk_lengths[i]); */ - c_def.chunk_lengths[i] = chunk_lengths[i]; - c_def.comp.chunk_lengths[i] = chunk_lengths[i]; - } - c_def.comp.comp_type = COMP_CODE_DEFLATE; - c_def.comp.cinfo.deflate.level = 6; - status = SDsetchunk(sds_id, c_def, (HDF_CHUNK | HDF_COMP) ); - if( status == FAIL ) - { - fprintf(stderr, "_SDsetchunk(): return status = %d\n", status); - HEprint(stderr, 0); - } - RETVAL = status; - OUTPUT: - RETVAL - -int -_SDinitchunk(sds_id, type, rank, chunk_lengths); - int sds_id - int type - int rank - int* chunk_lengths - CODE: - void* data = NULL; - int* origin = NULL; - int i; - size_t size; - int status; - origin = malloc( sizeof( int ) * rank ); - for( i = 0; i < rank; i++ ) - origin[i] = 0; - /* Just use the largest datatype here: */ - size = DFKNTsize(type) * chunk_lengths[0]; - if( rank > 1 ) - { - for( i = 1; i < rank; i++ ) - size *= chunk_lengths[i]; - } - data = malloc( size ); - status = SDwritechunk(sds_id, origin, data); - if( status == FAIL ) - { - fprintf(stderr, "_SDinitchunk(): return status = %d\n", status); - HEprint(stderr, 0); - } - free( data ); - free( origin ); - RETVAL = status; - OUTPUT: - RETVAL - -int -Hishdf(filename); - char* filename - CODE: - RETVAL = Hishdf(filename); - OUTPUT: - RETVAL - -int -_SDgetunlimiteddim(sds_id, dim); - int sds_id - int dim - CODE: - char sds_name[250]; - int rank; - int dimsizes[32]; - int num_type; - int nattrs; - RETVAL = SDgetinfo(sds_id, sds_name, &rank, dimsizes, &num_type, &nattrs) + 1; - if(RETVAL==1){RETVAL = dimsizes[dim];} - OUTPUT: - RETVAL - -int -_SDsetattr_text(s_id, name, text, size); - int s_id - char * name - char * text - int size - CODE: - RETVAL = SDsetattr(s_id, name, 4, size, text); - OUTPUT: - RETVAL - -int -_SDsetattr_values(s_id, name, values, size, type); - int s_id - char * name - pdl * values - int size - int type - CODE: - RETVAL = SDsetattr(s_id, name, type, size, values->data); - OUTPUT: - RETVAL - -ENDXS - -pp_addpm(<<'EOPM'); - -use PDL::Primitive; -use PDL::Basic; - -use PDL::IO::HDF; - -require POSIX; - -sub _pkg_name - { return "PDL::IO::HDF::SD::" . shift() . "()"; } - -# Convert a byte to a char: -sub Byte2Char -{ - my ($strB) = @_; - my $strC; - for(my $i=0; $i<$strB->nelem; $i++) - { - $strC .= chr( $strB->at($i) ); - } - return($strC); -} # End of Byte2Char()... - -=head1 CLASS METHODS - -=head2 new - -=for ref - - Open or create a new HDF object. - -=for usage - - Arguments: - 1 : The name of the file. - if you want to write to it, prepend the name with the '+' character : "+name.hdf" - if you want to create it, prepend the name with the '-' character : "-name.hdf" - otherwise the file will be open in read only mode - - Returns the hdf object (die on error) - -=for example - - my $hdf = PDL::IO::HDF::SD->new("file.hdf"); - -=cut - - -sub new -{ - # General: - my $type = shift; - my $filename = shift; - - my $sub = _pkg_name( 'new' ); - - my $debug = 0; - - my $self = {}; - - if (substr($filename, 0, 1) eq '+') - { # open for writing - $filename = substr ($filename, 1); # chop off + - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ; - } - if (substr($filename, 0, 1) eq '-') - { # Create new file - $filename = substr ($filename, 1); # chop off - - print "$sub: Creating HDF File $filename\n" - if $debug; - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE; - $self->{SDID} = PDL::IO::HDF::SD::_SDstart( $filename, $self->{ACCESS_MODE} ); - my $res = PDL::IO::HDF::SD::_SDend( $self->{SDID} ); - die "$sub: _ERR::Create\n" - if( ($self->{SDID} == PDL::IO::HDF->FAIL ) || ( $res == PDL::IO::HDF->FAIL )); - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ; - } - unless( defined( $self->{ACCESS_MODE} ) ) - { # Default to Read-only access: - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ; - } - $self->{FILE_NAME} = $filename; - - # SD interface: - print "$sub: Loading HDF File $self->{FILE_NAME}\n" - if $debug; - - $self->{SDID} = PDL::IO::HDF::SD::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} ); - die "$sub: _ERR::SDstart\n" - if( $self->{SDID} == PDL::IO::HDF->FAIL ); - - my $num_datasets = -999; - my $num_global_attrs = -999; - my $res = _SDfileinfo( $self->{SDID}, $num_datasets, $num_global_attrs ); - die "$sub: ** sdFileInfo **\n" - if($res == PDL::IO::HDF->FAIL); - - foreach my $i ( 0 .. $num_global_attrs-1 ) - { - print "$sub: Loading Global Attribute #$i\n" - if $debug; - - my $attrname = " "x(PDL::IO::HDF->MAX_NC_NAME+1); - my $type = 0; - my $count = 0; - - $res = _SDattrinfo( $self->{SDID}, $i, $attrname, $type, $count ); - die "$sub: ** sdAttrInfo **\n" - if($res == PDL::IO::HDF->FAIL); - - print "$sub: \$attrname = \'$attrname\'\n" - if $debug; - - $self->{GLOBATTR}->{$attrname} = zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$type}, $count ); - $res = _SDreadattr( $self->{SDID}, $i, $self->{GLOBATTR}->{$attrname} ); - die "$sub: ** sdReadAttr **\n" - if($res == PDL::IO::HDF->FAIL); - - if( $type == PDL::IO::HDF->DFNT_CHAR ) - { - $self->{GLOBATTR}->{$attrname} = Byte2Char( $self->{GLOBATTR}->{$attrname} ); - } - } - - my @dataname; - foreach my $i ( 0 .. $num_datasets-1 ) - { - print "$sub: Loading SDS #$i\n" - if $debug; - - my $sds_id = _SDselect( $self->{SDID}, $i ); - die "$sub: ** sdSelect **\n" - if($sds_id == PDL::IO::HDF->FAIL); - - my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1); - my $rank = 0; - my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 ); - my $numtype = 0; - my $num_attrs = 0; - - $res = _SDgetinfo($sds_id, $name, $rank, $dimsize, $numtype, $num_attrs); - die "$sub: ** sdGetInfo **\n" - if($res == PDL::IO::HDF->FAIL); - - print "$sub: \$name = \'$name\'\n" - if $debug; - print "$sub: \$dimsize = \'$dimsize\'\n" - if $debug; - - $self->{DATASET}->{$name}->{TYPE} = $numtype; - $self->{DATASET}->{$name}->{RANK} = $rank; - $self->{DATASET}->{$name}->{SDSID} = $sds_id; - - # Load up information on the dimensions (named, unlimited, etc...): - # - foreach my $j ( 0 .. $self->{DATASET}->{$name}->{RANK}-1 ) - { - print "$sub: Loading SDS($i) Dimension #$j\n" - if $debug; - - my $dim_id = _SDgetdimid( $sds_id, $j ); - die "$sub: ** sdGetDimId **\n" - if($dim_id == PDL::IO::HDF->FAIL); - - my $dimname = " "x(PDL::IO::HDF->MAX_NC_NAME+1); - my $size = 0; - my $num_type = 0; - my $num_dim_attrs = 0; - - $res = _SDdiminfo( $dim_id, $dimname, $size, $num_type, $num_dim_attrs ); - die "$sub: ** sdDimInfo **\n" - if($res == PDL::IO::HDF->FAIL); - - print "$sub: \$dimname = \'$dimname\'\n" - if $debug; - - $self->{DATASET}->{$name}->{DIMS}->{$j}->{DIMID} = $dim_id; - $self->{DATASET}->{$name}->{DIMS}->{$j}->{SIZE} = $size; - $self->{DATASET}->{$name}->{DIMS}->{$j}->{NAME} = $dimname; - - # The size comes back as 0 if it has the HDF unlimited dimension thing going on: - # So, lets figure out what the size is currently at: - unless ( $size ) - { - $self->{DATASET}->{$name}->{DIMS}->{$j}->{REAL_SIZE} = _SDgetunlimiteddim( $sds_id, $j); - } - } - - # Load up info on the SDS's attributes: - # - foreach my $j ( 0 .. $num_attrs-1 ) - { - print "$sub: Loading SDS($i) Attribute #$j\n" - if $debug; - - my $attrname = " "x(PDL::IO::HDF->MAX_NC_NAME+1); - my $type = 0; - my $count = 0; - - $res = _SDattrinfo( $sds_id, $j, $attrname, $type, $count); - die "$sub: ** sdAttrInfo **\n" - if($res == PDL::IO::HDF->FAIL); - - print "$sub: \$attrname = \'$attrname\'\n" - if $debug; - - $self->{DATASET}->{$name}->{ATTRS}->{$attrname} = - zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$type}, $count ); - - $res = _SDreadattr( $sds_id, $j, $self->{DATASET}->{$name}->{ATTRS}->{$attrname} ); - die "$sub: ** sdReadAttr **\n" - if($res == PDL::IO::HDF->FAIL); - - # FIXME: This should be a constant - if( $type == PDL::IO::HDF->DFNT_CHAR ) - { - $self->{DATASET}->{$name}->{ATTRS}->{$attrname} = - Byte2Char( $self->{DATASET}->{$name}->{ATTRS}->{$attrname} ); - } - } - } - - bless $self, $type; - - # Now that we're blessed, run our own accessors: - - # Default to using this (it's a good thing :) - $self->Chunking( 1 ); - - return $self; -} # End of new()... - -=head2 Chunking - -=for ref - - Accessor for the chunking mode on this HDF file. - - 'Chunking' is an internal compression and tiling the HDF library can - perform on an SDS. - - This variable only affects they way SDput() works, and is ON by default. - - The code modifications enabled by this flag automatically partition the - dataset to chunks of at least 100x100 values in size. The logic on this - is pretty fancy, and would take a while to doc out here. If you - _really_ have to know how it auto-partitions the data, then look at - the code. - - Someday over the rainbow, I'll add some features for better control of the - chunking parameters, if the need arises. For now, it's just stupid easy - to use. - -=for usage - - Arguments: - 1 (optional): new value for the chunking flag. - -=for example - - # See if chunking is currently on for this file: - my $chunkvar = $hdf->Chunking(); - - # Turn the chunking off: - my $newvar = $hdf->Chunking( 0 ); - - # Turn the chunking back on: - my $newvar = $hdf->Chunking( 1 ); - -=cut - - -# See the changelog for more docs on this feature: -sub Chunking -{ - my $self = shift; - my $var = shift; - if( defined( $var ) ) - { - $self->{CHUNKING} = $var ? 1 : 0; - } - return $self->{CHUNKING}; -} # End of Chunking()... - -=head2 SDgetvariablenames - -=for ref - - get the list of datasets. - -=for usage - - No arguments - Returns the list of dataset or undef on error. - -=for example - - my @DataList = $hdfobj->SDgetvariablenames(); - -=cut - - -sub SDgetvariablenames -{ - my($self) = @_; - return sort keys %{$self->{DATASET}}; -} # End of SDgetvariablenames()... -sub SDgetvariablename -{ - my $self = shift; - return $self->SDgetvariablenames( @_ ); -} # End of SDgetvariablename()... - - -=head2 SDgetattributenames - -=for ref - - Get a list of the names of the global or SDS attributes. - -=for usage - - Arguments: - 1 (optional) : The name of the SD dataset from which you want to get - the attributes. This arg is optional, and without it, it will - return the list of global attribute names. - - Returns a list of names or undef on error. - -=for example - - # For global attributes : - my @attrList = $hdf->SDgetattributenames(); - - # For SDS attributes : - my @attrList = $hdf->SDgetattributenames("dataset_name"); - -=cut - - -sub SDgetattributenames -{ - my($self, $name) = @_; - if( defined( $name ) ) - { - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - return sort keys %{ $self->{DATASET}->{$name}->{ATTRS} }; - } - else - { - return sort keys %{ $self->{GLOBATTR} }; - } -} # End of SDgetattributenames()... -# Wrapper (this is now defunct): -sub SDgetattributname -{ - my $self = shift; - return $self->SDgetattributenames( @_ ); -} # End of SDgetattributname()... - -=head2 SDgetattribute - -=for ref - - Get a global or SDS attribute value. - -=for usage - - Arguments: - 1 : The name of the attribute. - 2 (optional): The name of the SDS from which you want to get the attribute - value. Without this arg, it returns the global attribute value of that name. - - Returns an attribute value or undef on error. - -=for example - - # for global attributs : - my $attr = $hdf->SDgetattribute("attr_name"); - - # for local attributs : - my $attr = $hdf->SDgetattribute("attr_name", "dataset_name"); - -=cut - - -sub SDgetattribute -{ - my($self, $name, $dataset) = @_; - if( defined($dataset) ) - { # It's an SDS attribute: - return( undef ) - unless defined( $self->{DATASET}->{$dataset} ); - return $self->{DATASET}->{$dataset}->{ATTRS}->{$name}; - } - else - { # Global attribute: - return( undef ) - unless defined( $self->{GLOBATTR}->{$name} ); - return $self->{GLOBATTR}->{$name}; - } -} # End of SDgetattribute()... -# Wrapper (this is now defunct): -sub SDgetattribut -{ - my $self = shift; - return $self->SDgetattribute( @_ ); -} # End of SDgetattribut()... - -=head2 SDgetfillvalue - -=for ref - - Get the fill value of an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS from which you want to get the fill value. - - Returns the fill value or undef on error. - -=for example - - my $fillvalue = $hdf->SDgetfillvalue("dataset_name"); - -=cut - - -sub SDgetfillvalue -{ - my($self, $name) = @_; - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - return ($self->{DATASET}->{$name}->{ATTRS}->{_FillValue})->at(0); -} # End of SDgetfillvalue()... - -=head2 SDgetrange - -=for ref - - Get the valid range of an SDS. - -=for usage - - Arguments: - 1 : the name of the SDS from which you want to get the valid range. - - Returns a list of two elements [min, max] or undef on error. - -=for example - - my @range = $hdf->SDgetrange("dataset_name"); - -=cut - - -sub SDgetrange -{ - my($self, $name) = @_; - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - return $self->{DATASET}->{$name}->{ATTRS}->{valid_range}; -} # End of SDgetrange()... - -=head2 SDgetscalefactor - -=for ref - - Get the scale factor of an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS from which you want to get the scale factor. - - Returns the scale factor or undef on error. - -=for example - - my $scale = $hdf->SDgetscalefactor("dataset_name"); - -=cut - - -sub SDgetscalefactor -{ - my($self, $name) = @_; - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - return ($self->{DATASET}->{$name}->{ATTRS}->{scale_factor})->at(0); -} # End of SDgetscalefactor()... - -=head2 SDgetdimsize - -=for ref - - Get the dimensions of a dataset. - -=for usage - - Arguments: - 1 : The name of the SDS from which you want to get the dimensions. - - Returns an array of n dimensions with their sizes or undef on error. - -=for example - - my @dim = $hdf->SDgetdimsize("dataset_name"); - -=cut - - -sub SDgetdimsize -{ - my ($self, $name) = @_; - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - my @dims; - foreach( sort keys %{ $self->{DATASET}->{$name}->{DIMS} } ) - { - push @dims, $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE}; - } - - return( @dims ); -} # End of SDgetdimsize()... - -=head2 SDgetunlimiteddimsize - -=for ref - - Get the actual dimensions of an SDS with 'unlimited' dimensions. - -=for usage - - Arguments: - 1 : The name of the SDS from which you want to the dimensions. - - Returns an array of n dimensions with the dim sizes or undef on error. - -=for example - - my @dims = $hdf->SDgetunlimiteddimsize("dataset_name"); - -=cut - - -sub SDgetunlimiteddimsize -{ - my ($self, $name) = @_; - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - my @dim; - foreach( sort keys %{$self->{DATASET}{$name}{DIMS}} ) - { - if( $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE} == 0 ) - { - $dim[ $_ ] = - $self->{DATASET}->{$name}->{DIMS}->{$_}->{REAL_SIZE}; - } - else - { - $dim[ $_ ] = - $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE}; - } - } - return(@dim); -} # End of SDgetunlimiteddimsize()... -# Wrapper (this is now defunct): -sub SDgetdimsizeunlimit -{ - my $self = shift; - return $self->SDgetunlimiteddimsize( @_ ); -} # End of SDgetdimsizeunlimit()... - -=head2 SDgetdimnames - -=for ref - - Get the names of the dimensions of a dataset. - -=for usage - - Arguments: - 1 : the name of a dataset you want to get the dimensions'names . - - Returns an array of n dimensions with their names or an empty list if error. - -=for example - - my @dim_names = $hdf->SDgetdimnames("dataset_name"); - -=cut - - -sub SDgetdimnames -{ - my ($self, $name) = @_; - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - my @dims=(); - foreach( sort keys %{ $self->{DATASET}->{$name}->{DIMS} } ) - { - push @dims,$self->{DATASET}->{$name}->{DIMS}->{$_}->{NAME}; - } - return(@dims); -} # End of SDgetdimnames()... -sub SDgetdimname -{ - my $self = shift; - return $self->SDgetdimnames( @_ ); -} # End of SDgetdimname(); - -=head2 SDgetcal - -=for ref - - Get the calibration factor from an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS - - Returns (scale factor, scale factor error, offset, offset error, data type), or undef on error. - -=for example - - my ($cal, $cal_err, $off, $off_err, $d_type) = $hdf->SDgetcal("dataset_name"); - -=cut - - -sub SDgetcal -{ - my ($self, $name ) = @_; - - my ($cal, $cal_err, $off, $off_err, $type); - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - return( undef ) - unless defined( $self->{DATASET}->{$name}->{ATTRS}->{scale_factor} ); - - $cal = $self->{DATASET}->{$name}->{ATTRS}->{scale_factor}; - $cal_err = $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err}; - $off = $self->{DATASET}->{$name}->{ATTRS}->{add_offset}; - $off_err = $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err}; - $type = $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt}; - - return( $cal, $cal_err, $off, $off_err, $type ); -} # End of SDgetcal()... - -=head2 SDget - -=for ref - - Get a the data from and SDS, or just a slice of that SDS. - -=for usage - - Arguments: - 1 : The name of the SDS you want to get. - 2 (optional): The start array ref of the slice. - 3 (optional): The size array ref of the slice (HDF calls this the 'edge'). - 4 (optional): The stride array ref of the slice. - - Returns a PDL of data if ok, PDL::null on error. - - If the slice arguments are not given, this function will read the entire - SDS from the file. - - The type of the returned PDL variable is the PDL equivalent of what was - stored in the HDF file. - -=for example - - # Get the entire SDS: - my $pdldata = $hdf->SDget("dataset_name"); - - # get a slice of the dataset - my $start = [10,50,10]; # the start position of the slice is [10, 50, 10] - my $edge = [20,20,20]; # read 20 values on each dimension from @start - my $stride = [1, 1, 1]; # Don't skip values - my $pdldata = $hdf->SDget( "dataset_name", $start, $edge, $stride ); - -=cut - - -sub SDget -{ - my($self, $name, $start, $end, $stride) = @_; - my $sub = _pkg_name( 'SDget' ); - - return null - unless defined( $self->{DATASET}->{$name} ); - - unless( defined( $end ) ) - { # \@end was not passed in, so we need to set everything else to defaults: - ($start, $end) = []; - my @dimnames=$self->SDgetdimnames($name); - for my $dim (0 .. $#dimnames) - { - my $use_size = $self->{DATASET}->{$name}->{DIMS}->{$dim}->{SIZE} - || $self->{DATASET}->{$name}->{DIMS}->{$dim}->{REAL_SIZE}; - - $$end[ $dim ] = $use_size; - $$start[ $dim ] = 0; - $$stride[ $dim ] = 1; - } - } - - my $c_start = pack ("L*", @$start); - my $c_end = pack ("L*", @$end); - my $c_stride = pack ("L*", @$stride); - #print STDERR "$sub: start:[".join(',',@$start) - # ."]=>$c_start end:[".join(',',@$end) - # ."]=>$c_end stride:[".join(',',@$stride)."]=>$c_stride\n"; - - my $buff = zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$self->{DATASET}->{$name}->{TYPE}}, reverse @$end ); - - my $res = _SDreaddata( $self->{DATASET}->{$name}->{SDSID}, $c_start, $c_stride, $c_end, $buff ); - if($res == PDL::IO::HDF->FAIL) - { - $buff = null; - print "$sub: Error returned from _SDreaddata()!\n"; - } - - return $buff; -} # End of SDget()... - -=head2 SDsetfillvalue - -=for ref - - Set the fill value for an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS. - 2 : The fill value. - - Returns true on success, undef on error. - -=for example - - my $res = $hdf->SDsetfillvalue("dataset_name",$fillvalue); - -=cut - - -sub SDsetfillvalue -{ - my ($self, $name, $value) = @_; - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - $value = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($value); - $self->{DATASET}->{$name}->{ATTRS}->{_FillValue} = $value; - - return( _SDsetfillvalue($self->{DATASET}->{$name}->{SDSID}, $value) + 1 ); -} # End of SDsetfillvalue()... - -=head2 SDsetrange - -=for ref - - Set the valid range of an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS - 2 : an anonymous array of two elements : [min, max]. - - Returns true on success, undef on error. - -=for example - - my $res = $hdf->SDsetrange("dataset_name", [$min, $max]); - -=cut - - -sub SDsetrange -{ - my ($self, $name, $range) = @_; - - return undef - unless defined( $self->{DATASET}->{$name} ); - - my $min = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($$range[0]); - my $max = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($$range[1]); - $range = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($range); - $self->{DATASET}->{$name}->{ATTRS}->{valid_range} = $range; - - return( _SDsetrange($self->{DATASET}->{$name}->{SDSID}, $max, $min) + 1 ); -} # End of SDsetrange()... - -=head2 SDsetcal - -=for ref - - Set the HDF calibration for an SDS. - - In HDF lingo, this means to define: - scale factor - scale factor error - offset - offset error - -=for usage - - Arguments: - 1 : The name of the SDS. - 2 (optional): the scale factor (default is 1) - 3 (optional): the scale factor error (default is 0) - 4 (optional): the offset (default is 0) - 5 (optional): the offset error (default is 0) - - Returns true on success, undef on error. - - NOTE: This is not required to make a valid HDF SDS, but is there if you want to use it. - -=for example - - # Create the dataset: - my $res = $hdf->SDsetcal("dataset_name"); - - # To just set the scale factor: - $res = $hdf->SDsetcal("dataset_name", $scalefactor); - - # To set all calibration parameters: - $res = $hdf->SDsetcal("dataset_name", $scalefactor, $scale_err, $offset, $off_err); - -=cut - - -sub SDsetcal -{ - my $self = shift; - my $name = shift; - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - $self->{DATASET}->{$name}->{ATTRS}->{scale_factor} = shift || 1; - $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err} = shift || 0; - $self->{DATASET}->{$name}->{ATTRS}->{add_offset} = shift || 0; - $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err} = shift || 0; - # PDL_Double is the default type: - $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt} = shift || 6; - - return( - _SDsetcal( - $self->{DATASET}->{$name}->{SDSID}, - $self->{DATASET}->{$name}->{ATTRS}->{scale_factor}, - $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err}, - $self->{DATASET}->{$name}->{ATTRS}->{add_offset}, - $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err}, - $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt} - ) + 1); -} # End of SDsetcal()... - -=head2 SDsetcompress - -=for ref - - Set the internal compression on an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS. - 2 (optional): The gzip compression level ( 1 - 9 ). If not - specified, then 6 is used. - - Returns true on success, undef on failure. - - WARNING: This is a fairly buggy feature with many version of the HDF library. - Please just use the 'Chunking' features instead, as they work far better, and - are more reliable. - -=for example - - my $res = $hdf->SDsetfillvalue("dataset_name",$deflate_value); - -=cut - - -sub SDsetcompress -{ - my ($self, $name) = @_; - - return( undef ) - unless defined( $self->{DATASET}->{$name} ); - - # NOTE: Behavior change from the old version: - # it used to set to 6 if the passed value was greater than 8 - # it now sets it to 9 if it's greater than 9. - my $deflate = shift || 6; - $deflate = 9 - if( $deflate > 9 ); - - return( 1 + _SDsetcompress( $self->{DATASET}->{$name}->{SDSID}, $deflate ) ); -} # End of SDsetcompress()... - -=head2 SDsettextattr - -=for ref - - Add a text HDF attribute, either globally, or to an SDS. - -=for usage - - Arguments: - 1 : The text you want to add. - 2 : The name of the attribute - 3 (optional): The name of the SDS. - - Returns true on success, undef on failure. - -=for example - - # Set a global text attribute: - my $res = $hdf->SDsettextattr("my_text", "attribut_name"); - - # Set a local text attribute for 'dataset_name': - $res = $hdf->SDsettextattr("my_text", "attribut_name", "dataset_name"); - -=cut - - -sub SDsettextattr -{ - my ($self, $text, $name, $dataset) = @_; - - if( defined($dataset) ) - { - return( undef ) - unless defined( $self->{DATASET}->{$dataset} ); - - $self->{DATASET}->{$dataset}->{ATTRS}->{$name} = $text; - return( _SDsetattr_text( $self->{DATASET}->{$dataset}->{SDSID}, $name, $text, length($text) ) + 1 ); - } - - # Implied else it's a global attribute: - $self->{GLOBATTR}->{$name} = $text; - return( _SDsetattr_text( $self->{SDID}, $name, $text, length($text) ) + 1); -} # End of SDsettextattr()... - -=head2 SDsetvalueattr - -=for ref - - Add a non-text HDF attribute, either globally, or to an SDS. - -=for usage - - Arguments: - 1 : A pdl of value(s) you want to store. - 2 : The name of the attribute. - 3 (optional): the name of the SDS. - - Returns true on success, undef on failure. - -=for example - - my $attr = sequence( long, 4 ); - - # Set a global attribute: - my $res = $hdf->SDsetvalueattr($attribute, "attribute_name"); - - # Set a local attribute for 'dataset_name': - $res = $hdf->SDsetvalueattr($attribute, "attribute_name", "dataset_name"); - -=cut - - -sub SDsetvalueattr -{ - my ($self, $values, $name, $dataset) = @_; - - if( defined($dataset) ) - { - return( undef ) - unless defined( $self->{DATASET}->{$dataset} ); - - $self->{DATASET}->{$dataset}->{ATTRS}->{$name} = $values; - return( _SDsetattr_values( - $self->{DATASET}->{$dataset}->{SDSID}, $name, $values, - $values->nelem(), $PDL::IO::HDF::SDtypeTMAP->{$values->get_datatype()} ) + 1); - } - # Implied else it's a global attribute: - $self->{GLOBATTR}->{$name} = $values; - return( _SDsetattr_values( - $self->{SDID}, $name, $values, - $values->nelem(), $PDL::IO::HDF::SDtypeTMAP->{$values->get_datatype()} ) + 1); -} # End of SDsetvalueattr()... - -=head2 SDsetdimname - -=for ref - - Set or rename the dimensions of an SDS. - -=for usage - - Arguments: - 1 : The name of the SDS. - 2 : An anonymous array with the dimensions names. For dimensions you want - to leave alone, leave 'undef' placeholders. - - Returns true on success, undef on failure. - -=for example - - # Rename all dimensions - my $res = $hdf->SDsetdimname("dataset_name", ['dim1','dim2','dim3']); - - # Rename some dimensions - $res = $hdf->SDsetdimname("dataset_name", ['dim1', undef ,'dim3']); - -=cut - - -# FIXME: There are several problems with this: -# - The return code is an aggregate, and not necessarily accurate -# - It bails on the first error without trying the rest. If that is still -# desired, then it should run the check first, and if it's ok, then actually -# make the HDF library call. -sub SDsetdimname -{ - my ($self, $name, $dimname) = @_; - - return undef - unless defined( $self->{DATASET}->{$name} ); - - my $res = 0; - foreach( sort keys %{$self->{DATASET}->{$name}->{DIMS}} ) - { - return( undef ) - unless defined( $$dimname[ $_ ] ); - - $res = _SDsetdimname( - $self->{DATASET}->{$name}->{DIMS}->{$_}->{DIMID}, - $$dimname[ $_ ] ) + 1; - } - return( $res ); -} # End of SDsetdimname()... - -=head2 SDput - -=for ref - - Write to a SDS in an HDF file or create and write to it if it doesn't exist. - -=for usage - - Arguments: - 1 : The name of the SDS. - 2 : A pdl of data. - 3 (optional): An anonymous array of the dim names (only for creation) - 4 (optional): An anonymous array of the start of the slice to store - (only for putting a slice) - - Returns true on success, undef on failure. - - The datatype of the SDS in the HDF file will match the PDL equivalent as - much as possible. - -=for example - - my $data = sequence( float, 10, 20, 30 ); #any value you want - - # Simple case: create a new dataset with a $data pdl - my $result = $hdf->SDput("dataset_name", $data); - - # Above, but also naming the dims: - $res = $hdf->SDput("dataset_name", $data, ['dim1','dim2','dim3']); - - # Just putting a slice in there: - my $start = [x,y,z]; - $res = $hdf->SDput("dataset_name", $data->slice("..."), undef, $start); - -=cut - - -sub SDput -{ - my($self, $name, $data, $dimname_p, $from) = @_; - - my $sub = _pkg_name( 'SDput' ); - - my $rank = $data->getndims(); - my $dimsize = pack ("L*", reverse $data->dims); - - # If this dataset doesn't already exist, then create it: - # - unless ( defined( $self->{DATASET}->{$name} ) ) - { - my $hdf_type = $PDL::IO::HDF::SDtypeTMAP->{$data->get_datatype()}; - - my $res = _SDcreate( $self->{SDID}, $name, $hdf_type, $rank, $dimsize ); - return( undef ) - if ($res == PDL::IO::HDF->FAIL); - - $self->{DATASET}->{$name}->{SDSID} = $res; - $self->{DATASET}->{$name}->{TYPE} = $hdf_type; - $self->{DATASET}->{$name}->{RANK} = $rank; - - if( $self->Chunking() ) - { - # Setup chunking on this dataset: - my @chunk_lens; - my $min_chunk_size = 100; - my $num_chunks = 10; - my $total_chunks = 1; - foreach my $dimsize ( $data->dims() ) - { - my $chunk_size = ($dimsize + 9) / $num_chunks; - my $num_chunks_this_dim = $num_chunks; - if( $chunk_size < $min_chunk_size ) - { - $chunk_size = $min_chunk_size; - # Re-calc the num_chunks_per_dim: - $num_chunks_this_dim = POSIX::ceil( $dimsize / $chunk_size ); - } - push(@chunk_lens, $chunk_size); - $total_chunks *= $num_chunks_this_dim; - } - my $chunk_lengths = pack("L*", reverse @chunk_lens); - - $res = _SDsetchunk( $self->{DATASET}->{$name}->{SDSID}, $rank, $chunk_lengths ); - return( undef ) - if ($res == PDL::IO::HDF->FAIL); - - $res = _SDsetchunkcache( $self->{DATASET}->{$name}->{SDSID}, $total_chunks, 0); - return( undef ) - if ($res == PDL::IO::HDF->FAIL); - } # End of chunking section... - } # End of dataset creation... - - my $start = []; - my $stride = []; - if( defined( $from ) ) - { - $start = $from; - foreach($data->dims) - { push(@$stride, 1); } - } - else - { # $from was not defined, so assume we're doing all of it: - foreach($data->dims) - { - push(@$start, 0); - push(@$stride, 1); - } - } - $start = pack ("L*", @$start); - $stride = pack ("L*", @$stride); - $data->make_physical(); - - my $res = _SDwritedata( $self->{DATASET}->{$name}->{SDSID}, $start, $stride, $dimsize, $data ); - return( undef ) - if ($res == PDL::IO::HDF->FAIL); - - foreach my $j ( 0 .. $rank-1 ) - { - # Probably not a good way to bail: - my $dim_id = _SDgetdimid( $self->{DATASET}->{$name}->{SDSID}, $j ); - return( undef ) - if( $dim_id == PDL::IO::HDF->FAIL); - - if( defined( @$dimname_p[$j] ) ) - { - $res = _SDsetdimname( $dim_id, @$dimname_p[$j] ); - return( undef ) - if( $res == PDL::IO::HDF->FAIL ); - } - - my $dimname = " "x(PDL::IO::HDF->MAX_NC_NAME); - my $size = 0; - my $num_dim_attrs = 0; - $res = _SDdiminfo( $dim_id, $dimname, $size, my $numtype=0, $num_dim_attrs); - - return( undef ) - if ($res == PDL::IO::HDF->FAIL); - $self->{DATASET}->{$name}->{DIMS}->{$j}->{NAME} = $dimname; - $self->{DATASET}->{$name}->{DIMS}->{$j}->{SIZE} = $size; - $self->{DATASET}->{$name}->{DIMS}->{$j}->{DIMID} = $dim_id; - } - return( 1 ); -} # End of SDput()... - -=head2 close - -=for ref - - Close an HDF file. - -=for usage - - No arguments. - -=for example - - my $result = $hdf->close(); - -=cut - - -# NOTE: This may not be enough, since there may be opened datasets as well! SDendaccess()! -sub close -{ - my $self = shift; - my $sdid = $self->{SDID}; - $self = undef; - return( _SDend( $sdid ) + 1); -} # End of close()... - -sub DESTROY -{ - my $self = shift; - $self->close; -} # End of DESTROY()... - -EOPM - -# -# Add the tail of the documentation to the module: -# -pp_addpm(<<'EOD'); - -=head1 CURRENT AUTHOR & MAINTAINER - -Judd Taylor, Orbital Systems, Ltd. -judd dot t at orbitalsystems dot com - -=head1 PREVIOUS AUTHORS - -Patrick Leilde patrick.leilde@ifremer.fr -contribs of Olivier Archer olivier.archer@ifremer.fr - -=head1 SEE ALSO - -perl(1), PDL(1), PDL::IO::HDF(1). - -=cut - - -EOD - -pp_done(); diff --git a/IO/HDF/TODO b/IO/HDF/TODO deleted file mode 100644 index 18f49f8d9..000000000 --- a/IO/HDF/TODO +++ /dev/null @@ -1,39 +0,0 @@ -# -# PDL::IO::HDF -# -# Version 2.0 TODO: -# We get there and it'll be included in the main PDL distribution! -# -# Judd Taylor, USF IMaRS -# 17 March 2006 -# - -############ -# General: # -############ - - Internally, everything should be using Class::Accessor methods, to seperate the naming semantics... - - I've always wanted better error handling, but that's a little ambitious for this version. - The current error handling is to just die, but that's a major pain, since you may just want - to open HDF files as a test and do something else if it fails. - If the sub doesn't just die(), then it returns alls sorts of things currently (0, [], undef) - - I prefer lazy population of information, as it speeds up doing simple things on the files - greatly. [NOTE: I've also written my own HDF4 C++ lib, and it works great there]. - - Real OO re-design and re-implementation (not for this version, though). - - -########## -# Tests: # -########## - - -################## -# Documentation: # -################## - - The VS.pd file needs a lot more documentation. - - diff --git a/IO/HDF/VS/.gitignore b/IO/HDF/VS/.gitignore deleted file mode 100644 index af2a6da19..000000000 --- a/IO/HDF/VS/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -VS.c -VS.pm -VS.xs diff --git a/IO/HDF/VS/Changes b/IO/HDF/VS/Changes deleted file mode 100644 index 4e8b2e0b0..000000000 --- a/IO/HDF/VS/Changes +++ /dev/null @@ -1,3 +0,0 @@ -Revision history for Perl extension PDL::HDF -0.01 13/02/01 - - original version diff --git a/IO/HDF/VS/Makefile.PL b/IO/HDF/VS/Makefile.PL deleted file mode 100644 index f63baa9b9..000000000 --- a/IO/HDF/VS/Makefile.PL +++ /dev/null @@ -1,30 +0,0 @@ -use strict; -use warnings; -use ExtUtils::MakeMaker; -use Config; - -my $package = [ qw(VS.pd VS PDL::IO::HDF::VS) ]; - -undef &MY::postamble; # suppress warning -*MY::postamble = sub { pdlpp_postamble_int($package); }; - -my $pkg = ExtUtils::Depends->new(qw(PDL::IO::HDF::VS Alien::HDF4)); -$pkg->set_inc(&PDL_INCLUDE()); -$pkg->add_typemaps(&PDL_TYPEMAP()); -$pkg->add_pm( - 'VS.pm' => '$(INST_LIBDIR)/VS.pm', -); - -WriteMakefile( - NAME => 'PDL::IO::HDF::VS', - OBJECT => 'VS$(OBJ_EXT)', - $pkg->get_makefile_vars, - clean => { - FILES => 'VS.pm VS.xs VS$(OBJ_EXT) VS.c', - }, - dist => { - COMPRESS => 'gzip', - SUFFIX => 'gz', - }, - NO_MYMETA => 1, -); diff --git a/IO/HDF/VS/VS.pd b/IO/HDF/VS/VS.pd deleted file mode 100644 index 93eeb238b..000000000 --- a/IO/HDF/VS/VS.pd +++ /dev/null @@ -1,743 +0,0 @@ -use strict; -use warnings; - -pp_addpm({At => 'Top'}, <<'EOD'); -use strict; -use warnings; - -=head1 NAME - -PDL::IO::HDF::VS - An interface library for HDF4 files. - -=head1 SYNOPSIS - - use PDL; - use PDL::IO::HDF::VS; - - #### no doc for now #### - -=head1 DESCRIPTION - -This library provides functions to manipulate -HDF4 files with VS and V interface (reading, writing, ...) - -For more information on HDF4, see http://www.hdfgroup.org/products/hdf4/ - -=head1 FUNCTIONS - -=cut -EOD - -pp_addhdr(<<'EOH'); - -#include -#include -#include -#include - -#include -#include -#include - -#define PDLchar pdl -#define PDLuchar pdl -#define PDLshort pdl -#define PDLint pdl -#define PDLlong pdl -#define PDLfloat pdl -#define PDLdouble pdl -#define PDLvoid pdl -#define uchar unsigned char - -#define PDLlist pdl - -EOH - -#define AVRef AV -#pp_bless ("PDL::IO::HDF::VS"); - -use FindBin; -use lib "$FindBin::Bin/.."; -use buildfunc; - - -#------------------------------------------------------------------------- -# Create low level interface from HDF VS and V header file. -#------------------------------------------------------------------------- - -create_low_level (<<'EODEF'); -# -# HDF (H) Interface -# -int Hishdf(const char *filename); -int Hopen(const char *filename, int access, int n_dds); -int Hclose(int file_id)+1; -# -# VGROUP/VDATA Interface -# -int Vstart(int hdfid); -int Vend(int hdfid); -int Vgetid(int hdfid, int vgroup_ref); -int Vattach(int hdfid, int vgroup_ref, const char *access); -int Vdetach(int vgroup_id); -int Vntagrefs(int vgroup_id); - -int Vgettagref(int vgroup_id, int index, int *tag, int *ref); - -int Vsetname(int vgroup_id, const char *vgroup_name); -int Vsetclass(int vgroup_id, const char *vgroup_class); -int Visvg(int vgroup_id, int obj_ref); -int Visvs(int vgroup_id, int obj_ref); -int Vaddtagref(int vgroup_id, int tag, int ref); -int Vinsert(int vgroup_id, int v_id); - -int VSsetname(int vdata_id, const char *vdata_name); -int VSsetclass(int vdata_id, const char *vdata_class); -int VSgetid(int hdfid, int vdata_ref); -int VSattach(int hdfid, int vdata_ref, const char *access); -int VSdetach(int vdata_id); -int VSelts(int vdata_id); -int VSsizeof(int vdata_id, const char *fields); -int VSfind(int hdfid, const char *vdata_name); -int VFfieldtype(int vdata_id, int field_index); -int VFnfields(int vdata_ref); -int VFfieldorder(int vdata_ref, int field_index); - -int VSfdefine(int vata_id, const char *fieldname, int data_type, int order)+1; -int VSsetfields(int vata_id, const char *fieldname_list)+1; -int VSwrite(int vdata_id, const PDLvoid *databuf, int n_records, int interlace_mode); -int VSread(int vdata_id, PDLvoid *databuf, int n_records, int interlace_mode); -#int VSlone(int file_id, int *ref_array, int max_ref); - -int VSfnattrs(int vdata_id, int field_index); -int VSgetattr(int vdata_id, int field_index, int attr_index, PDLlong *values); -int VSisattr(int vdata_id); - -int SDstart(const char *filename, int access_mode); -int SDreftoindex(int sd_id, int sds_ref); -int SDselect(int sd_id, int index); -int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_type, int *nattrs); -int SDendaccess(int sds_id); -int SDend(int sd_id); - -EODEF - -pp_addxs('',<<'ENDOFXS'); - -int -_WriteMultPDL(VID, nb_records, nb_fields, interlace_mode, sizeofPDL, sdimofPDL, listofPDL); - int VID - int nb_records - int nb_fields - int interlace_mode - AV *sizeofPDL - AV *sdimofPDL - AV *listofPDL - PROTOTYPE: @ - CODE: - unsigned long int total_size = 0; - int i, j, k; - for(i=0; iSvPDLV( *SvTmp2 ); - SV **SvTmp3 = av_fetch(sdimofPDL, j, 0); - int cursdim = SvIV( *SvTmp3 ); - SV **SvTmp1 = av_fetch(sizeofPDL, j, 0); - int curvalue = SvIV( *SvTmp1 ); - for(k=0; kdata + curvalue*i + curvalue*k*nb_records), curvalue ); - ptrbuff += curvalue; - } - } - } - } - else - { - for(j=0; jSvPDLV( *SvTmp2 ); - SV **SvTmp3 = av_fetch(sdimofPDL, j, 0); - int cursdim = SvIV( *SvTmp3 ); - SV **SvTmp1 = av_fetch(sizeofPDL, j, 0); - int curvalue = SvIV( *SvTmp1 ); - memcpy( ptrbuff, (unsigned char *)(curPDL->data), curvalue*nb_records*cursdim ); - ptrbuff += curvalue*nb_records*cursdim; - #printf("buffer %d= %d\n", k, curvalue*nb_records*cursdim); - } - interlace_mode = 1; - } - fprintf(stderr, "Calling VSwrite(VID=%d, databuff=%p, nb_records=%d, interlace_mode=%d)...\n", - VID, databuff, nb_records, interlace_mode); - RETVAL = VSwrite(VID, databuff, nb_records, interlace_mode); - free(databuff); - OUTPUT: - RETVAL - -SV * -_Vgetname(vgroup_id); - int vgroup_id - CODE: - uint16 len; - if (Vgetnamelen(vgroup_id, &len)) croak("Failed to get Vgetnamelen for ID=%d", vgroup_id); - char vgroup_name[len+1]; - Vgetname(vgroup_id,vgroup_name); - RETVAL = newSVpvn(vgroup_name,len); - OUTPUT: - RETVAL - -SV * -_VSgetname(vdata_id); - int vdata_id - CODE: - char vdata_name[VGNAMELENMAX]; - VSgetname(vdata_id,vdata_name); - RETVAL = newSVpv(vdata_name,0); - OUTPUT: - RETVAL - -SV * -_Vgetclass(vgroup_id); - int vgroup_id - CODE: - uint16 len; - if (Vgetclassnamelen(vgroup_id, &len)) croak("Failed to get Vgetclassnamelen for ID=%d", vgroup_id); - char vgroup_class[len+1]; - Vgetclass(vgroup_id,vgroup_class); - RETVAL = newSVpvn(vgroup_class,len); - OUTPUT: - RETVAL - -SV * -_VSgetclass(vdata_id); - int vdata_id - CODE: - char vdata_class[VGNAMELENMAX]; - VSgetclass(vdata_id,vdata_class); - RETVAL = newSVpv(vdata_class,0); - OUTPUT: - RETVAL - -int -_VSgetfields(vdata_id, fields); - int vdata_id - char *fields - CODE: - char tmpfields[10000]; - RETVAL=VSgetfields(vdata_id, tmpfields); - fields = tmpfields; - OUTPUT: - RETVAL - fields - -AV * -_VSlone(file_id); - int file_id; - CODE: - AV *ref_vdata_list=newAV(); - int ref_array[MAX_FIELD_SIZE]; - int32 nlone = VSlone(file_id, ref_array, MAX_FIELD_SIZE); - int32 i; - for(i=0;i[0] => 1, - PDL::short->[0] => 2, - PDL::ushort->[0] => 2, - PDL::long->[0] => 4, - PDL::float->[0] => 4, - PDL::double->[0] => 8 -}; - -sub _pkg_name - { return "PDL::IO::HDF::VS::" . shift() . "()"; } - -=head2 new - -=for ref - - Open or create a new HDF object with VS and V interface. - -=for usage - - Arguments: - 1 : The name of the HDF file. - If you want to write to it, prepend the name with the '+' character : "+name.hdf" - If you want to create it, prepend the name with the '-' character : "-name.hdf" - Otherwise the file will be opened in read only mode. - - Returns the hdf object (die on error) - -=for example - - my $hdf = PDL::IO::HDF::VS->new("file.hdf"); - -=cut - -sub new -{ - # general - my $type = shift; - my $filename = shift; - - my $self = {}; - - if (substr($filename, 0, 1) eq '+') - { # open for writing - $filename = substr ($filename, 1); # chop off + - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ; - } - if (substr($filename, 0, 1) eq '-') - { # Creating - $filename = substr ($filename, 1); # chop off - - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE; - } - - unless( defined($self->{ACCESS_MODE}) ) - { - $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ; - } - - $self->{FILE_NAME} = $filename; - - $self->{HID} = PDL::IO::HDF::VS::_Hopen( $self->{FILE_NAME}, $self->{ACCESS_MODE}, 20 ); - if ($self->{HID}) - { - PDL::IO::HDF::VS::_Vstart( $self->{HID} ); - - my $SDID = PDL::IO::HDF::VS::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} ); - - #### search for vgroup - my $vgroup = {}; - - my $vg_ref = -1; - while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL) - { - my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' ); - my $vg_name = PDL::IO::HDF::VS::_Vgetname($vg_id); - $vgroup->{$vg_name}{ref} = $vg_ref; - $vgroup->{$vg_name}{class} = PDL::IO::HDF::VS::_Vgetclass($vg_id); - my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id ); - for ( 0 .. $n_pairs-1 ) - { - my ($tag, $ref); - my $res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 ); - if($tag == 1965) - { # Vgroup - my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' ); - my $name = PDL::IO::HDF::VS::_Vgetname($id); - PDL::IO::HDF::VS::_Vdetach( $id ); - $vgroup->{$vg_name}->{children}->{$name} = $ref; - $vgroup->{$name}->{parents}->{$vg_name} = $vg_ref; - } - elsif($tag == 1962) - { # Vdata - my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r' ); - my $name = PDL::IO::HDF::VS::_VSgetname( $id ); - my $class = PDL::IO::HDF::VS::_VSgetclass( $id ); - PDL::IO::HDF::VS::_VSdetach( $id ); - $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData'; - $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref; - $vgroup->{$vg_name}->{attach}->{$name}->{class} = $class - if( $class ne '' ); - } - if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702) - { - my $i = _SDreftoindex( $SDID, $ref ); - my $sds_ID = _SDselect( $SDID, $i ); - my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1); - my $rank = 0; - my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 ); - my $numtype = 0; - my $nattrs = 0; - - $res = _SDgetinfo( $sds_ID, $name, $rank, $dimsize , $numtype, $nattrs ); - $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'SDS_Data'; - $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref; - } - } # for each pair... - PDL::IO::HDF::VS::_Vdetach( $vg_id ); - } # while vg_ref... - - PDL::IO::HDF::VS::_SDend( $SDID ); - $self->{VGROUP} = $vgroup; - - #### search for vdata - my $vdata_ref=-1; - my $vdata_id=-1; - my $vdata = {}; - - # get lone vdata (not member of a vgroup) - my $lone=PDL::IO::HDF::VS::_VSlone($self->{HID}); - - while ( $vdata_ref = shift @$lone ) - { - my $mode="r"; - if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ ) - { - $mode="w"; - } - $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $mode ); - my $n_records = 0; - my $interlace = 0; - my $fields = ""; - my $vdata_size = 0; - my $vdata_name = ""; - - PDL::IO::HDF::VS::_VSinquire( - $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name ); - $vdata->{$vdata_name}->{REF} = $vdata_ref; - $vdata->{$vdata_name}->{NREC} = $n_records; - $vdata->{$vdata_name}->{INTERLACE} = $interlace; - - $vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdata_id ); - - my $field_index = 0; - foreach my $onefield ( split( ",", $fields ) ) - { - $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} = - PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, $field_index ); - $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{INDEX} = $field_index; - $field_index++; - } - - PDL::IO::HDF::VS::_VSdetach( $vdata_id ); - } # while vdata_ref... - - $self->{VDATA} = $vdata; - } # if $self->{HDID}... - - bless($self, $type); -} # End of new()... - -sub Vgetchildren -{ - my ($self, $name) = @_; - return( undef ) - unless defined( $self->{VGROUP}->{$name}->{children} ); - - return sort keys %{$self->{VGROUP}->{$name}->{children}}; -} # End of Vgetchildren()... -# Now defunct: -sub Vgetchilds -{ - my $self = shift; - return $self->Vgetchildren( @_ ); -} # End of Vgetchilds()... - -sub Vgetattach -{ - my ($self, $name) = @_; - return( undef ) - unless defined( $self->{VGROUP}->{$name}->{attach} ); - - return sort keys %{$self->{VGROUP}->{$name}->{children}}; -} # End of Vgetattach()... - -sub Vgetparents -{ - my ($self, $name) = @_; - return( undef ) - unless defined( $self->{VGROUP}->{$name}->{parents} ); - - return sort keys %{$self->{VGROUP}->{$name}->{parents}}; -} # End of Vgetparents()... - -sub Vgetmains -{ - my ($self) = @_; - my @rlist; - foreach( sort keys %{$self->{VGROUP}} ) - { - push(@rlist, $_) - unless defined( $self->{VGROUP}->{$_}->{parents} ); - } - return @rlist; -} # End of Vgetmains()... - -sub Vcreate -{ - my($self, $name, $class, $where) = @_; - - my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, -1, 'w' ); - return( undef ) - if( $id == PDL::IO::HDF->FAIL ); - - my $res = _Vsetname($id, $name); - $res = _Vsetclass($id, $class) - if defined( $class ); - - $self->{VGROUP}->{$name}->{ref} = '???'; - $self->{VGROUP}->{$name}->{class} = $class - if defined( $class ); - - if( defined( $where ) ) - { - return( undef ) - unless defined( $self->{VGROUP}->{$where} ); - - my $ref = $self->{VGROUP}->{$where}->{ref}; - - my $Pid = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'w' ); - my $index = PDL::IO::HDF::VS::_Vinsert( $Pid, $id ); - my ($t, $r) = (0, 0); - $res = PDL::IO::HDF::VS::_Vgettagref( $Pid, $index, $t, $r ); - PDL::IO::HDF::VS::_Vdetach( $Pid ); - - $self->{VGROUP}->{$name}->{parents}->{$where} = $ref; - $self->{VGROUP}->{$where}->{children}->{$name} = $r; - $self->{VGROUP}->{$name}->{ref} = $r; - } - return( _Vdetach( $id ) + 1 ); -} # End of Vcreate()... - -=head2 close - -=for ref - - Close the VS interface. - -=for usage - - no arguments - -=for example - - my $result = $hdf->close(); - -=cut - -sub close -{ - my $self = shift; - _Vend( $self->{HID} ); - my $Hid = $self->{HID}; - $self = undef; - return( _Hclose($Hid) + 1 ); -} # End of close()... - -sub VSisattr -{ - my($self, $name) = @_; - - return undef - unless defined( $self->{VDATA}->{$name} ); - - return $self->{VDATA}->{$name}->{ISATTR}; -} # End of VSisattr()... - -sub VSgetnames -{ - my $self = shift; - return sort keys %{$self->{VDATA}}; -} # End of VSgetnames()... - -sub VSgetfieldnames -{ - my ( $self, $name ) = @_; - - my $sub = _pkg_name( 'VSgetfieldnames' ); - - die "$sub: vdata name $name doesn't exist!\n" - unless defined( $self->{VDATA}->{$name} ); - - return sort keys %{$self->{VDATA}->{$name}->{FIELDS}}; -} # End of VSgetfieldnames()... -# Now defunct: -sub VSgetfieldsnames -{ - my $self = shift; - return $self->VSgetfieldnames( @_ ); -} # End of VSgetfieldsnames()... - - -sub VSread -{ - my ( $self, $name, $field ) = @_; - my $sub = _pkg_name( 'VSread' ); - - my $data = null; - my $vdata_ref = PDL::IO::HDF::VS::_VSfind( $self->{HID}, $name ); - - die "$sub: vdata name $name doesn't exist!\n" - unless $vdata_ref; - - my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' ); - my $vdata_size = 0; - my $n_records = 0; - my $interlace = 0; - my $fields = ""; - my $vdata_name = ""; - PDL::IO::HDF::VS::_VSinquire( - $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name ); - my $data_type = PDL::IO::HDF::VS::_VFfieldtype( - $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} ); - - die "$sub: data_type $data_type not implemented!\n" - unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} ); - - my $order = PDL::IO::HDF::VS::_VFfieldorder( - $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} ); - - if($order == 1) - { - $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records ); - } - else - { - $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $order ); - } - my $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field ); - - die "$sub: _VSsetfields\n" - unless $status; - - $status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace); - - PDL::IO::HDF::VS::_VSdetach( $vdata_id ); - return $data; -} # End of VSread()... - -sub VSwrite -{ - my($self, $name, $mode, $field, $value) = @_; - - return( undef ) - if( $$value[0]->getndims > 2); #too many dims - - my $VD_id; - my $res; - my @foo = split( /:/, $name ); - - return( undef ) - if defined( $self->{VDATA}->{$foo[0]} ); - - $VD_id = _VSattach( $self->{HID}, -1, 'w' ); - - return( undef ) - if( $VD_id == PDL::IO::HDF->FAIL ); - - $res = _VSsetname( $VD_id, $foo[0] ); - return( undef ) - if( $res == PDL::IO::HDF->FAIL ); - - $res = _VSsetclass( $VD_id, $foo[1] ) - if defined( $foo[1] ); - return( undef ) - if( $res == PDL::IO::HDF->FAIL ); - - my @listfield = split( /,/, $field ); - for( my $i = 0; $i <= $#$value; $i++ ) - { - my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$$value[$i]->get_datatype()}; - $res = _VSfdefine( $VD_id, $listfield[$i], $HDFtype, $$value[$i]->getdim(1) ); - return( undef ) - unless $res; - } - - $res = _VSsetfields( $VD_id, $field ); - return( undef ) - unless $res; - - my @sizeofPDL; - my @sdimofPDL; - foreach ( @$value ) - { - push(@sdimofPDL, $_->getdim(1)); - push(@sizeofPDL, $TMAP->{$_->get_datatype()}); - } - $res = _WriteMultPDL( $VD_id, $$value[0]->getdim(0), $#$value+1, $mode, \@sizeofPDL, \@sdimofPDL, $value); - - return( undef ) - if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL ); - return $res; -} # End of VSwrite()... - - -sub DESTROY -{ - my $self = shift; - $self->close; -} # End of DESTROY()... - -EOPM - -# -# Add the tail of the docs: -# -pp_addpm(<<'EOD'); - -=head1 CURRENT AUTHOR & MAINTAINER - -Judd Taylor, Orbital Systems, Ltd. -judd dot t at orbitalsystems dot com - -=head1 PREVIOUS AUTHORS - -Olivier Archer olivier.archer@ifremer.fr -contribs of Patrick Leilde patrick.leilde@ifremer.fr - -=head1 SEE ALSO - -perl(1), L, L. - -=cut - -EOD - -pp_done(); diff --git a/IO/HDF/buildfunc.pm b/IO/HDF/buildfunc.pm deleted file mode 100644 index 0ef50b071..000000000 --- a/IO/HDF/buildfunc.pm +++ /dev/null @@ -1,97 +0,0 @@ -#package; - -use strict; -use warnings; - -# This file contains functions to build .pd from the HDF prototypes - -# Define a low-level perl interface to HDF from these definitions. -sub create_low_level -{ - # This file must be modified to only include - # netCDF 3 function definitions. - # Also, all C function declarations must be on one line. - my $defn = shift; - my $sub = "create_low_level()"; - - my @lines = split (/\n/, $defn); - - foreach my $line (@lines) - { - - next if ( $line =~ /^\#/ ); # Skip commented out lines - next if ( $line =~ /^\s*$/ ); # Skip blank lines - - unless ($line =~ /^(\w+\**)\s+(\w+)\((.+)\)(\+*\d*)\;/) - { - die "$sub: Can't parse this line!\n"; - } - my ($return_type, $func_name, $params, $add) = ($1, $2, $3, $4); - - my @vars; - my @types; - my $output = {}; - foreach my $param ( split (/,/, $params) ) - { - my ($varname) = ($param =~ /(\w+)$/); - $param =~ s/$varname//; # parm now contains the full C type - $output->{$varname} = 1 - if (($param =~ /\*/) && ($param !~ /const/)); - $param =~ s/const //; # get rid of 'const' in C type - $param =~ s/^\s+//; - $param =~ s/\s+$//; # pare off the variable type from 'parm' - - push (@vars, $varname); - push (@types, $param); - } - - # Create the XS header: - my $xsout = ''; - $xsout .= "$return_type\n"; - $xsout .= "_$func_name (" . join (", ", @vars) . ")\n"; - - # Add in the variable declarations: - foreach my $i ( 0 .. $#vars ) - { - $xsout .= "\t$types[$i]\t$vars[$i]\n"; - } - - # Add the CODE section: - $xsout .= "CODE:\n"; - $xsout .= "\tRETVAL = "; - $xsout .= "$add + " - if defined($add); - $xsout .= "$func_name ("; - - # Add more variable stuff: - foreach my $i ( 0 .. $#vars ) - { - my $type = $types[$i]; - if ($type =~ /PDL/) - { - $type =~ s/PDL//; # Get rid of PDL type when writing xs CODE section - $xsout .= "($type)$vars[$i]"."->data,"; - } - else - { - $xsout .= "$vars[$i],"; - } - } - chop ($xsout); # remove last comma - $xsout .= ");\n"; - - # Add the OUTPUT section: - $xsout .= "OUTPUT:\n"; - $xsout .= "\tRETVAL\n"; - foreach my $var ( sort keys %$output ) - { - $xsout .= "\t$var\n"; - } - $xsout .= "\n\n"; - - # Add it to the PDL::PP file: - pp_addxs ('', $xsout); - } -} # End of create_low_level()... - -1; diff --git a/IO/HDF/t/hdf_sd.t b/IO/HDF/t/hdf_sd.t deleted file mode 100644 index 01cb528b3..000000000 --- a/IO/HDF/t/hdf_sd.t +++ /dev/null @@ -1,168 +0,0 @@ -# Tests the SD interface to the HDF library. -# -# Judd Taylor, Orbital Systems, Ltd. -# 29 March 2006 -# -use strict; -use warnings; -use PDL; -use Test::More; -use Test::PDL; -use File::Temp qw(tempdir); -use PDL::IO::HDF::SD; - -my $tmpdir = tempdir( CLEANUP => 1 ); -my $testfile = "$tmpdir/sdtest.hdf"; - -my $SDobj = PDL::IO::HDF::SD->new( "-$testfile" ); - -my $data = sequence(short, 500, 5); -my $square_data = sequence(short, 50, 50); - -ok( $SDobj->SDput("myData", $data , ['dim1','dim2']), 'SDput()' ); - -ok( $SDobj->SDsetfillvalue("myData", 0), 'SDsetfillvalue()' ); - -ok( $SDobj->SDsetrange("myData", [0, 2000]), 'SDsetrange()' ); - -ok( $SDobj->SDsetcal("myData"), 'SDsetcal()' ); - -ok( $SDobj->SDsettextattr('This is a global text test!!', "myGText" ), 'SDsettextattr() (global)' ); - -ok( $SDobj->SDsettextattr('This is a local text testl!!', "myLText", "myData" ), 'SDsettextattr() (local)' ); - -ok( $SDobj->SDsetvalueattr( PDL::short( 20 ), "myGValue"), 'SDSetvalueattr() (global)' ); - -ok( $SDobj->SDsetvalueattr( PDL::long( [20, 15, 36] ), "myLValues", "myData" ), 'SDSetvalueattr() (local)' ); - -ok( $SDobj->SDput("mySquareData", $square_data , ['square_dim','square_dim']), 'SDput()' ); - -$SDobj->close; - -ok( PDL::IO::HDF::SD::Hishdf( $testfile ), 'Hishdf()' ); - -#Open an HDF file in read only mode -my $SDobj2 = PDL::IO::HDF::SD->new( $testfile ); - -my @dataset_list = $SDobj2->SDgetvariablenames(); -ok( $#dataset_list+1, 'SDgetvariablenames()' ); - -my @globattr_list = $SDobj2->SDgetattributenames(); -ok( $#globattr_list+1, 'SDgetattributenames() (global)' ); - -my @locattr_list = $SDobj2->SDgetattributenames( "myData" ); -ok( $#locattr_list+1, 'SDgetattributenames() (local)' ); - -my $value = $SDobj2->SDgetattribute( "myLText", "myData" ); -ok( defined($value), 'SDgetattribute() (local)' ); - -$data = $SDobj2->SDget("myData"); -ok( $data->nelem() > 0, 'SDget()' ); - -my @dim = $SDobj2->SDgetdimnames("myData"); -ok( ($dim[0] eq "dim1") && ($dim[1] eq "dim2") , 'SDgetdimnames()' ); - -my @dim_square = $SDobj2->SDgetdimsize("myData"); -ok( ($dim_square[0] == 5) && ($dim_square[1] == 500), 'SDgetdimsize()' ); - -@dim_square = $SDobj2->SDgetdimnames("mySquareData"); -ok( ($dim_square[0] eq "square_dim") && ($dim_square[1] eq "square_dim"), 'SDgetdimnames()' ); - -@dim_square = $SDobj2->SDgetdimsize("mySquareData"); -ok( ($dim_square[0] == 50) && ($dim_square[1] == 50), 'SDgetdimsize()' ); - -my $square_data_get = $SDobj2->SDget("mySquareData"); -ok( $square_data_get->nelem() > 0, 'SDget()' ); - -my $res = $SDobj2->SDgetscalefactor("myData"); -ok( defined($res), 'SDgetscalefactor()' ); - -#The fill value corresponding to the BAD value in pdl -$res = $SDobj2->SDgetfillvalue("myData"); -ok( defined($res), 'SDgetfillvalue()' ); - -my @range = $SDobj2->SDgetrange("myData"); -ok( $#range+1, 'SDgetrange()' ); - -$SDobj2->close; - -undef($data); -my $HDFobj = PDL::IO::HDF::SD->new("-$testfile"); - -$data = ones( short, 5000, 5); -ok( $HDFobj->SDput("myData", $data , ['dim1','dim2']), 'SDput()' ); - -$HDFobj->SDput("myData", $data , ['dim1','dim2']); -$data = $HDFobj->SDget("myData"); -ok( $data->nelem(), 'SDget()' ); - -$HDFobj->close(); - -my $hdf = PDL::IO::HDF::SD->new( "-$testfile" ); - -ok( $hdf->Chunking(), 'Chunking()' ); -$hdf->Chunking(0); -ok( !$hdf->Chunking(), 'Chunking(0)' ); - -my $dataset = sequence( byte, 10, 10 ); -$res = $hdf->SDput( "NO_CHUNK", $dataset ); -ok( $res, 'SDput() (unchunked)' ); - -$hdf->close(); -undef($hdf); - -$hdf = PDL::IO::HDF::SD->new( $testfile ); - -my $dataset_test = $hdf->SDget( "NO_CHUNK" ); -my $good = ($dataset_test->nelem() > 0) ? 1 : 0; -ok( $good, 'SDget() (unchunked)' ); -my $do_skip = $good ? '' : 'Skip if failed previous test!'; -SKIP: { - skip( "Previous test failed!", 1 ) if $do_skip; - is_pdl $dataset, $dataset_test, 'comparing datasets written out and read in (unchunked)'; -} - -$hdf->close(); -undef($hdf); -unlink( $testfile ); - -# Reopen to write out the chunked portion: -$hdf = PDL::IO::HDF::SD->new( "-$testfile" ); - -my $dataset2d = sequence( long, 200, 200 ); - -$res = $hdf->SDput( "CHUNK_2D", $dataset2d ); -ok( $res, 'SDput() (chunked, 2D)' ); - -my $dataset3d = sequence( long, 200, 200, 10 ); -$res = $hdf->SDput( "CHUNK_3D", $dataset3d ); -ok( $res, 'SDput() (chunked, 3D)'); - -$hdf->close(); -undef($hdf); - -# Verify the datasets we just wrote: -$hdf = PDL::IO::HDF::SD->new( $testfile ); - -my $dataset2d_test = $hdf->SDget( "CHUNK_2D" ); -$good = $dataset2d_test->nelem() > 0; -ok( $good, 'SDget() (chunked, 2D)' ); -$do_skip = $good ? '' : 'Skip if failed previous test!'; -SKIP: { - skip( "Previous test failed!", 1 ) if $do_skip; - is_pdl $dataset2d_test, $dataset2d, 'comparing datasets written out and read in (chunked, 2D)'; -} - -my $dataset3d_test = $hdf->SDget( "CHUNK_3D" ); -$good = $dataset3d_test->nelem() > 0; -ok( $good, 'SDget() (chunked, 3D)' ); -$do_skip = $good ? '' : 'Skip if failed previous test!'; -SKIP: { - skip( "Previous test failed!", 1 ) if $do_skip; - is_pdl $dataset3d_test, $dataset3d, 'comparing datasets written out and read in (chunked, 3D)'; -} - -$hdf->close(); -undef($hdf); - -done_testing; diff --git a/IO/HDF/t/hdf_vdata.t b/IO/HDF/t/hdf_vdata.t deleted file mode 100644 index c62480c19..000000000 --- a/IO/HDF/t/hdf_vdata.t +++ /dev/null @@ -1,98 +0,0 @@ -# Tests Vdata features of the HDF library. -# -# 29 March 2006 -# Judd Taylor, USF IMaRS -# -use strict; -use warnings; -use PDL; -use Test::More; -use Test::PDL; -use PDL::IO::HDF::VS; -use File::Temp qw(tempdir); - -# Vdata test suite -my $tmpdir = tempdir( CLEANUP => 1 ); -my $testfile = "$tmpdir/vdata.hdf"; - -# creating - -my $Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_CREATE, 2); -ok( $Hid != PDL::IO::HDF->FAIL ); - -PDL::IO::HDF::VS::_Vstart( $Hid ); -my $vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, -1, "w" ); -PDL::IO::HDF::VS::_VSsetname( $vdata_id, 'vdata_name' ); -PDL::IO::HDF::VS::_VSsetclass( $vdata_id, 'vdata_class' ); - -my $vdata_ref = PDL::IO::HDF::VS::_VSgetid( $Hid, -1 ); -ok( $vdata_ref != PDL::IO::HDF->FAIL ); - -is( PDL::IO::HDF::VS::_VSgetname( $vdata_id ), "vdata_name" ); -is( PDL::IO::HDF::VS::_VSgetclass( $vdata_id ), "vdata_class" ); - -my $data = PDL::float sequence(10); -my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$data->get_datatype()}; - -ok( PDL::IO::HDF::VS::_VSfdefine( $vdata_id, 'PX', $HDFtype, 1) ); -ok( PDL::IO::HDF::VS::_VSsetfields( $vdata_id, 'PX') ); -ok( PDL::IO::HDF::VS::_VSwrite( $vdata_id, $data, 10, PDL::IO::HDF->FULL_INTERLACE ) ); - -PDL::IO::HDF::VS::_VSdetach( $vdata_id ); -PDL::IO::HDF::VS::_Vend( $Hid ); - -ok( PDL::IO::HDF::VS::_Hclose( $Hid ) ); - -undef( $Hid ); -$Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_READ, 2 ); -ok( $Hid != PDL::IO::HDF->FAIL ); - -PDL::IO::HDF::VS::_Vstart( $Hid ); - -$vdata_ref = PDL::IO::HDF::VS::_VSfind( $Hid, 'vdata_name' ); -ok( $vdata_ref != PDL::IO::HDF->FAIL ); - -$vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, $vdata_ref, "r" ); -ok( $vdata_id != PDL::IO::HDF->FAIL ); - -my $vdata_size = 0; -my $n_records = 0; -my $interlace = 0; -my $fields = ""; -my $vdata_name = ""; -PDL::IO::HDF::VS::_VSinquire( $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name); - -my @tfields = split(",",$fields); -my $data_type = PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, 0 ); -$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, 10 ); -ok( PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace ) ); -is_pdl $data, sequence(float, 10); - -PDL::IO::HDF::VS::_VSdetach( $vdata_id ); -PDL::IO::HDF::VS::_Vend( $Hid ); - -ok( PDL::IO::HDF::VS::_Hclose( $Hid ) ); - -my $vdataOBJ = PDL::IO::HDF::VS->new( $testfile ); -ok( defined( $vdataOBJ ) ); - -my @vnames = $vdataOBJ->VSgetnames(); -ok( scalar( @vnames ) > 0 ); - -foreach my $name ( @vnames ) -{ - # TEST 18: - my @fields = $vdataOBJ->VSgetfieldnames( $name ); - ok( scalar( @fields ) > 0 ); - foreach my $field ( @fields ) - { - # TEST 19: - my $data = $vdataOBJ->VSread( $name, $field ); - ok( defined( $data ) ); - } -} - -ok( $vdataOBJ->close() ); -undef( $vdataOBJ ); - -done_testing; diff --git a/IO/HDF/t/hdf_vgroup.t b/IO/HDF/t/hdf_vgroup.t deleted file mode 100644 index 813d74a77..000000000 --- a/IO/HDF/t/hdf_vgroup.t +++ /dev/null @@ -1,53 +0,0 @@ -# Tests Vgroup features of the HDF library. -# -# 29 March 2006 -# Judd Taylor, USF IMaRS -# -use strict; -use warnings; -use PDL; -use Test::More; -use PDL::IO::HDF::VS; -use File::Temp qw(tempdir); - -my $tmpdir = tempdir( CLEANUP => 1 ); -my $testfile = "$tmpdir/vgroup.hdf"; - -# Vgroup test suite -my $Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_CREATE, 2 ); -ok( $Hid != -1 ); - -PDL::IO::HDF::VS::_Vstart( $Hid ); - -my $vgroup_id = PDL::IO::HDF::VS::_Vattach( $Hid, -1, "w" ); -PDL::IO::HDF::VS::_Vsetname( $vgroup_id, 'vgroup_name' ); -PDL::IO::HDF::VS::_Vsetclass( $vgroup_id, 'vgroup_class' ); - -my $vgroup_ref = PDL::IO::HDF::VS::_Vgetid( $Hid, -1 ); -ok( $vgroup_ref != PDL::IO::HDF->FAIL ); - -is( PDL::IO::HDF::VS::_Vgetname($vgroup_id), "vgroup_name" ); -is( PDL::IO::HDF::VS::_Vgetclass( $vgroup_id ), "vgroup_class" ); - -PDL::IO::HDF::VS::_Vdetach( $vgroup_id ); - -PDL::IO::HDF::VS::_Vend( $Hid ); - -ok( PDL::IO::HDF::VS::_Hclose( $Hid ) ); - -my $vOBJ = PDL::IO::HDF::VS->new( "+$testfile" ); -ok( defined($vOBJ) ); - -ok( $vOBJ->Vcreate('10vgroup','vgroup_class2','vgroup_name') ); - -my @mains = $vOBJ->Vgetmains(); -ok( scalar( @mains ) > 0 ); - -foreach my $Vmain ( @mains ) { - my @Vchildren = $vOBJ->Vgetchildren( $Vmain ); - ok( scalar( @Vchildren ) > 0 ); -} - -ok( $vOBJ->close() ); - -done_testing; diff --git a/IO/HDF/typemap b/IO/HDF/typemap deleted file mode 100644 index 58856f4cc..000000000 --- a/IO/HDF/typemap +++ /dev/null @@ -1,20 +0,0 @@ -# Extra type mappings for PDL::IO::HDF -# basic C types -int * T_PVI -long int * T_PVI -size_t * T_PVI -PDLint * T_PDL -PDLlong * T_PDL -PDLvoid * T_PDL - -############################################################################# -INPUT - -T_PVI - $var = ($type)SvPV($arg,PL_na) - -############################################################################# -OUTPUT - -T_PVI - sv_setiv((SV*)$arg, (IV)*$var); diff --git a/MANIFEST b/MANIFEST index febdab5ec..546006e74 100644 --- a/MANIFEST +++ b/MANIFEST @@ -321,21 +321,6 @@ IO/GD/Makefile.PL IO/GD/t/gd_oo_tests.t IO/GD/t/gd_tests.t IO/GD/typemap -IO/HDF/buildfunc.pm -IO/HDF/Changes -IO/HDF/HDF.pm -IO/HDF/Makefile.PL -IO/HDF/SD/Changes -IO/HDF/SD/Makefile.PL -IO/HDF/SD/SD.pd -IO/HDF/t/hdf_sd.t -IO/HDF/t/hdf_vdata.t -IO/HDF/t/hdf_vgroup.t -IO/HDF/TODO -IO/HDF/typemap -IO/HDF/VS/Changes -IO/HDF/VS/Makefile.PL -IO/HDF/VS/VS.pd IO/IDL/IDL.pm IO/IDL/Makefile.PL IO/IDL/README diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 123ce62e6..c2df113c7 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -64,8 +64,6 @@ Makefile\.old ^IO/ENVI/envi-data ^IO/ENVI/envi-data.hdr ^IO/GD/GD\.(pm|xs|c)$ -^IO/HDF/SD/SD\.(pm|xs|c)$ -^IO/HDF/VS/VS\.(pm|xs|c)$ ^Libtmp/Fit/Gaussian/Gaussian\..* ^Libtmp/GSL/lib/PDL/GSL/CDF(\.(pm|xs|c)$|-pp-) ^Libtmp/GSL/lib/PDL/GSL/DIFF(\.(pm|xs|c)$|-pp-)