~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to IO/FastRaw/FastRaw.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
=head1 NAME
 
2
 
 
3
PDL::IO::FastRaw -- A simple, fast and convenient io format for PerlDL.
 
4
 
 
5
=head1 SYNOPSIS
 
6
 
 
7
 use PDL;
 
8
 use PDL::IO::FastRaw;
 
9
 
 
10
 writefraw($pdl,"fname");         # write a raw file
 
11
 
 
12
 $pdl2 = readfraw("fname");       # read a raw file
 
13
 $pdl2 = PDL->readfraw("fname");
 
14
 
 
15
 $pdl3 = mapfraw("fname2",{ReadOnly => 1}); # mmap a file, don't read yet
 
16
 
 
17
 $pdl4 = maptextfraw("fname3",{...}); # map a text file into a 1-D pdl.
 
18
 
 
19
 
 
20
=head1 DESCRIPTION
 
21
 
 
22
This is a very simple and fast io format for PerlDL.
 
23
The disk data consists of two files, a header metadata file
 
24
in ASCII and a binary file consisting simply of consecutive
 
25
bytes, shorts or whatever.
 
26
 
 
27
It is hoped that this will not only make for a simple PerlDL module
 
28
for saving and retrieving these files but also make it easy
 
29
for other programs to use these files.
 
30
 
 
31
The format of the ASCII header is simply
 
32
 
 
33
        <typeid>
 
34
        <ndims>
 
35
        <dim0> <dim1> ...
 
36
 
 
37
The binary files are in general
 
38
NOT interchangeable between different architectures since the binary
 
39
file is simply dumped from the memory region of the piddle.
 
40
This is what makes the approach efficient.
 
41
 
 
42
It is also possible to mmap the file which can give a large
 
43
speedup in certain situations as well as save a lot of memory
 
44
by using a disk file as virtual memory. When a file is mapped,
 
45
parts of it are read only as they are accessed in the memory
 
46
(or as the kernel decides: if you are reading the pages in order,
 
47
it may well preread some for you).
 
48
 
 
49
Note that memory savings and copy-on-write are operating-system
 
50
dependent - see Core.xs and your operating system documentation
 
51
for exact semantics of whatever. Basically, if you write to a
 
52
mmapped file without C<ReadOnly>, the change will be reflected
 
53
in the file immediately. C<ReadOnly> doesn't really make it impossible
 
54
to write to the piddle but maps the memory privately so the file
 
55
will not be changed when you change the piddle. Be aware though
 
56
that mmapping a 40Mb file without C<ReadOnly> spends no virtual
 
57
memory but with C<ReadOnly> it does reserve 40Mb.
 
58
 
 
59
=head1 FUNCTIONS
 
60
 
 
61
=head2 readfraw
 
62
 
 
63
=for ref
 
64
 
 
65
Read a raw format binary file
 
66
 
 
67
=for usage
 
68
 
 
69
 $pdl2 = readfraw("fname");
 
70
 $pdl2 = PDL->readfraw("fname");
 
71
 
 
72
 
 
73
=head2 writefraw
 
74
 
 
75
=for ref
 
76
 
 
77
Write a raw format binary file
 
78
 
 
79
=for usage
 
80
 
 
81
 writefraw($pdl,"fname");
 
82
 
 
83
 
 
84
=head2 mapfraw
 
85
 
 
86
=for ref
 
87
 
 
88
Memory map a raw format binary file (see the module docs also)
 
89
 
 
90
=for usage
 
91
 
 
92
 $pdl3 = mapfraw("fname2",{ReadOnly => 1});
 
93
 
 
94
=for options
 
95
 
 
96
The C<mapfraw> command
 
97
supports the following options (not all combinations make sense):
 
98
 
 
99
=over 8
 
100
 
 
101
=item Dims, Datatype
 
102
 
 
103
If creating a new file or if you want to specify your own header
 
104
data for the file, you can give an array reference and a scalar,
 
105
respectively.
 
106
 
 
107
=item Creat
 
108
 
 
109
Create the file. Also writes out a header for the file.
 
110
 
 
111
=item Trunc
 
112
 
 
113
Set the file size. Automatically enabled with C<Creat>. NOTE: This also
 
114
clears the file to all zeroes.
 
115
 
 
116
=item ReadOnly
 
117
 
 
118
Disallow writing to the file.
 
119
 
 
120
=back
 
121
 
 
122
=head2 maptextfraw
 
123
 
 
124
=for ref
 
125
 
 
126
Memory map a text file (see the module docs also).
 
127
 
 
128
Note that this function maps the raw format so if you are
 
129
using an operating system which does strange things to e.g.
 
130
line delimiters upon reading a text file, you get the raw (binary)
 
131
representation.
 
132
 
 
133
The file doesn't really need to be text but it is just mapped
 
134
as one large binary chunk.
 
135
 
 
136
This function is just a convenience wrapper which firsts C<stat>s
 
137
the file and sets the dimensions and datatype.
 
138
 
 
139
=for usage
 
140
 
 
141
 $pdl4 = maptextfraw("fname", {options}
 
142
 
 
143
=for options
 
144
 
 
145
The options other than Dims, Datatype of C<mapfraw> are
 
146
supported.
 
147
 
 
148
=head1 BUGS
 
149
 
 
150
Should be documented better. C<writefraw> and C<readfraw> should
 
151
also have options (the author nowadays only uses C<mapfraw> ;)
 
152
 
 
153
=head1 AUTHOR
 
154
 
 
155
Copyright (C) Tuomas J. Lukka 1997.
 
156
All rights reserved. There is no warranty. You are allowed
 
157
to redistribute this software / documentation under certain
 
158
conditions. For details, see the file COPYING in the PDL
 
159
distribution. If this file is separated from the PDL distribution,
 
160
the copyright notice should be included in the file.
 
161
 
 
162
 
 
163
=cut
 
164
 
 
165
package PDL::IO::FastRaw;
 
166
 
 
167
require Exporter;
 
168
use PDL::Core '';
 
169
use PDL::Exporter;
 
170
use FileHandle;
 
171
 
 
172
@PDL::IO::FastRaw::ISA = qw/PDL::Exporter/;
 
173
 
 
174
@EXPORT_OK = qw/writefraw readfraw mapfraw maptextfraw/;
 
175
%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
 
176
 
 
177
# Exported functions
 
178
 
 
179
*writefraw = \&PDL::writefraw;
 
180
sub readfraw {PDL->readfraw(@_)}
 
181
sub mapfraw  {PDL->mapfraw(@_)}
 
182
sub maptextfraw  {PDL->maptextfraw(@_)}
 
183
 
 
184
sub _read_frawhdr {
 
185
        my($name) = @_;
 
186
        my $hname = "$name.hdr";
 
187
        my $h = new FileHandle "$hname"
 
188
         or barf "Couldn't open '$hname' for reading";
 
189
        my $tid = <$h>;
 
190
        my $ndims = <$h>;
 
191
        my $str = <$h>; if(!defined $str) {barf("Format error in '$hname'");}
 
192
        my @dims = split ' ',$str;
 
193
        if($#dims != $ndims-1) {
 
194
                barf("Format error reading fraw header file '$hname'");
 
195
        }
 
196
        return {
 
197
                Type => $tid,
 
198
                Dims => \@dims,
 
199
                NDims => $ndims
 
200
        };
 
201
}
 
202
 
 
203
sub _writefrawhdr {
 
204
        my($pdl,$name) = @_;
 
205
        my $hname = "$name.hdr";
 
206
        my $h = new FileHandle ">$hname"
 
207
         or barf "Couldn't open '$hname' for writing";
 
208
        print $h map {"$_\n"} ($pdl->get_datatype,
 
209
                $pdl->getndims, (join ' ',$pdl->dims));
 
210
}
 
211
 
 
212
sub PDL::writefraw {
 
213
        my($pdl,$name,$opts) = @_;
 
214
        _writefrawhdr($pdl,$name);
 
215
        my $d = new FileHandle ">$name"
 
216
         or barf "Couldn't open '$name' for writing";
 
217
        binmode $d;
 
218
        print $d ${$pdl->get_dataref};
 
219
}
 
220
 
 
221
sub PDL::readfraw {
 
222
        my $class = shift;
 
223
        my($name,$opts) = @_;
 
224
        my $d = new FileHandle "$name"
 
225
         or barf "Couldn't open '$name' for reading";
 
226
        binmode $d;
 
227
        my $hdr = _read_frawhdr($name);
 
228
        my $pdl = $class->zeroes ((new PDL::Type($hdr->{Type})), @{$hdr->{Dims}});
 
229
        my $len = length ${$pdl->get_dataref};
 
230
# wrong.
 
231
#       $d->sysread(${$pdl->get_dataref},$len) == $len
 
232
#         or barf "Couldn't read enough data from '$name'";
 
233
        my $index = 0;
 
234
        my $data;
 
235
        my $retlen;
 
236
        while (($retlen = $d->sysread($data, $len)) != 0) {
 
237
                substr(${$pdl->get_dataref},$index,$len) = $data;
 
238
                $index += $retlen;
 
239
               $len -= $retlen;
 
240
        }
 
241
        $pdl->upd_data();
 
242
        return $pdl;
 
243
}
 
244
 
 
245
sub PDL::mapfraw {
 
246
        my $class = shift;
 
247
        my($name,$opts) = @_;
 
248
        my $hdr;
 
249
        if($opts->{Dims}) {
 
250
                my $datatype = $opts->{Datatype};
 
251
                if(!defined $datatype) {$datatype = $PDL_D;}
 
252
                $hdr->{Type} = $datatype;
 
253
                $hdr->{Dims} = $opts->{Dims};
 
254
                $hdr->{NDims} = scalar(@{$opts->{Dims}});
 
255
        } else {
 
256
                $hdr = _read_frawhdr($name);
 
257
        }
 
258
        $s = PDL::Core::howbig($hdr->{Type});
 
259
        for(@{$hdr->{Dims}}) {
 
260
                $s *= $_;
 
261
        }
 
262
        my $pdl = $class->zeroes(new PDL::Type($hdr->{Type}));
 
263
#       $pdl->dump();
 
264
        $pdl->setdims($hdr->{Dims});
 
265
#       $pdl->dump();
 
266
        $pdl->set_data_by_mmap($name,$s,1,($opts->{ReadOnly}?0:1),
 
267
                ($opts->{Creat}?1:0),
 
268
                (0644),
 
269
                ($opts->{Creat} || $opts->{Trunc} ? 1:0));
 
270
#       $pdl->dump();
 
271
        if($opts->{Creat}) {
 
272
                _writefrawhdr($pdl,$name);
 
273
        }
 
274
        return $pdl;
 
275
}
 
276
 
 
277
sub PDL::maptextfraw {
 
278
        my($class, $name, $opts) = @_;
 
279
        $opts = {%$opts}; # Copy just in case
 
280
        my @s = stat $name;
 
281
        $opts->{Dims} = [$s[7]];
 
282
        $opts->{Datatype} = &PDL::byte;
 
283
        return PDL::mapfraw($class, $name, $opts);
 
284
}
 
285
 
 
286
1;