line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Paranoid::IO::FileMultiplexer::Block::FileHeader -- File Header Block |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# $Id: lib/Paranoid/IO/FileMultiplexer/Block/FileHeader.pm, 2.09 2021/12/28 15:46:49 acorliss Exp $ |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# This software is free software. Similar to Perl, you can redistribute it |
6
|
|
|
|
|
|
|
# and/or modify it under the terms of either: |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# a) the GNU General Public License |
9
|
|
|
|
|
|
|
# as published by the |
10
|
|
|
|
|
|
|
# Free Software Foundation ; either version 1 |
11
|
|
|
|
|
|
|
# , or any later version |
12
|
|
|
|
|
|
|
# , or |
13
|
|
|
|
|
|
|
# b) the Artistic License 2.0 |
14
|
|
|
|
|
|
|
# , |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# subject to the following additional term: No trademark rights to |
17
|
|
|
|
|
|
|
# "Paranoid" have been or are conveyed under any of the above licenses. |
18
|
|
|
|
|
|
|
# However, "Paranoid" may be used fairly to describe this unmodified |
19
|
|
|
|
|
|
|
# software, in good faith, but not as a trademark. |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# (c) 2005 - 2021, Arthur Corliss (corliss@digitalmages.com) |
22
|
|
|
|
|
|
|
# (tm) 2008 - 2021, Paranoid Inc. (www.paranoid.com) |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
##################################################################### |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
##################################################################### |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# Environment definitions |
29
|
|
|
|
|
|
|
# |
30
|
|
|
|
|
|
|
##################################################################### |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
package Paranoid::IO::FileMultiplexer::Block::FileHeader; |
33
|
|
|
|
|
|
|
|
34
|
11
|
|
|
11
|
|
253
|
use 5.008; |
|
11
|
|
|
|
|
44
|
|
35
|
|
|
|
|
|
|
|
36
|
11
|
|
|
11
|
|
77
|
use strict; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
220
|
|
37
|
11
|
|
|
11
|
|
55
|
use warnings; |
|
11
|
|
|
|
|
11
|
|
|
11
|
|
|
|
|
297
|
|
38
|
11
|
|
|
11
|
|
55
|
use vars qw($VERSION); |
|
11
|
|
|
|
|
11
|
|
|
11
|
|
|
|
|
693
|
|
39
|
11
|
|
|
11
|
|
77
|
use base qw(Exporter); |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
891
|
|
40
|
11
|
|
|
11
|
|
77
|
use Paranoid; |
|
11
|
|
|
|
|
11
|
|
|
11
|
|
|
|
|
627
|
|
41
|
11
|
|
|
11
|
|
77
|
use Paranoid::IO qw(:all); |
|
11
|
|
|
|
|
11
|
|
|
11
|
|
|
|
|
2508
|
|
42
|
11
|
|
|
11
|
|
88
|
use Paranoid::Debug qw(:all); |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
1815
|
|
43
|
11
|
|
|
11
|
|
88
|
use Fcntl qw(:DEFAULT :flock :mode :seek); |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
5192
|
|
44
|
11
|
|
|
11
|
|
6017
|
use Paranoid::IO::FileMultiplexer::Block; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
561
|
|
45
|
11
|
|
|
11
|
|
5588
|
use Paranoid::IO::FileMultiplexer::Block::StreamHeader; |
|
11
|
|
|
|
|
33
|
|
|
11
|
|
|
|
|
561
|
|
46
|
11
|
|
|
11
|
|
5808
|
use Paranoid::IO::FileMultiplexer::Block::BATHeader; |
|
11
|
|
|
|
|
33
|
|
|
11
|
|
|
|
|
946
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
($VERSION) = ( q$Revision: 2.09 $ =~ /(\d+(?:\.\d+)+)/sm ); |
49
|
|
|
|
|
|
|
|
50
|
11
|
|
|
11
|
|
77
|
use base qw(Paranoid::IO::FileMultiplexer::Block); |
|
11
|
|
|
|
|
121
|
|
|
11
|
|
|
|
|
869
|
|
51
|
|
|
|
|
|
|
|
52
|
11
|
|
|
11
|
|
66
|
use constant PIOFMVER => '1.0'; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
583
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Signature format: |
55
|
|
|
|
|
|
|
# PIOFM VER BS BC |
56
|
|
|
|
|
|
|
# Z6 Z4 NNx NNx |
57
|
|
|
|
|
|
|
# 28 bytes |
58
|
|
|
|
|
|
|
# |
59
|
|
|
|
|
|
|
# Stream record format: |
60
|
|
|
|
|
|
|
# String BN |
61
|
|
|
|
|
|
|
# Z21 NNx |
62
|
|
|
|
|
|
|
# 30 bytes |
63
|
11
|
|
|
11
|
|
66
|
use constant SIGNATURE => 'Z6Z4NNxNNx'; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
462
|
|
64
|
11
|
|
|
11
|
|
66
|
use constant SIG_LEN => 28; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
748
|
|
65
|
11
|
|
|
11
|
|
66
|
use constant SIG_TYPE => 'PIOFM'; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
462
|
|
66
|
11
|
|
|
11
|
|
66
|
use constant BLOCKS_POS => 10; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
451
|
|
67
|
11
|
|
|
11
|
|
55
|
use constant BLOCKC_POS => 19; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
594
|
|
68
|
11
|
|
|
11
|
|
77
|
use constant STREAMS_POS => 28; |
|
11
|
|
|
|
|
11
|
|
|
11
|
|
|
|
|
649
|
|
69
|
11
|
|
|
11
|
|
121
|
use constant STRMIDX => 'Z21NNx'; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
627
|
|
70
|
11
|
|
|
11
|
|
77
|
use constant STRM_LEN => 30; |
|
11
|
|
|
|
|
22
|
|
|
11
|
|
|
|
|
26257
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
##################################################################### |
73
|
|
|
|
|
|
|
# |
74
|
|
|
|
|
|
|
# Module code follows |
75
|
|
|
|
|
|
|
# |
76
|
|
|
|
|
|
|
##################################################################### |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub new { |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Purpose: Creates a new file header object |
81
|
|
|
|
|
|
|
# Returns: Object reference/undef |
82
|
|
|
|
|
|
|
# Usage: $obj = |
83
|
|
|
|
|
|
|
# Paranoid::IO::FileMultiplexer::Block::FileHeader->new($file, $blockSize); |
84
|
|
|
|
|
|
|
|
85
|
338
|
|
|
338
|
1
|
744
|
my $class = shift; |
86
|
338
|
|
|
|
|
591
|
my $file = shift; |
87
|
338
|
|
|
|
|
650
|
my $bsize = shift; |
88
|
338
|
|
|
|
|
502
|
my $self; |
89
|
|
|
|
|
|
|
|
90
|
338
|
|
|
|
|
1000
|
pdebug( 'entering w/(%s)(%s)', PDLEVEL3, $file, $bsize ); |
91
|
338
|
|
|
|
|
999
|
pIn(); |
92
|
|
|
|
|
|
|
|
93
|
338
|
|
|
|
|
1322
|
$self = __PACKAGE__->SUPER::new( $file, 0, $bsize ); |
94
|
|
|
|
|
|
|
|
95
|
338
|
100
|
|
|
|
880
|
if ( defined $self ) { |
96
|
239
|
|
|
|
|
609
|
$$self{version} = PIOFMVER; |
97
|
239
|
|
|
|
|
637
|
$$self{blocks} = 1; |
98
|
239
|
|
|
|
|
796
|
$$self{streamidx} = {}; # name => idx of rec in streams |
99
|
239
|
|
|
|
|
573
|
$$self{streams} = []; # array of [ name, blockNum ] |
100
|
239
|
|
|
|
|
1061
|
$$self{maxStreams} = int( ( $bsize - SIG_LEN ) / STRM_LEN ); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
338
|
|
|
|
|
1049
|
pOut(); |
104
|
338
|
|
|
|
|
913
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $self ); |
105
|
|
|
|
|
|
|
|
106
|
338
|
|
|
|
|
960
|
return $self; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub blocks { |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Purpose: Returns the number of blocks recorded in the signature |
112
|
|
|
|
|
|
|
# Returns: Integer |
113
|
|
|
|
|
|
|
# Usage: $count = $obj->blocks; |
114
|
|
|
|
|
|
|
|
115
|
279
|
|
|
279
|
1
|
570
|
my $self = shift; |
116
|
279
|
|
|
|
|
1084
|
return $$self{blocks}; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub version { |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# Purpose: Returns the version of the file format |
122
|
|
|
|
|
|
|
# Returns: String |
123
|
|
|
|
|
|
|
# Usage: $ver = $obj->version; |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
126
|
0
|
|
|
|
|
0
|
return $$self{version}; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub streams { |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Purpose: Returns a hash of stream names => blockNums |
132
|
|
|
|
|
|
|
# Returns: Hash |
133
|
|
|
|
|
|
|
# Usage: %streams = $obj->streams; |
134
|
|
|
|
|
|
|
|
135
|
100
|
|
|
100
|
1
|
374
|
my $self = shift; |
136
|
100
|
|
|
|
|
15276
|
my @streams = @{ $$self{streams} }; |
|
100
|
|
|
|
|
502
|
|
137
|
100
|
|
|
|
|
278
|
my ( %rv, $stream ); |
138
|
|
|
|
|
|
|
|
139
|
100
|
|
|
|
|
334
|
foreach $stream (@streams) { |
140
|
167
|
|
|
|
|
653
|
$rv{ $$stream[0] } = $$stream[1]; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
100
|
|
|
|
|
642
|
return %rv; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub maxStreams { |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Purpose: Returns the maximum number of streams supported by this file |
149
|
|
|
|
|
|
|
# Returns: Integer |
150
|
|
|
|
|
|
|
# Usage: $max = $obj->maxStreams; |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
0
|
return $$self{maxStreams}; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub _transHuman { |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Purpose: Translates raw integers into human-readable values |
160
|
|
|
|
|
|
|
# Returns: String |
161
|
|
|
|
|
|
|
# Usage: $rv = _transHuman($n); |
162
|
|
|
|
|
|
|
|
163
|
222
|
|
|
222
|
|
428
|
my $n = shift; |
164
|
222
|
|
|
|
|
751
|
my $u = 'B'; |
165
|
|
|
|
|
|
|
|
166
|
222
|
|
|
|
|
674
|
while ( $n > 1024 ) { |
167
|
721
|
100
|
|
|
|
2060
|
$u = |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
168
|
|
|
|
|
|
|
$u eq 'B' ? 'KB' |
169
|
|
|
|
|
|
|
: $u eq 'KB' ? 'MB' |
170
|
|
|
|
|
|
|
: $u eq 'MB' ? 'GB' |
171
|
|
|
|
|
|
|
: $u eq 'GB' ? 'TB' |
172
|
|
|
|
|
|
|
: $u eq 'TB' ? 'PB' |
173
|
|
|
|
|
|
|
: 'EX'; |
174
|
721
|
|
|
|
|
1528
|
$n /= 1024; |
175
|
721
|
100
|
|
|
|
2254
|
last if $u eq 'EX'; |
176
|
|
|
|
|
|
|
} |
177
|
222
|
|
|
|
|
1885
|
$n = sprintf( '%0.2f', $n ); |
178
|
|
|
|
|
|
|
|
179
|
222
|
|
|
|
|
1157
|
return "$n$u"; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub model { |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Purpose: Returns a hash of file statistics |
185
|
|
|
|
|
|
|
# Returns: Hash |
186
|
|
|
|
|
|
|
# Usage: $stats = $obj->model; |
187
|
|
|
|
|
|
|
|
188
|
74
|
|
|
74
|
1
|
205
|
my $self = shift; |
189
|
74
|
|
|
|
|
221
|
my $bs = $$self{blockSize}; |
190
|
74
|
|
|
|
|
233
|
my $blks = $$self{blocks}; |
191
|
74
|
|
|
|
|
148
|
my $strms = scalar keys %{ $$self{streamidx} }; |
|
74
|
|
|
|
|
330
|
|
192
|
74
|
|
|
|
|
216
|
my ( $block, $maxBATs, $maxData, %rv ); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# Get reference max values |
195
|
|
|
|
|
|
|
$block = |
196
|
|
|
|
|
|
|
Paranoid::IO::FileMultiplexer::Block::StreamHeader->new( $$self{file}, |
197
|
74
|
|
|
|
|
724
|
1, $bs, 'foo' ); |
198
|
74
|
|
|
|
|
364
|
$maxBATs = $block->maxBATs; |
199
|
|
|
|
|
|
|
$block = |
200
|
74
|
|
|
|
|
934
|
Paranoid::IO::FileMultiplexer::Block::BATHeader->new( $$self{file}, 1, |
201
|
|
|
|
|
|
|
$bs, 'foo', 0 ); |
202
|
74
|
|
|
|
|
279
|
$maxData = $block->maxData; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
# Current stats |
205
|
74
|
|
|
|
|
380
|
$rv{intSize} = ( 1 << 32 ) == 1 ? 32 : 64; |
206
|
74
|
|
|
|
|
235
|
$rv{curFileSize} = $bs * $blks; |
207
|
74
|
|
|
|
|
320
|
$rv{curFSHuman} = _transHuman( $rv{curFileSize} ); |
208
|
74
|
|
|
|
|
196
|
$rv{curStreams} = $strms; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# Predicted max |
211
|
74
|
|
|
|
|
192
|
$rv{maxFileSize} = 0b11111111_11111111_11111111_11111111; |
212
|
|
|
|
|
|
|
$rv{maxFileSize} = $rv{maxFileSize} | ( $rv{maxFileSize} << 32 ) |
213
|
74
|
50
|
|
|
|
480
|
if $rv{intSize} == 64; |
214
|
74
|
|
|
|
|
302
|
$rv{maxStreams} = $$self{maxStreams}; |
215
|
74
|
|
|
|
|
321
|
$rv{maxStreamSize} = $bs * $maxBATs * $maxData; |
216
|
|
|
|
|
|
|
$rv{maxStreamSize} = $rv{maxFileSize} |
217
|
74
|
50
|
|
|
|
292
|
if $rv{maxStreamSize} > $rv{maxFileSize}; |
218
|
74
|
|
|
|
|
246
|
$rv{maxSSHuman} = _transHuman( $rv{maxStreamSize} ); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Provide human-readable values |
221
|
74
|
|
|
|
|
270
|
$rv{maxFSHuman} = _transHuman( $rv{maxFileSize} ); |
222
|
|
|
|
|
|
|
|
223
|
74
|
|
|
|
|
1362
|
return %rv; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub writeSig { |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Purpose: Writes the file signature to the file |
229
|
|
|
|
|
|
|
# Returns: Boolean |
230
|
|
|
|
|
|
|
# Usage: $rv = $obj->writeSig; |
231
|
|
|
|
|
|
|
|
232
|
99
|
|
|
99
|
1
|
198
|
my $self = shift; |
233
|
99
|
|
|
|
|
209
|
my $file = $$self{file}; |
234
|
99
|
|
|
|
|
231
|
my $ver = $$self{version}; |
235
|
99
|
|
|
|
|
176
|
my $rv = 0; |
236
|
|
|
|
|
|
|
my $sig = pack SIGNATURE, SIG_TYPE, PIOFMVER, |
237
|
|
|
|
|
|
|
$self->splitInt( $$self{blockSize} ), |
238
|
99
|
|
|
|
|
495
|
$self->splitInt( $$self{blocks} ); |
239
|
|
|
|
|
|
|
|
240
|
99
|
|
|
|
|
374
|
pdebug( 'entering', PDLEVEL3 ); |
241
|
99
|
|
|
|
|
319
|
pIn(); |
242
|
|
|
|
|
|
|
|
243
|
99
|
|
|
|
|
374
|
$rv = $self->bwrite($sig); |
244
|
|
|
|
|
|
|
|
245
|
99
|
|
|
|
|
341
|
pOut(); |
246
|
99
|
|
|
|
|
341
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
247
|
|
|
|
|
|
|
|
248
|
99
|
|
|
|
|
385
|
return $rv; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub readSig { |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Purpose: Reads the block signature from the file |
254
|
|
|
|
|
|
|
# Returns: Boolean |
255
|
|
|
|
|
|
|
# Usage: $rv = $obj->readSig; |
256
|
|
|
|
|
|
|
|
257
|
129
|
|
|
129
|
1
|
317
|
my $self = shift; |
258
|
129
|
|
|
|
|
257
|
my $file = $$self{file}; |
259
|
129
|
|
|
|
|
284
|
my $rv = 0; |
260
|
129
|
|
|
|
|
388
|
my ( $raw, $type, $ver, $bs, $bc, $tblock ); |
261
|
129
|
|
|
|
|
0
|
my ( $lbs, $ubs, $lbc, $ubc ); |
262
|
|
|
|
|
|
|
|
263
|
129
|
|
|
|
|
407
|
pdebug( 'entering', PDLEVEL3 ); |
264
|
129
|
|
|
|
|
427
|
pIn(); |
265
|
|
|
|
|
|
|
|
266
|
129
|
50
|
|
|
|
384
|
if ( pflock( $file, LOCK_SH ) ) { |
267
|
129
|
50
|
|
|
|
672
|
if ( $self->bread( \$raw, 0, SIG_LEN ) == SIG_LEN ) { |
268
|
129
|
|
|
|
|
394
|
$rv = 1; |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Unpack the signature |
271
|
129
|
|
|
|
|
1554
|
( $type, $ver, $lbs, $ubs, $lbc, $ubc ) = unpack SIGNATURE, $raw; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# Validate contents |
274
|
|
|
|
|
|
|
# |
275
|
|
|
|
|
|
|
# Start with file type |
276
|
129
|
50
|
|
|
|
676
|
unless ( $type eq SIG_TYPE ) { |
277
|
0
|
|
|
|
|
0
|
$rv = 0; |
278
|
0
|
|
|
|
|
0
|
pdebug( 'Invalid file header type (%s)', PDLEVEL1, $type ); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# format version |
282
|
129
|
50
|
|
|
|
460
|
unless ( $ver eq PIOFMVER ) { |
283
|
0
|
|
|
|
|
0
|
$rv = 0; |
284
|
0
|
|
|
|
|
0
|
pdebug( 'Invalid file header version (%s)', PDLEVEL1, $ver ); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# Make sure block size is legitimate |
288
|
129
|
|
|
|
|
443
|
$bs = $self->joinInt( $lbs, $ubs ); |
289
|
129
|
50
|
|
|
|
397
|
if ( defined $bs ) { |
290
|
129
|
|
|
|
|
954
|
$tblock = __PACKAGE__->new( $file, $bs ); |
291
|
129
|
100
|
|
|
|
425
|
unless ( defined $tblock ) { |
292
|
22
|
|
|
|
|
55
|
$rv = 0; |
293
|
22
|
|
|
|
|
66
|
pdebug( 'blockSize error in file header: %s', |
294
|
|
|
|
|
|
|
PDLEVEL1, $bs ); |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} else { |
297
|
0
|
|
|
|
|
0
|
pdebug( |
298
|
|
|
|
|
|
|
'this platform does not support 64b values for block size', |
299
|
|
|
|
|
|
|
PDLEVEL1 |
300
|
|
|
|
|
|
|
); |
301
|
0
|
|
|
|
|
0
|
$rv = 0; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# Validate end of file matches block count |
305
|
129
|
|
|
|
|
396
|
$bc = $self->joinInt( $lbc, $ubc ); |
306
|
129
|
50
|
|
|
|
397
|
if ( defined $bc ) { |
307
|
129
|
|
|
|
|
512
|
pseek( $file, 0, SEEK_END ); |
308
|
129
|
100
|
|
|
|
468
|
unless ( ptell($file) == $bc * $bs ) { |
309
|
44
|
|
|
|
|
121
|
$rv = 0; |
310
|
44
|
|
|
|
|
143
|
pdebug( |
311
|
|
|
|
|
|
|
'incorrect file size based on block count (%s * %s = %s)', |
312
|
|
|
|
|
|
|
PDLEVEL1, $bc, $bs, $bc * $bs |
313
|
|
|
|
|
|
|
); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} else { |
316
|
0
|
|
|
|
|
0
|
pdebug( |
317
|
|
|
|
|
|
|
'this platform does not support 64b values for block count', |
318
|
|
|
|
|
|
|
PDLEVEL1 |
319
|
|
|
|
|
|
|
); |
320
|
0
|
|
|
|
|
0
|
$rv = 0; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Update internal values |
324
|
129
|
100
|
|
|
|
395
|
if ($rv) { |
325
|
85
|
|
|
|
|
309
|
$$self{version} = $ver; |
326
|
85
|
|
|
|
|
493
|
$$self{blockSize} = $bs; |
327
|
85
|
|
|
|
|
279
|
$$self{blocks} = $bc; |
328
|
85
|
|
|
|
|
466
|
$self->recalibrate; |
329
|
|
|
|
|
|
|
} else { |
330
|
44
|
|
|
|
|
121
|
pdebug( 'file signature verification failure', PDLEVEL1 ); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
} else { |
334
|
0
|
|
|
|
|
0
|
pdebug( 'failed to read file header signature', PDLEVEL1 ); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
129
|
|
|
|
|
406
|
pflock( $file, LOCK_UN ); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
129
|
|
|
|
|
394
|
pOut(); |
341
|
129
|
|
|
|
|
366
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
342
|
|
|
|
|
|
|
|
343
|
129
|
|
|
|
|
1545
|
return $rv; |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
sub writeBlocks { |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# Purpose: Updates the blocks counter and writes it to disk |
349
|
|
|
|
|
|
|
# Returns: Boolean |
350
|
|
|
|
|
|
|
# Usage: $rv = $obj->writeBlocks($count); |
351
|
|
|
|
|
|
|
|
352
|
257
|
|
|
257
|
1
|
583
|
my $self = shift; |
353
|
257
|
|
|
|
|
548
|
my $bcount = shift; |
354
|
257
|
|
|
|
|
516
|
my ( $raw, $rv ); |
355
|
|
|
|
|
|
|
|
356
|
257
|
|
|
|
|
849
|
pdebug( 'entering w/%s', PDLEVEL3, $bcount ); |
357
|
257
|
|
|
|
|
896
|
pIn(); |
358
|
|
|
|
|
|
|
|
359
|
257
|
50
|
33
|
|
|
1965
|
if ( defined $bcount and $bcount > 0 ) { |
360
|
257
|
|
|
|
|
1002
|
$raw = pack 'NN', $self->splitInt($bcount); |
361
|
257
|
50
|
|
|
|
1034
|
if ( $self->bwrite( $raw, BLOCKC_POS ) == 8 ) { |
362
|
257
|
|
|
|
|
860
|
$$self{blocks} = $bcount; |
363
|
257
|
|
|
|
|
548
|
$rv = 1; |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} else { |
366
|
0
|
|
|
|
|
0
|
pdebug( 'invalid value for blocks (%s)', PDLEVEL1, $bcount ); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
257
|
|
|
|
|
782
|
pOut(); |
370
|
257
|
|
|
|
|
793
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
371
|
|
|
|
|
|
|
|
372
|
257
|
|
|
|
|
1633
|
return $rv; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
sub readBlocks { |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# Purpose: Reads the blocks counter from disk |
378
|
|
|
|
|
|
|
# Returns: Integer/undef on error |
379
|
|
|
|
|
|
|
# Usage: $count = $obj->readBlocks; |
380
|
|
|
|
|
|
|
|
381
|
3003
|
|
|
3003
|
1
|
5554
|
my $self = shift; |
382
|
3003
|
|
|
|
|
5285
|
my ( $rv, $raw ); |
383
|
|
|
|
|
|
|
|
384
|
3003
|
|
|
|
|
8793
|
pdebug( 'entering', PDLEVEL3 ); |
385
|
3003
|
|
|
|
|
7361
|
pIn(); |
386
|
|
|
|
|
|
|
|
387
|
3003
|
50
|
|
|
|
11088
|
if ( $self->bread( \$raw, BLOCKC_POS, 8 ) == 8 ) { |
388
|
3003
|
|
|
|
|
18547
|
$rv = $self->joinInt( unpack 'NN', $raw ); |
389
|
3003
|
50
|
33
|
|
|
17635
|
$rv = '0 but true' if defined $rv and $rv == 0; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
3003
|
|
|
|
|
8957
|
pOut(); |
393
|
3003
|
|
|
|
|
7709
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
394
|
|
|
|
|
|
|
|
395
|
3003
|
|
|
|
|
13437
|
return $rv; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub incrBlocks { |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# Purpose: Increments the block count and writes the field to disk |
401
|
|
|
|
|
|
|
# Returns: Boolean |
402
|
|
|
|
|
|
|
# Usage: $rv = $obj->incrBlocks; |
403
|
|
|
|
|
|
|
|
404
|
191
|
|
|
191
|
1
|
449
|
my $self = shift; |
405
|
|
|
|
|
|
|
|
406
|
191
|
|
|
|
|
894
|
return $self->writeBlocks( $$self{blocks} + 1 ); |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub validateBlocks { |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Purpose: Compares in-memory block counter to what's stored in the file |
412
|
|
|
|
|
|
|
# Returns: Boolean |
413
|
|
|
|
|
|
|
# Usage: $rv = $obj->validateBlocks; |
414
|
|
|
|
|
|
|
|
415
|
2992
|
|
|
2992
|
1
|
5633
|
my $self = shift; |
416
|
2992
|
|
|
|
|
5413
|
my $rv = 0; |
417
|
|
|
|
|
|
|
|
418
|
2992
|
|
|
|
|
8001
|
pdebug( 'entering', PDLEVEL3 ); |
419
|
2992
|
|
|
|
|
8192
|
pIn(); |
420
|
|
|
|
|
|
|
|
421
|
2992
|
100
|
|
|
|
9970
|
$rv = 1 if $$self{blocks} == $self->readBlocks; |
422
|
|
|
|
|
|
|
|
423
|
2992
|
|
|
|
|
10113
|
pOut(); |
424
|
2992
|
|
|
|
|
7616
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
425
|
|
|
|
|
|
|
|
426
|
2992
|
|
|
|
|
11715
|
return $rv; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub writeStreams { |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
# Purpose: Writes all the stream index records to the file |
432
|
|
|
|
|
|
|
# Returns: Boolean |
433
|
|
|
|
|
|
|
# Usage: $rv = $obj->writeStreams; |
434
|
|
|
|
|
|
|
|
435
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
436
|
0
|
|
|
|
|
0
|
my $file = $$self{file}; |
437
|
0
|
|
|
|
|
0
|
my $rv = 0; |
438
|
0
|
|
|
|
|
0
|
my ( $rec, $i, $pos ); |
439
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
0
|
pdebug( 'entering', PDLEVEL3 ); |
441
|
0
|
|
|
|
|
0
|
pIn(); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# Hold an exclusive lock for the entire transaction |
444
|
0
|
0
|
|
|
|
0
|
if ( pflock( $file, LOCK_EX ) ) { |
445
|
0
|
|
|
|
|
0
|
$rv = 1; |
446
|
0
|
|
|
|
|
0
|
$i = 0; |
447
|
0
|
|
|
|
|
0
|
foreach $rec ( @{ $$self{streams} } ) { |
|
0
|
|
|
|
|
0
|
|
448
|
0
|
|
|
|
|
0
|
@$rec = ( $$rec[0], $self->splitInt( $$rec[1] ) ); |
449
|
0
|
|
|
|
|
0
|
$pos = STREAMS_POS + $i * STRM_LEN; |
450
|
0
|
0
|
|
|
|
0
|
$rv = 0 |
451
|
|
|
|
|
|
|
unless $self->bwrite( pack( STRMIDX, @$rec ), $pos ) == |
452
|
|
|
|
|
|
|
STRM_LEN; |
453
|
0
|
|
|
|
|
0
|
$i++; |
454
|
0
|
0
|
|
|
|
0
|
last unless $rv; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
|
457
|
0
|
|
|
|
|
0
|
pflock( $file, LOCK_UN ); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
0
|
0
|
|
|
|
0
|
pdebug( 'failed to write all stream records to the file header', |
461
|
|
|
|
|
|
|
PDLEVEL1 ) |
462
|
|
|
|
|
|
|
unless $rv; |
463
|
|
|
|
|
|
|
|
464
|
0
|
|
|
|
|
0
|
pOut(); |
465
|
0
|
|
|
|
|
0
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
466
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
0
|
return $rv; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
sub readStreams { |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
# Purpose: Reads the stream records from the file header |
473
|
|
|
|
|
|
|
# Returns: Boolean |
474
|
|
|
|
|
|
|
# Usage: $rv = $obj->readStreams; |
475
|
|
|
|
|
|
|
|
476
|
52
|
|
|
52
|
1
|
173
|
my $self = shift; |
477
|
52
|
|
|
|
|
143
|
my $rv = 1; |
478
|
52
|
|
|
|
|
447
|
my ( $raw, $sname, $bn, @sraw, $prev ); |
479
|
52
|
|
|
|
|
0
|
my ( %sidx, @streams, %model, $maxstreams ); |
480
|
|
|
|
|
|
|
|
481
|
52
|
|
|
|
|
230
|
pdebug( 'entering', PDLEVEL3 ); |
482
|
52
|
|
|
|
|
215
|
pIn(); |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# Read the streams section of the block |
485
|
52
|
50
|
|
|
|
290
|
if ( $self->bread( \$raw, STREAMS_POS ) ) { |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
# Get the model so we know how many streams we can support |
488
|
52
|
|
|
|
|
321
|
%model = $self->model; |
489
|
52
|
|
|
|
|
221
|
$maxstreams = $model{maxStreams}; |
490
|
|
|
|
|
|
|
|
491
|
52
|
|
|
|
|
24501
|
@sraw = unpack '(' . STRMIDX . ")$maxstreams", $raw; |
492
|
52
|
|
|
|
|
2835
|
while (@sraw) { |
493
|
112
|
|
|
|
|
563
|
$sname = shift @sraw; |
494
|
112
|
|
|
|
|
546
|
$bn = $self->joinInt( shift @sraw, shift @sraw ); |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# Stop processing when it looks like we're not getting legitmate |
497
|
|
|
|
|
|
|
# values |
498
|
112
|
100
|
66
|
|
|
1384
|
last unless defined $sname and length $sname and $bn > 0; |
|
|
|
66
|
|
|
|
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
# Make sure we're not getting repeated streams |
501
|
60
|
50
|
|
|
|
229
|
if ( exists $sidx{$sname} ) { |
502
|
0
|
|
|
|
|
0
|
pdebug( 'stream (%s) listed more than once', |
503
|
|
|
|
|
|
|
PDLEVEL1, $sname ); |
504
|
0
|
|
|
|
|
0
|
$rv = 0; |
505
|
0
|
|
|
|
|
0
|
last; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
# Error out if stream block numbers aren't ascending |
509
|
60
|
50
|
66
|
|
|
289
|
unless ( !defined $prev or $bn > $prev ) { |
510
|
0
|
|
|
|
|
0
|
pdebug( 'stream block number appearing out of sequence', |
511
|
|
|
|
|
|
|
PDLEVEL1 ); |
512
|
0
|
|
|
|
|
0
|
$rv = 0; |
513
|
0
|
|
|
|
|
0
|
last; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# Save entry |
517
|
60
|
|
|
|
|
309
|
push @streams, [ $sname, $bn ]; |
518
|
60
|
|
|
|
|
250
|
$sidx{$sname} = $#streams; |
519
|
60
|
|
|
|
|
225
|
$prev = $bn; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# Save everything extracted |
523
|
52
|
|
|
|
|
334
|
$$self{streamidx} = {%sidx}; |
524
|
52
|
|
|
|
|
512
|
$$self{streams} = [@streams]; |
525
|
52
|
|
|
|
|
252
|
pdebug( 'found %s streams', PDLEVEL4, scalar @streams ); |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
} else { |
528
|
0
|
|
|
|
|
0
|
pdebug( 'failed to read list of streams from file header', PDLEVEL1 ); |
529
|
0
|
|
|
|
|
0
|
$rv = 0; |
530
|
|
|
|
|
|
|
} |
531
|
|
|
|
|
|
|
|
532
|
52
|
|
|
|
|
266
|
pOut(); |
533
|
52
|
|
|
|
|
210
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
534
|
|
|
|
|
|
|
|
535
|
52
|
|
|
|
|
2878
|
return $rv; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
sub addStream { |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# Purpose: Adds a stream record to the file header |
541
|
|
|
|
|
|
|
# Returns: Boolean |
542
|
|
|
|
|
|
|
# Usage: $rv = $obj->addStream($sname, $bn); |
543
|
|
|
|
|
|
|
|
544
|
88
|
|
|
88
|
1
|
220
|
my $self = shift; |
545
|
88
|
|
|
|
|
165
|
my $sname = shift; |
546
|
88
|
|
|
|
|
176
|
my $bn = shift; |
547
|
88
|
|
|
|
|
176
|
my %sidx = %{ $$self{streamidx} }; |
|
88
|
|
|
|
|
363
|
|
548
|
88
|
|
|
|
|
209
|
my $rv = 1; |
549
|
|
|
|
|
|
|
|
550
|
88
|
|
|
|
|
286
|
pdebug( 'entering w/(%s)(%s)', PDLEVEL3, $sname, $bn ); |
551
|
88
|
|
|
|
|
330
|
pIn(); |
552
|
|
|
|
|
|
|
|
553
|
88
|
100
|
66
|
|
|
495
|
if ( defined $sname and length $sname ) { |
554
|
77
|
50
|
|
|
|
319
|
if ( exists $sidx{$sname} ) { |
555
|
0
|
|
|
|
|
0
|
pdebug( 'stream already exists (%s)', PDLEVEL1, $sname ); |
556
|
0
|
|
|
|
|
0
|
$rv = 0; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
77
|
50
|
|
|
|
264
|
if ( length $sname > 20 ) { |
560
|
0
|
|
|
|
|
0
|
pdebug( 'stream name is too long (%s)', PDLEVEL1, $sname ); |
561
|
0
|
|
|
|
|
0
|
$rv = 0; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
77
|
100
|
100
|
|
|
462
|
if ( !defined $bn or $bn < 1 ) { |
565
|
22
|
|
|
|
|
77
|
pdebug( 'invalid stream block number (%s)', PDLEVEL1, $bn ); |
566
|
22
|
|
|
|
|
44
|
$rv = 0; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
77
|
100
|
|
|
|
231
|
if ($rv) { |
570
|
55
|
|
|
|
|
132
|
push @{ $$self{streams} }, [ $sname, $bn ]; |
|
55
|
|
|
|
|
242
|
|
571
|
55
|
|
|
|
|
132
|
${ $$self{streamidx} }{$sname} = $#{ $$self{streams} }; |
|
55
|
|
|
|
|
165
|
|
|
55
|
|
|
|
|
220
|
|
572
|
|
|
|
|
|
|
$rv = 0 |
573
|
|
|
|
|
|
|
unless $self->bwrite( pack( STRMIDX, $sname, $bn ), |
574
|
55
|
50
|
|
|
|
330
|
STREAMS_POS + STRM_LEN * $#{ $$self{streams} } ) == |
|
55
|
|
|
|
|
682
|
|
575
|
|
|
|
|
|
|
STRM_LEN; |
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
} else { |
579
|
11
|
|
|
|
|
44
|
pdebug( 'invalid stream name (%s)', PDLEVEL1, $sname ); |
580
|
11
|
|
|
|
|
22
|
$rv = 0; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
88
|
|
|
|
|
341
|
pOut(); |
584
|
88
|
|
|
|
|
286
|
pdebug( 'leaving w/rv: %s', PDLEVEL3, $rv ); |
585
|
|
|
|
|
|
|
|
586
|
88
|
|
|
|
|
627
|
return $rv; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
1; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
__END__ |