line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package D64::Disk::Layout; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
D64::Disk::Layout - Handling entire Commodore (D64/D71/D81) disk image data in pure Perl |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use D64::Disk::Layout; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Create an empty disk layout instance: |
12
|
|
|
|
|
|
|
my $layout = D64::Disk::Layout->new(); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Read disk image layout from existing file: |
15
|
|
|
|
|
|
|
my $layout = D64::Disk::Layout->new('image.d64'); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Get disk sector object from a disk layout: |
18
|
|
|
|
|
|
|
my $sector_layout = $layout->sector(track => $track, sector => $sector); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Put new data into specific disk layout sector: |
21
|
|
|
|
|
|
|
$layout->sector(data => $sector_layout); |
22
|
|
|
|
|
|
|
# Update an arbitrary disk layout sector with data: |
23
|
|
|
|
|
|
|
$layout->sector(data => $sector_layout, track => $track, sector => $sector); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Fetch disk layout data as an array of 683 sector objects: |
26
|
|
|
|
|
|
|
my @sector_layouts = $layout->sectors(); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Update disk layout given an array of arbitrary sector objects: |
29
|
|
|
|
|
|
|
$layout->sectors(sectors => \@sector_layouts); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# Fetch disk layout data as a scalar of 683 * 256 bytes: |
32
|
|
|
|
|
|
|
my $data = $layout->data(); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Update disk layout providing 683 * 256 bytes of scalar data: |
35
|
|
|
|
|
|
|
$layout->data(data => $data); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Print out nicely formatted human-readable form of a track/sector data: |
38
|
|
|
|
|
|
|
$layout->print(fh => $fh, track => $track, sector => $sector); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 DESCRIPTION |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
C provides a helper class for C module, enabling users to easily access and manipulate entire D64/D71/D81 disk image data in an object oriented way without the hassle of worrying about the meaning of individual bits and bytes located on every track and sector of a physical disk image. The whole family of C modules has been implemented in pure Perl as an alternative to Per Olofsson's "diskimage.c" library originally written in an ANSI C. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
C is completely unaware of an internal structure, configuration and meaning of individual sectors on disk. It only knows how to fetch and store bytes of data. Standard C disk image of C<170> kbytes is split into C<683> sectors on C<35> tracks, each of the sectors holding C<256> bytes. See description of the L module for a detailed description on accessing individual disk image files and preserving disk directory structure. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 METHODS |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
5
|
|
|
5
|
|
107912
|
use bytes; |
|
5
|
|
|
|
|
101
|
|
|
5
|
|
|
|
|
26
|
|
51
|
5
|
|
|
5
|
|
157
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
94
|
|
52
|
5
|
|
|
5
|
|
2872
|
use utf8; |
|
5
|
|
|
|
|
72
|
|
|
5
|
|
|
|
|
27
|
|
53
|
5
|
|
|
5
|
|
154
|
use warnings; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
237
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
56
|
|
|
|
|
|
|
|
57
|
5
|
|
|
5
|
|
28
|
use base qw(D64::Disk::Layout::Base); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
2851
|
|
58
|
5
|
|
|
5
|
|
11979
|
use Carp qw(carp croak); |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
265
|
|
59
|
5
|
|
|
5
|
|
2718
|
use D64::Disk::Layout::Sector; |
|
5
|
|
|
|
|
113911
|
|
|
5
|
|
|
|
|
212
|
|
60
|
5
|
|
|
5
|
|
3120
|
use List::MoreUtils qw(arrayify zip6); |
|
5
|
|
|
|
|
77527
|
|
|
5
|
|
|
|
|
36
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Number of bytes per sector storage: |
63
|
|
|
|
|
|
|
our $bytes_per_sector = 256; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Number of sectors per track storage: |
66
|
|
|
|
|
|
|
our @sectors_per_track = ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, # tracks 1-17 |
67
|
|
|
|
|
|
|
19, 19, 19, 19, 19, 19, 19, # tracks 18-24 |
68
|
|
|
|
|
|
|
18, 18, 18, 18, 18, 18, # tracks 25-30 |
69
|
|
|
|
|
|
|
17, 17, 17, 17, 17, # tracks 31-35 |
70
|
|
|
|
|
|
|
# 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, # tracks 31-40 |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 new |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Create empty unformatted D64 disk image layout: |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my $d64DiskLayoutObj = D64::Disk::Layout->new(); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Read D64 disk image layout from existing file: |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $d64DiskLayoutObj = D64::Disk::Layout->new('image.d64'); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
A valid D64::Disk::Layout object is returned upon success, an undefined value otherwise. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub new { |
88
|
16
|
|
|
16
|
1
|
340390
|
my ($class) = shift ; |
89
|
16
|
|
|
|
|
148
|
my $self = $class->SUPER::new(@_); |
90
|
16
|
50
|
|
|
|
170
|
if (defined $self) { |
91
|
16
|
|
|
|
|
60
|
bless $self, $class; |
92
|
16
|
|
|
|
|
71
|
return $self; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
else { |
95
|
0
|
|
|
|
|
0
|
carp 'Failed to create new ' . __PACKAGE__ . ' object'; |
96
|
0
|
|
|
|
|
0
|
return undef; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub _initialize { |
101
|
16
|
|
|
16
|
|
220
|
my ($self) = shift; |
102
|
16
|
|
|
|
|
81
|
$self->SUPER::_initialize(@_); |
103
|
16
|
|
|
|
|
2258041
|
return 1; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head2 sector |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Retrieve disk sector object from a disk layout: |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my $sectorObj = $d64DiskLayoutObj->sector(track => $track, sector => $sector); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Insert new data into specific disk layout sector: |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
$d64DiskLayoutObj->sector(data => $sectorObj); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Update an arbitrary disk layout sector with data: |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
$d64DiskLayoutObj->sector(data => $sectorObj, track => $track, sector => $sector); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=cut |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub sector { |
123
|
688
|
|
|
688
|
1
|
8154
|
my ($self, %args) = @_; |
124
|
688
|
|
|
|
|
1109
|
my $track = $args{track}; |
125
|
688
|
|
|
|
|
983
|
my $sector = $args{sector}; |
126
|
688
|
|
|
|
|
1001
|
my $data = $args{data}; |
127
|
688
|
100
|
|
|
|
1775
|
if (defined $data) { |
128
|
2
|
100
|
66
|
|
|
15
|
unless (defined $track && defined $sector) { |
129
|
1
|
|
|
|
|
4
|
$track = $data->track(); |
130
|
1
|
|
|
|
|
13
|
$sector = $data->sector(); |
131
|
|
|
|
|
|
|
} |
132
|
2
|
|
|
|
|
16
|
$self->sector_data($track, $sector, $data->data()); |
133
|
|
|
|
|
|
|
} |
134
|
688
|
|
|
|
|
2850
|
my @data = $self->sector_data($track, $sector); |
135
|
688
|
|
|
|
|
201988
|
return D64::Disk::Layout::Sector->new(data => \@data, track => $track, sector => $sector); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head2 sectors |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Fetch disk layout data as a flattened array of 683 sector objects: |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my @sector_layouts = $d64DiskLayoutObj->sectors(); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Update disk layout given an array of arbitrary sector objects: |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$d64DiskLayoutObj->sectors(sectors => \@sector_layouts); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub sectors { |
151
|
0
|
|
|
0
|
1
|
0
|
my ($self, %args) = @_; |
152
|
0
|
|
|
|
|
0
|
my $sectors = $args{sectors}; |
153
|
0
|
0
|
|
|
|
0
|
if (defined $sectors) { |
154
|
0
|
|
|
|
|
0
|
for my $sectorObj (@{$sectors}) { |
|
0
|
|
|
|
|
0
|
|
155
|
0
|
|
|
|
|
0
|
my $track = $sectorObj->track(); |
156
|
0
|
|
|
|
|
0
|
my $sector = $sectorObj->sector(); |
157
|
0
|
|
|
|
|
0
|
my $data = $sectorObj->data(); |
158
|
0
|
|
|
|
|
0
|
$self->sector_data($track, $sector, $data); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} |
161
|
0
|
|
|
|
|
0
|
my @sector_layouts = arrayify $self->tracks(); |
162
|
0
|
|
|
|
|
0
|
return @sector_layouts; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 tracks |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Fetch disk layout data as an array of 35 arrays of sector objects allocated by their respective track numbers: |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
my @track_layouts = $d64DiskLayoutObj->tracks(); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub tracks { |
174
|
1
|
|
|
1
|
1
|
8
|
my ($self) = @_; |
175
|
1
|
|
|
|
|
28
|
my @track_numbers = (1 .. @sectors_per_track); |
176
|
|
|
|
|
|
|
my @track_layouts = map { |
177
|
1
|
|
|
|
|
34
|
my ($num_sectors, $track) = @{$_}; |
|
35
|
|
|
|
|
101686
|
|
|
35
|
|
|
|
|
108
|
|
178
|
|
|
|
|
|
|
[ |
179
|
|
|
|
|
|
|
map { |
180
|
35
|
|
|
|
|
122
|
my $sector = $_; |
|
683
|
|
|
|
|
1928210
|
|
181
|
683
|
|
|
|
|
1695
|
$self->sector(track => $track, sector => $sector); |
182
|
|
|
|
|
|
|
} (0 .. $num_sectors - 1) |
183
|
|
|
|
|
|
|
]; |
184
|
|
|
|
|
|
|
} zip6 @sectors_per_track, @track_numbers; |
185
|
1
|
|
|
|
|
3014
|
return @track_layouts; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 data |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Fetch disk layout data as a scalar of 683 * 256 bytes: |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
my $data = $d64DiskLayoutObj->data(); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Update disk layout providing 683 * 256 bytes of scalar data: |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
$d64DiskLayoutObj->data(data => $data); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub data { |
201
|
3
|
|
|
3
|
1
|
48
|
my ($self, %args) = @_; |
202
|
3
|
|
|
|
|
30
|
my $data = $args{data}; |
203
|
3
|
|
|
|
|
18
|
my @track_numbers = (1 .. @sectors_per_track); |
204
|
|
|
|
|
|
|
my $result = join '', map { |
205
|
3
|
|
|
|
|
59
|
my ($num_sectors, $track) = @{$_}; |
|
105
|
|
|
|
|
63017
|
|
|
105
|
|
|
|
|
288
|
|
206
|
|
|
|
|
|
|
join '', map { |
207
|
105
|
|
|
|
|
358
|
my $sector = $_; |
|
2049
|
|
|
|
|
454734
|
|
208
|
2049
|
100
|
|
|
|
4658
|
if (defined $data) { |
209
|
683
|
|
|
|
|
18276
|
$self->sector_data($track, $sector, split //, substr $data, 0x00, $bytes_per_sector, ''); |
210
|
|
|
|
|
|
|
} |
211
|
2049
|
|
|
|
|
227852
|
$self->sector_data($track, $sector); |
212
|
|
|
|
|
|
|
} (0 .. $num_sectors - 1); |
213
|
|
|
|
|
|
|
} zip6 @sectors_per_track, @track_numbers; |
214
|
3
|
|
|
|
|
2443
|
return $result; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head2 print |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Print out nicely formatted human-readable form of a track/sector data into any given IO::Handle: |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
$d64DiskLayoutObj->print(fh => $fh, track => $track, sector => $sector); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=cut |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub print { |
226
|
2
|
|
|
2
|
1
|
21
|
my ($self, %params) = @_; |
227
|
2
|
|
|
|
|
26
|
my $track = $params{track}; |
228
|
2
|
|
|
|
|
5
|
my $sector = $params{sector}; |
229
|
|
|
|
|
|
|
|
230
|
2
|
|
33
|
|
|
14
|
my $fh = $params{fh} || *STDOUT; |
231
|
2
|
|
|
|
|
23
|
my $stdout = select $fh; |
232
|
|
|
|
|
|
|
|
233
|
2
|
|
|
|
|
9
|
my @data = $self->sector_data($track, $sector); |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
# Fail on invalid track/sector value combinations: |
236
|
2
|
50
|
|
|
|
587
|
carp 'Failed to print track/sector=' . $track . '/' . $sector . ' data' unless @data; |
237
|
|
|
|
|
|
|
|
238
|
2
|
|
|
|
|
9
|
for (my $i = 0x00; $i < 0x0100; $i += 0x10) { |
239
|
32
|
|
|
|
|
332
|
printf q{%02X:}, $i; |
240
|
32
|
|
|
|
|
389
|
for (my $j = 0x00; $j < 0x10; $j++) { |
241
|
512
|
|
|
|
|
5910
|
printf q{ %02x}, ord $data[$i + $j]; |
242
|
|
|
|
|
|
|
} |
243
|
32
|
|
|
|
|
392
|
print qq{\n}; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
2
|
|
|
|
|
25
|
select $stdout; |
247
|
2
|
|
|
|
|
31
|
return; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head1 BUGS |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
There are no known bugs at the moment. Please report any bugs or feature requests. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 EXPORT |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
None. No method is exported into the caller's namespace either by default or explicitly. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head1 SEE ALSO |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
L, L, L. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head1 AUTHOR |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Pawel Krol, Epawelkrol@cpan.orgE. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 VERSION |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Version 0.01 (2021-01-12) |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
Copyright 2021 by Pawel Krol . |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=cut |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
1; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
__END__ |