"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "IO/FastRaw/FastRaw.pm" between
PDL-2.076.tar.gz and PDL-2.077.tar.gz

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

FastRaw.pm  (PDL-2.076):FastRaw.pm  (PDL-2.077)
=head1 NAME =head1 NAME
PDL::IO::FastRaw -- A simple, fast and convenient io format for PerlDL. PDL::IO::FastRaw -- A simple, fast and convenient io format for PerlDL.
=head1 VERSION
This documentation refers to PDL::IO::FastRaw version 0.0.2, I guess.
=head1 SYNOPSIS =head1 SYNOPSIS
use PDL; use PDL;
use PDL::IO::FastRaw; use PDL::IO::FastRaw;
writefraw($pdl,"fname"); # write a raw file writefraw($pdl,"fname"); # write a raw file
$pdl2 = readfraw("fname"); # read a raw file $pdl2 = readfraw("fname"); # read a raw file
$pdl2 = PDL->readfraw("fname"); $pdl2 = PDL->readfraw("fname");
gluefraw($pdlx, "fname"); # append to existing file
$pdlx->gluefraw("fname");
$pdl3 = mapfraw("fname2",{ReadOnly => 1}); # mmap a file, don't read yet $pdl3 = mapfraw("fname2",{ReadOnly => 1}); # mmap a file, don't read yet
$pdl4 = maptextfraw("fname3",{...}); # map a text file into a 1-D pdl. $pdl4 = maptextfraw("fname3",{...}); # map a text file into a 1-D pdl.
=head1 DESCRIPTION =head1 DESCRIPTION
This is a very simple and fast io format for PerlDL. This is a very simple and fast io format for PerlDL.
The disk data consists of two files, a header metadata file The disk data consists of two files, a header metadata file
in ASCII and a binary file consisting simply of consecutive in ASCII and a binary file consisting simply of consecutive
bytes, shorts or whatever. bytes, shorts or whatever.
skipping to change at line 175 skipping to change at line 174
$ndarray_on_hd = mapfraw('fname', {Creat => 1, Dims => [dim1, dim2, ...]}); $ndarray_on_hd = mapfraw('fname', {Creat => 1, Dims => [dim1, dim2, ...]});
Note that you must specify the dimensions and you must tell Note that you must specify the dimensions and you must tell
C<mapfraw> to create the new ndarray for you by setting the C<mapfraw> to create the new ndarray for you by setting the
C<Creat> option to a true value, not C<Create> (note the missing C<Creat> option to a true value, not C<Create> (note the missing
final 'e'). final 'e').
=head1 FUNCTIONS =head1 FUNCTIONS
=head2 readfraw =cut
package PDL::IO::FastRaw;
use strict;
use warnings;
our $VERSION = '0.000003';
$VERSION = eval $VERSION;
require Exporter;
use PDL::Core '';
use PDL::Exporter;
our @ISA = qw/PDL::Exporter/;
our @EXPORT_OK = qw/writefraw readfraw mapfraw maptextfraw gluefraw/;
our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
# Exported functions
*writefraw = \&PDL::writefraw;
*gluefraw = \&PDL::gluefraw;
sub readfraw {PDL->readfraw(@_)}
sub mapfraw {PDL->mapfraw(@_)}
sub maptextfraw {PDL->maptextfraw(@_)}
sub _read_frawhdr {
my($name,$opts) = @_;
my $hname = $opts->{Header} || "$name.hdr";
open my $h, '<', $hname
or barf "Couldn't open '$hname' for reading: $!";
chomp(my $tid = <$h>);
chomp(my $ndims = <$h>);
chomp(my $str = <$h>); if(!defined $str) {barf("Format error in '$hname'"
);}
my @dims = split ' ',$str;
if($#dims != $ndims-1) {
barf("Format error reading fraw header file '$hname'");
}
return {
Type => $tid,
Dims => \@dims,
NDims => $ndims
};
}
sub _writefrawhdr {
my($pdl,$name,$opts) = @_;
my $hname = $opts->{Header} || "$name.hdr";
open my $h, '>', $hname
or barf "Couldn't open '$hname' for writing: $!";
print $h map "$_\n", $pdl->get_datatype,
$opts->{NDims} // $pdl->getndims,
join(' ', $opts->{Dims} ? @{$opts->{Dims}} : $pdl->dims);
}
=head2 writefraw
=for ref =for ref
Read a raw format binary file Write a raw format binary file
=for usage =for usage
$pdl2 = readfraw("fname"); writefraw($pdl,"fname");
$pdl2 = PDL->readfraw("fname"); writefraw($pdl,"fname", {Header => 'headerfname'});
$pdl2 = readfraw("fname", {Header => 'headerfname'});
=for options =for options
The C<readfraw> command The C<writefraw> command
supports the following option: supports the following option:
=over 8 =over 8
=item Header =item Header
Specify the header file name. Specify the header file name.
=back =back
=head2 writefraw =cut
sub PDL::writefraw {
my($pdl,$name,$opts) = @_;
_writefrawhdr($pdl,$name,$opts);
open my $d, '>', $name
or barf "Couldn't open '$name' for writing: $!";
binmode $d;
print $d ${$pdl->get_dataref};
}
=head2 readfraw
=for ref =for ref
Write a raw format binary file Read a raw format binary file
=for usage =for usage
writefraw($pdl,"fname"); $pdl2 = readfraw("fname");
writefraw($pdl,"fname", {Header => 'headerfname'}); $pdl2 = PDL->readfraw("fname");
$pdl2 = readfraw("fname", {Header => 'headerfname'});
=for options =for options
The C<writefraw> command The C<readfraw> command
supports the following option: supports the following option:
=over 8 =over 8
=item Header =item Header
Specify the header file name. Specify the header file name.
=back =back
=cut
sub PDL::readfraw {
my $class = shift;
my($name,$opts) = @_;
open my $d, '<', $name or barf "Couldn't open '$name' for reading: $!";
binmode $d;
my $hdr = _read_frawhdr($name,$opts);
my $pdl = $class->zeroes(PDL::Type->new($hdr->{Type}), @{$hdr->{Dims}});
my $len = length ${$pdl->get_dataref};
my $index = 0;
my $data;
my $retlen;
while (($retlen = sysread $d, $data, $len) != 0) {
substr(${$pdl->get_dataref},$index,$len) = $data;
$index += $retlen;
$len -= $retlen;
}
$pdl->upd_data();
return $pdl;
}
=head2 gluefraw
=for ref
Append a single data item to an existing binary file written by
L</writefraw>. Error if dims not compatible with existing data.
=for usage
gluefraw($file, $pdl[, $opts]);
=cut
sub PDL::gluefraw {
my $usage = 'Usage: gluefraw($pdl,"filename"[,$opts])';
my ($pdl,$name,$opts) = @_;
barf $usage if @_ < 2 or @_ > 3 or !UNIVERSAL::isa($pdl, 'PDL') or ref $name;
barf "'$name' must be real filename: $!" if !-f $name;
$opts ||= {};
my $hdr = _read_frawhdr($name,$opts);
barf "gluefraw: ndarray has type '@{[$pdl->type]}' but file has type '$hdr->{T
ype}'"
if $pdl->type != PDL::Type->new($hdr->{Type});
my @dims = ref $hdr->{Dims} ? @{$hdr->{Dims}} : $hdr->{Dims};
barf "gluefraw: header dims needs at least 2 dims, got (@dims)" if @dims < 2;
my @ldims = @dims[0..$#dims-1];
barf "gluefraw: incompatible lower dims, ndarray (@{[$pdl->dims]}) vs header (
@ldims)"
if !PDL::all($pdl->shape == pdl(@ldims));
open my $d, '>>', $name or barf "Couldn't open '$name' for appending: $!";
binmode $d;
print $d ${$pdl->get_dataref};
$dims[-1]++;
$hdr->{Dims} = \@dims;
_writefrawhdr($pdl, $name, { %$opts, %$hdr });
}
=head2 mapfraw =head2 mapfraw
=for ref =for ref
Memory map a raw format binary file (see the module docs also) Memory map a raw format binary file (see the module docs also)
=for usage =for usage
$pdl3 = mapfraw("fname2",{ReadOnly => 1}); $pdl3 = mapfraw("fname2",{ReadOnly => 1});
skipping to change at line 266 skipping to change at line 387
=item ReadOnly =item ReadOnly
Disallow writing to the file. Disallow writing to the file.
=item Header =item Header
Specify the header file name. Specify the header file name.
=back =back
=cut
sub PDL::mapfraw {
my $class = shift;
my($name,$opts) = @_;
my $hdr;
if($opts->{Dims}) {
$hdr->{Type} = $opts->{Datatype} // double->enum;
$hdr->{Dims} = $opts->{Dims};
$hdr->{NDims} = scalar(@{$opts->{Dims}});
} else {
$hdr = _read_frawhdr($name,$opts);
}
my $s = PDL::Core::howbig($hdr->{Type});
for(@{$hdr->{Dims}}) {
$s *= $_;
}
my $pdl = $class->zeroes(PDL::Type->new($hdr->{Type}));
$pdl->set_data_by_file_map(
$name,
$s,
1,
($opts->{ReadOnly}?0:1),
($opts->{Creat}?1:0),
(0644),
($opts->{Creat} || $opts->{Trunc} ? 1:0)
);
$pdl->setdims($hdr->{Dims});
_writefrawhdr($pdl,$name,$opts) if $opts->{Creat};
$pdl;
}
=head2 maptextfraw =head2 maptextfraw
=for ref =for ref
Memory map a text file (see the module docs also). Memory map a text file (see the module docs also).
Note that this function maps the raw format so if you are Note that this function maps the raw format so if you are
using an operating system which does strange things to e.g. using an operating system which does strange things to e.g.
line delimiters upon reading a text file, you get the raw (binary) line delimiters upon reading a text file, you get the raw (binary)
representation. representation.
skipping to change at line 292 skipping to change at line 445
=for usage =for usage
$pdl4 = maptextfraw("fname", {options} $pdl4 = maptextfraw("fname", {options}
=for options =for options
The options other than Dims, Datatype of C<mapfraw> are The options other than Dims, Datatype of C<mapfraw> are
supported. supported.
=cut
sub PDL::maptextfraw {
my($class, $name, $opts) = @_;
$opts = {%$opts}; # Copy just in case
my @s = stat $name;
$opts->{Dims} = [$s[7]];
$opts->{Datatype} = &PDL::byte;
return PDL::mapfraw($class, $name, $opts);
}
=head1 BUGS =head1 BUGS
Should be documented better. C<writefraw> and C<readfraw> should Should be documented better. C<writefraw> and C<readfraw> should
also have options (the author nowadays only uses C<mapfraw> ;) also have options (the author nowadays only uses C<mapfraw> ;)
=head1 AUTHOR =head1 AUTHOR
Copyright (C) Tuomas J. Lukka 1997. Copyright (C) Tuomas J. Lukka 1997.
All rights reserved. There is no warranty. You are allowed All rights reserved. There is no warranty. You are allowed
to redistribute this software / documentation under certain to redistribute this software / documentation under certain
conditions. For details, see the file COPYING in the PDL conditions. For details, see the file COPYING in the PDL
distribution. If this file is separated from the PDL distribution, distribution. If this file is separated from the PDL distribution,
the copyright notice should be included in the file. the copyright notice should be included in the file.
=cut =cut
package PDL::IO::FastRaw;
use strict;
use warnings;
our $VERSION = '0.000003';
$VERSION = eval $VERSION;
require Exporter;
use PDL::Core '';
use PDL::Exporter;
our @ISA = qw/PDL::Exporter/;
our @EXPORT_OK = qw/writefraw readfraw mapfraw maptextfraw/;
our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
# Exported functions
*writefraw = \&PDL::writefraw;
sub readfraw {PDL->readfraw(@_)}
sub mapfraw {PDL->mapfraw(@_)}
sub maptextfraw {PDL->maptextfraw(@_)}
sub _read_frawhdr {
my($name,$opts) = @_;
my $hname = $opts->{Header} || "$name.hdr";
open my $h, '<', $hname
or barf "Couldn't open '$hname' for reading: $!";
chomp(my $tid = <$h>);
chomp(my $ndims = <$h>);
chomp(my $str = <$h>); if(!defined $str) {barf("Format error in '$hname'"
);}
my @dims = split ' ',$str;
if($#dims != $ndims-1) {
barf("Format error reading fraw header file '$hname'");
}
return {
Type => $tid,
Dims => \@dims,
NDims => $ndims
};
}
sub _writefrawhdr {
my($pdl,$name,$opts) = @_;
my $hname = $opts->{Header} || "$name.hdr";
open my $h, '>', $hname
or barf "Couldn't open '$hname' for writing: $!";
print $h map {"$_\n"} ($pdl->get_datatype,
$pdl->getndims, (join ' ',$pdl->dims));
}
sub PDL::writefraw {
my($pdl,$name,$opts) = @_;
_writefrawhdr($pdl,$name,$opts);
open my $d, '>', $name
or barf "Couldn't open '$name' for writing: $!";
binmode $d;
print $d ${$pdl->get_dataref};
}
sub PDL::readfraw {
my $class = shift;
my($name,$opts) = @_;
open my $d, '<', $name or barf "Couldn't open '$name' for reading: $!";
binmode $d;
my $hdr = _read_frawhdr($name,$opts);
my $pdl = $class->zeroes(PDL::Type->new($hdr->{Type}), @{$hdr->{Dims}});
my $len = length ${$pdl->get_dataref};
my $index = 0;
my $data;
my $retlen;
while (($retlen = sysread $d, $data, $len) != 0) {
substr(${$pdl->get_dataref},$index,$len) = $data;
$index += $retlen;
$len -= $retlen;
}
$pdl->upd_data();
return $pdl;
}
sub PDL::mapfraw {
my $class = shift;
my($name,$opts) = @_;
my $hdr;
if($opts->{Dims}) {
$hdr->{Type} = $opts->{Datatype} // double->enum;
$hdr->{Dims} = $opts->{Dims};
$hdr->{NDims} = scalar(@{$opts->{Dims}});
} else {
$hdr = _read_frawhdr($name,$opts);
}
my $s = PDL::Core::howbig($hdr->{Type});
for(@{$hdr->{Dims}}) {
$s *= $_;
}
my $pdl = $class->zeroes(PDL::Type->new($hdr->{Type}));
$pdl->set_data_by_file_map(
$name,
$s,
1,
($opts->{ReadOnly}?0:1),
($opts->{Creat}?1:0),
(0644),
($opts->{Creat} || $opts->{Trunc} ? 1:0)
);
$pdl->setdims($hdr->{Dims});
_writefrawhdr($pdl,$name,$opts) if $opts->{Creat};
$pdl;
}
sub PDL::maptextfraw {
my($class, $name, $opts) = @_;
$opts = {%$opts}; # Copy just in case
my @s = stat $name;
$opts->{Dims} = [$s[7]];
$opts->{Datatype} = &PDL::byte;
return PDL::mapfraw($class, $name, $opts);
}
1; 1;
 End of changes. 14 change blocks. 
134 lines changed or deleted 182 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)