D64-Disk-Dir

 view release on metacpan or  search on metacpan

Dir/Entry.pm  view on Meta::CPAN

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
 
sub _bytes_to_data {
    my $self = shift;
    my $bytes = shift;
    # Get file type:
    my $file_type = ord (substr $bytes, 0x00, 0x01);
    # Get the actual filetype:
    my $type = $file_type & 7;
    # Get closed flag (not set produces "*", or "splat" files):
    my $closed = $file_type & 0x80;
    # Get locked flag (set produces ">" locked files):
    my $locked = $file_type & 0x40;
    # Get track/sector location of first sector of file:
    my $track = ord (substr $bytes, 0x01, 0x01);
    my $sector = ord (substr $bytes, 0x02, 0x01);
    # Get 16 character filename (in PETASCII, padded with $A0):
    my $rawname = substr $bytes, 0x03, 0x10;
    my $name = D64::Disk::Image->name_from_rawname($rawname);
    my ($side_track, $side_sector, $record_length) = ();
    if ($file_types[$type] eq 'rel') {
        # Get track/sector location of first side-sector block (REL file only):
        $side_track = ord (substr $bytes, 0x13, 0x01);
        $side_sector = ord (substr $bytes, 0x14, 0x01);
        # Get REL file record length (REL file only, maximum value 254):
        $record_length = ord (substr $bytes, 0x15, 0x01);
    }
    # Get file size in sectors, low/high byte order ($1C+$1D*256):
    my $size = ord (substr $bytes, 0x1D, 0x01) << 8 | ord (substr $bytes, 0x1C, 0x01);
    # Store directory entry details in a hash:
    my $dirEntry = {
        'TYPE'          => $type,
        'CLOSED'        => $closed,
        'LOCKED'        => $locked,
        'TRACK'         => $track,
        'SECTOR'        => $sector,
        'NAME'          => $name,
        'SIDE_TRACK'    => $side_track,
        'SIDE_SECTOR'   => $side_sector,
        'RECORD_LENGTH' => $record_length,
        'SIZE'          => $size,
    };
    $self->{'DETAILS'} = $dirEntry;
    return 1;
}
 
sub _data_to_bytes {
    my $self = shift;
    my @bytes = ();
    # Get detailed file information stored within this object instance:
    my $dirEntry = $self->{'DETAILS'};
    my $type = $dirEntry->{'TYPE'};
    my $closed = $dirEntry->{'CLOSED'};
    my $locked = $dirEntry->{'LOCKED'};
    my $track = $dirEntry->{'TRACK'};
    my $sector = $dirEntry->{'SECTOR'};
    my $name = $dirEntry->{'NAME'};
    my $side_track = $dirEntry->{'SIDE_TRACK'} || 0x00;
    my $side_sector = $dirEntry->{'SIDE_SECTOR'} || 0x00;
    my $record_length = $dirEntry->{'RECORD_LENGTH'} || 0x00;
    my $size = $dirEntry->{'SIZE'};
    # Byte $00 - File type:
    $bytes[0x00] = chr ($type | ($locked ? 0x40 : 0x00) | ($closed ? 0x80 : 0x00));
    # Byte $01 - Track location of first sector of file:
    $bytes[0x01] = chr ($track);
    # Byte $02 - Sector location of first sector of file:
    $bytes[0x02] = chr ($sector);
    # Bytes $03..$12 - 16 character filename (in PETASCII, padded with $A0):
    my $rawname = D64::Disk::Image->rawname_from_name($name);
    my $i = 0x03;
    foreach my $byte (split //, $rawname) {
        $bytes[$i++] = $byte;
    }

Dir/Entry.pm  view on Meta::CPAN

238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
 
=cut
 
sub set_closed {
    my ($self, $closed) = @_;
    croak "An illegal closed flag: ${closed}" unless $closed == 0 || $closed == 1;
    $self->{'DETAILS'}->{'CLOSED'} = $closed;
    return $closed;
}
 
=head2 get_locked
 
Get "Locked" flag (when set produces ">" locked files):
 
  my $locked = $entryObj->get_locked();
 
Returns true when "Locked" flag is set, and false otherwise.
 
=cut
 
sub get_locked {
    my $self = shift;
    my $locked = $self->{'DETAILS'}->{'LOCKED'};
    return $locked ? 1 : 0;
}
 
=head2 get_track
 
Get track location of first sector of file:
 
  my $track = $entryObj->get_track();
 
=cut

Dir/Entry.pm  view on Meta::CPAN

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
=cut
 
sub print_entry {
    my ($self, $fh, $args) = @_;
    $fh = *STDOUT unless defined $fh;
    $args = {} unless defined $args;
    my $verbose = $args->{verbose};
    # Get detailed file information stored within this object instance:
    my $type = $self->get_type();
    my $closed = $self->get_closed() ? ord ' ' : ord '*';
    my $locked = $self->get_locked() ? ord '<' : ord ' ';
    my $size = $self->get_size();
    my $track = sprintf '%2d', $self->get_track();
    my $sector = sprintf '%2d', $self->get_sector();
    # Get filename convert to ASCII and add quotes:
    my $name = $self->get_name(1);
    my $quotename = sprintf "\"%s\"", $name;
    # Print directory entry:
    if ($verbose) {
      printf $fh "%-4d  %-18s%c%s%c %s %s\n", $size, $quotename, $closed, $type, $locked, $track, $sector;
    }
    else {
      printf $fh "%-4d  %-18s%c%s%c\n", $size, $quotename, $closed, $type, $locked;
    }
}
 
=head1 BUGS
 
There are no known bugs at the moment. Please report any bugs or feature requests.
 
=head1 EXPORT
 
None. No method is exported into the caller's namespace either by default or explicitly.

t/03-entry.t  view on Meta::CPAN

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#########################
{
my ($d64, $entryObj, $filename) = create_test_image();
eval { $entryObj->set_closed(2); };
like($@, qr/An illegal closed flag/, 'set_closed - detecting an attempt to pass an illegal closed flag');
free_test_image($d64, $filename);
}
#########################
{
my ($d64, $entryObj, $filename) = create_test_image();
my $locked = $entryObj->get_locked();
cmp_ok($locked, '==', 0, 'get_locked - getting "Locked" flag');
free_test_image($d64, $filename);
}
#########################
{
my ($d64, $entryObj, $filename) = create_test_image();
my $track = $entryObj->get_track();
like($track, qr/^\d+$/, 'get_track - getting track location of first sector of file');
free_test_image($d64, $filename);
}
#########################