"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "GENERATED/PDL/IO/HDF/VS.pm" between
PDL-2.081.tar.gz and PDL-2.082.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

VS.pm  (PDL-2.081)	:	VS.pm  (PDL-2.082)
skipping to change at line 45		skipping to change at line 45
This library provides functions to manipulate		This library provides functions to manipulate
HDF4 files with VS and V interface (reading, writing, ...)		HDF4 files with VS and V interface (reading, writing, ...)
For more information on HDF4, see http://www.hdfgroup.org/products/hdf4/		For more information on HDF4, see http://www.hdfgroup.org/products/hdf4/
=head1 FUNCTIONS		=head1 FUNCTIONS
=cut		=cut
#line 51 "VS.pm"		#line 51 "VS.pm"
#line 325 "VS.pd"		#line 308 "VS.pd"
use PDL::Primitive;		use PDL::Primitive;
use PDL::Basic;		use PDL::Basic;
use PDL::IO::HDF;		use PDL::IO::HDF;
my $TMAP = {		my $TMAP = {
PDL::byte->[0] => 1,		PDL::byte->[0] => 1,
PDL::short->[0] => 2,		PDL::short->[0] => 2,
PDL::ushort->[0] => 2,		PDL::ushort->[0] => 2,
skipping to change at line 132		skipping to change at line 132
my $vg_ref = -1;		my $vg_ref = -1;
while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL)		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_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' ) ;
my $n_entries = 0;		my $n_entries = 0;
my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);		my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );		my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );
my $vg_class = "";
PDL::IO::HDF::VS::_Vgetclass( $vg_id, $vg_class );
$vgroup->{$vg_name}->{ref} = $vg_ref;		$vgroup->{$vg_name}->{ref} = $vg_ref;
$vgroup->{$vg_name}->{class} = $vg_class;		$vgroup->{$vg_name}->{class} = PDL::IO::HDF::VS::_Vgetclass( $vg_id );
my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );		my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );
for ( 0 .. $n_pairs-1 )		for ( 0 .. $n_pairs-1 )
{		{
my ($tag, $ref);		my ($tag, $ref);
$res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );		$res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );
if($tag == 1965)		if($tag == 1965)
{ # Vgroup		{ # Vgroup
my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );		my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );
my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);		my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );		my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );
PDL::IO::HDF::VS::_Vdetach( $id );		PDL::IO::HDF::VS::_Vdetach( $id );
$vgroup->{$vg_name}->{children}->{$name} = $ref;		$vgroup->{$vg_name}->{children}->{$name} = $ref;
$vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;		$vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;
}		}
elsif($tag == 1962)		elsif($tag == 1962)
{ # Vdata		{ # Vdata
my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r ' );		my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r ' );
my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);		my $name = PDL::IO::HDF::VS::_VSgetname( $id );
my $res = PDL::IO::HDF::VS::_VSgetname( $id, $name );		my $class = PDL::IO::HDF::VS::_VSgetclass( $id );
my $class = "";
PDL::IO::HDF::VS::_VSgetclass( $id, $class );
PDL::IO::HDF::VS::_VSdetach( $id );		PDL::IO::HDF::VS::_VSdetach( $id );
$vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';		$vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';
$vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;		$vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
$vgroup->{$vg_name}->{attach}->{$name}->{class} = $class		$vgroup->{$vg_name}->{attach}->{$name}->{class} = $class
if( $class ne '' );		if( $class ne '' );
}		}
if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)		if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)
{		{
my $i = _SDreftoindex( $SDID, $ref );		my $i = _SDreftoindex( $SDID, $ref );
my $sds_ID = _SDselect( $SDID, $i );		my $sds_ID = _SDselect( $SDID, $i );
skipping to change at line 207		skipping to change at line 202
my $MAX_REF = 0;		my $MAX_REF = 0;
while ( $vdata_ref = shift @$lone )		while ( $vdata_ref = shift @$lone )
{		{
my $mode="r";		my $mode="r";
if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )		if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )
{		{
$mode="w";		$mode="w";
}		}
$vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $ mode );		$vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $ mode );
my $vdata_size = 0;
my $n_records = 0;		my $n_records = 0;
my $interlace = 0;		my $interlace = 0;
my $fields = "";		my $fields = "";
		my $vdata_size = 0;
my $vdata_name = "";		my $vdata_name = "";
my $status = PDL::IO::HDF::VS::_VSinquire(		PDL::IO::HDF::VS::_VSinquire(
$vdata_id, $n_records, $interlace, $fields, $vdata_s ize, $vdata_name );		$vdata_id, $n_records, $interlace, $fields, $vdata_s ize, $vdata_name );
die "PDL::IO::HDF::VS::_VSinquire (vdata_id=$vdata_id)"
unless $status;
$vdata->{$vdata_name}->{REF} = $vdata_ref;		$vdata->{$vdata_name}->{REF} = $vdata_ref;
$vdata->{$vdata_name}->{NREC} = $n_records;		$vdata->{$vdata_name}->{NREC} = $n_records;
$vdata->{$vdata_name}->{INTERLACE} = $interlace;		$vdata->{$vdata_name}->{INTERLACE} = $interlace;
$vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdat a_id );		$vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdat a_id );
my $field_index = 0;		my $field_index = 0;
foreach my $onefield ( split( ",", $fields ) )		foreach my $onefield ( split( ",", $fields ) )
{		{
$vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =		$vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =
skipping to change at line 248		skipping to change at line 241
bless($self, $type);		bless($self, $type);
} # End of new()...		} # End of new()...
sub Vgetchildren		sub Vgetchildren
{		{
my ($self, $name) = @_;		my ($self, $name) = @_;
return( undef )		return( undef )
unless defined( $self->{VGROUP}->{$name}->{children} );		unless defined( $self->{VGROUP}->{$name}->{children} );
return sort keys %{$self->{VGROUP}->{$name}->{children}};		return sort keys %{$self->{VGROUP}->{$name}->{children}};
#line 263 "VS.pm"		#line 256 "VS.pm"
#line 528 "VS.pd"		#line 504 "VS.pd"
} # End of Vgetchildren()...		} # End of Vgetchildren()...
# Now defunct:		# Now defunct:
sub Vgetchilds		sub Vgetchilds
{		{
my $self = shift;		my $self = shift;
return $self->Vgetchildren( @_ );		return $self->Vgetchildren( @_ );
} # End of Vgetchilds()...		} # End of Vgetchilds()...
sub Vgetattach		sub Vgetattach
{		{
my ($self, $name) = @_;		my ($self, $name) = @_;
return( undef )		return( undef )
unless defined( $self->{VGROUP}->{$name}->{attach} );		unless defined( $self->{VGROUP}->{$name}->{attach} );
return sort keys %{$self->{VGROUP}->{$name}->{children}};		return sort keys %{$self->{VGROUP}->{$name}->{children}};
#line 280 "VS.pm"		#line 273 "VS.pm"
#line 543 "VS.pd"		#line 519 "VS.pd"
} # End of Vgetattach()...		} # End of Vgetattach()...
sub Vgetparents		sub Vgetparents
{		{
my ($self, $name) = @_;		my ($self, $name) = @_;
return( undef )		return( undef )
unless defined( $self->{VGROUP}->{$name}->{parents} );		unless defined( $self->{VGROUP}->{$name}->{parents} );
return sort keys %{$self->{VGROUP}->{$name}->{parents}};		return sort keys %{$self->{VGROUP}->{$name}->{parents}};
#line 291 "VS.pm"		#line 284 "VS.pm"
#line 552 "VS.pd"		#line 528 "VS.pd"
} # End of Vgetparents()...		} # End of Vgetparents()...
sub Vgetmains		sub Vgetmains
{		{
my ($self) = @_;		my ($self) = @_;
my @rlist;		my @rlist;
foreach( sort keys %{$self->{VGROUP}} )		foreach( sort keys %{$self->{VGROUP}} )
#line 300 "VS.pm"		#line 293 "VS.pm"
#line 559 "VS.pd"		#line 535 "VS.pd"
{		{
push(@rlist, $_)		push(@rlist, $_)
unless defined( $self->{VGROUP}->{$_}->{parents} );		unless defined( $self->{VGROUP}->{$_}->{parents} );
}		}
return @rlist;		return @rlist;
} # End of Vgetmains()...		} # End of Vgetmains()...
sub Vcreate		sub Vcreate
{		{
my($self, $name, $class, $where) = @_;		my($self, $name, $class, $where) = @_;
skipping to change at line 369		skipping to change at line 362
return undef		return undef
unless defined( $self->{VDATA}->{$name} );		unless defined( $self->{VDATA}->{$name} );
return $self->{VDATA}->{$name}->{ISATTR};		return $self->{VDATA}->{$name}->{ISATTR};
} # End of VSisattr()...		} # End of VSisattr()...
sub VSgetnames		sub VSgetnames
{		{
my $self = shift;		my $self = shift;
return sort keys %{$self->{VDATA}};		return sort keys %{$self->{VDATA}};
#line 384 "VS.pm"		#line 377 "VS.pm"
#line 641 "VS.pd"		#line 617 "VS.pd"
} # End of VSgetnames()...		} # End of VSgetnames()...
sub VSgetfieldnames		sub VSgetfieldnames
{		{
my ( $self, $name ) = @_;		my ( $self, $name ) = @_;
my $sub = _pkg_name( 'VSgetfieldnames' );		my $sub = _pkg_name( 'VSgetfieldnames' );
die "$sub: vdata name $name doesn't exist!\n"		die "$sub: vdata name $name doesn't exist!\n"
unless defined( $self->{VDATA}->{$name} );		unless defined( $self->{VDATA}->{$name} );
return sort keys %{$self->{VDATA}->{$name}->{FIELDS}};		return sort keys %{$self->{VDATA}->{$name}->{FIELDS}};
#line 398 "VS.pm"		#line 391 "VS.pm"
#line 653 "VS.pd"		#line 629 "VS.pd"
} # End of VSgetfieldnames()...		} # End of VSgetfieldnames()...
# Now defunct:		# Now defunct:
sub VSgetfieldsnames		sub VSgetfieldsnames
{		{
my $self = shift;		my $self = shift;
return $self->VSgetfieldnames( @_ );		return $self->VSgetfieldnames( @_ );
} # End of VSgetfieldsnames()...		} # End of VSgetfieldsnames()...
sub VSread		sub VSread
{		{
skipping to change at line 410		skipping to change at line 403
die "$sub: vdata name $name doesn't exist!\n"		die "$sub: vdata name $name doesn't exist!\n"
unless $vdata_ref;		unless $vdata_ref;
my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );		my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );
my $vdata_size = 0;		my $vdata_size = 0;
my $n_records = 0;		my $n_records = 0;
my $interlace = 0;		my $interlace = 0;
my $fields = "";		my $fields = "";
my $vdata_name = "";		my $vdata_name = "";
my $status = PDL::IO::HDF::VS::_VSinquire(		PDL::IO::HDF::VS::_VSinquire(
$vdata_id, $n_records, $interlace, $fields, $vdata_size, $vd ata_name );		$vdata_id, $n_records, $interlace, $fields, $vdata_size, $vd ata_name );
my $data_type = PDL::IO::HDF::VS::_VFfieldtype(		my $data_type = PDL::IO::HDF::VS::_VFfieldtype(
$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );		$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );
die "$sub: data_type $data_type not implemented!\n"		die "$sub: data_type $data_type not implemented!\n"
unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );		unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );
my $order = PDL::IO::HDF::VS::_VFfieldorder(		my $order = PDL::IO::HDF::VS::_VFfieldorder(
$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );		$vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{IND EX} );
if($order == 1)		if($order == 1)
{		{
$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );		$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );
}		}
else		else
{		{
$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $ order );		$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $ order );
}		}
$status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );		my $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );
die "$sub: _VSsetfields\n"		die "$sub: _VSsetfields\n"
unless $status;		unless $status;
$status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlac e);		$status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlac e);
PDL::IO::HDF::VS::_VSdetach( $vdata_id );		PDL::IO::HDF::VS::_VSdetach( $vdata_id );
return $data;		return $data;
} # End of VSread()...		} # End of VSread()...
skipping to change at line 500		skipping to change at line 493
return( undef )		return( undef )
if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL );		if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL );
return $res;		return $res;
} # End of VSwrite()...		} # End of VSwrite()...
sub DESTROY		sub DESTROY
{		{
my $self = shift;		my $self = shift;
$self->close;		$self->close;
} # End of DESTROY()...		} # End of DESTROY()...
#line 517 "VS.pm"		#line 510 "VS.pm"
#line 776 "VS.pd"		#line 752 "VS.pd"
=head1 CURRENT AUTHOR & MAINTAINER		=head1 CURRENT AUTHOR & MAINTAINER
Judd Taylor, Orbital Systems, Ltd.		Judd Taylor, Orbital Systems, Ltd.
judd dot t at orbitalsystems dot com		judd dot t at orbitalsystems dot com
=head1 PREVIOUS AUTHORS		=head1 PREVIOUS AUTHORS
Olivier Archer olivier.archer@ifremer.fr		Olivier Archer olivier.archer@ifremer.fr
contribs of Patrick Leilde patrick.leilde@ifremer.fr		contribs of Patrick Leilde patrick.leilde@ifremer.fr
=head1 SEE ALSO		=head1 SEE ALSO
perl(1), PDL(1), PDL::IO::HDF(1).		perl(1), PDL(1), PDL::IO::HDF(1).
=cut		=cut
#line 539 "VS.pm"		#line 532 "VS.pm"
# Exit with OK status		# Exit with OK status
1;		1;
End of changes. 19 change blocks.
30 lines changed or deleted		23 lines changed or added

---