File Coverage

blib/lib/D64/Disk/Layout.pm
Criterion Covered Total %
statement 78 91 85.7
branch 8 12 66.6
condition 3 6 50.0
subroutine 14 15 93.3
pod 6 6 100.0
total 109 130 83.8


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__