view release on metacpan or  search on metacpan

lib/Data/MATFile.pm  view on Meta::CPAN

        croak "could not open $obj->{file_name}: $!";
    }
    return;
}

=head2 set_endianness

    $obj->set_endianness ($flag);

Set the endian-ness of C<$obj> from C<$flag>, which is part of the
header, as read in L</read_file_header>.

=cut

sub set_endianness
{
    my ($obj, $flag) = @_;
    my $e = chr ($flag / 0x100) . chr ($flag % 0x100);
    if ($e eq 'MI') {
        $obj->{endian} = 0;
    }
    elsif ($e eq 'IM') {
        $obj->{endian} = 1;
        $obj->error ("Opposite endian-ness files are not supported");
    }
    else {
        $obj->error ("Endian-ness flag $flag of $obj->{file_name} was not parsed");
    }
    if ($obj->{verbose}) {
        print "Endian-ness of input file is $obj->{endian}.\n";
    }
    return;
}

sub set_data
{
    my ($obj, $data) = @_;
    $obj->{input_data} = $data;
}

# Data-reading functions

=head2 read_object

    my $array = $obj->read_object ();

Read an object from the file.

=cut

sub read_object
{
    my ($obj) = @_;
    die "bad call" if wantarray != 0;
    my ($type, $n_bytes, $data) = $obj->read_data_header ();
    if ($obj->{eof}) {
        return undef;
    }
    if ($type == miCOMPRESSED) {
#	print "Oh, you have $n_bytes of data.\n";
	my $cdata = $obj->read_bytes ($n_bytes);
	my $uncdata = gunzip ($cdata);
	$obj->set_data ($uncdata);
#	print "Read again as uncompressed.\n";
	my $value = $obj->read_object ();
	$obj->set_data (undef);
	return $value;
    }
    elsif ($type == miMATRIX) {
	return $obj->read_matrix ($n_bytes, $data);
    }
    else {
	my $name = $names{$type};
	if (! defined $name) {
	    $name = 'unknown';
	}
        $obj->error ("cannot handle non-matrix data of type $name here");
    }
    return undef;
}

sub read_matrix
{
    my ($obj, $n_bytes, $data) = @_;
    if ($obj->{verbose}) {
        print <<'EOF';
                           
   __ _ _ __ _ __ __ _ _   _ 
  / _` | '__| '__/ _` | | | |
 | (_| | |  | | | (_| | |_| |
  \__,_|_|  |_|  \__,_|\__, |
                       |___/ 

EOF
    }
    my ($class) = $obj->read_array_flags ();
    # Flag for numeric classes.
    my $numeric = $obj->is_numeric ($class);
    my @dim = $obj->get_array_dimensions ();
    my $name = $obj->get_array_name ();

    # This is the return value.  It has to be stored in this
    # convoluted way because we need to store things like the
    # "complex" flag and the name of the matrix.

    my $matrix = {
        dimensions => \@dim,
        name => $name,
        class => $class,
    };

    # Handle the different possible types of matrix data.

    if ($numeric) {
        my $numbers = $obj->get_numeric_array ($class, \@dim);
        $matrix->{array} = $numbers,
    }
    elsif ($class == mxSTRUCT_CLASS) {
        my $field_names = $obj->read_field_names ();
        for (0..$#$field_names) {
            my $name = $field_names->[$_];
            if (! $name) {
                $obj->error ("no name for element $_");