D64-Disk-Dir

 view release on metacpan or  search on metacpan

Dir/Entry.pm  view on Meta::CPAN

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

=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

=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

#########################
{
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);
}
#########################