view release on metacpan or  search on metacpan

lib/AppleII/Disk.pm  view on Meta::CPAN

sub new
{
    my ($type, $filename, $mode) = @_;
    my $self = {};
    $self->{filename} = $filename;

    my $file = IO::File->new;

    $mode = 'r' unless $mode;
    my $openMode = '<';
    if ($mode =~ /w/) {
        $self->{writable} = 1;
        $openMode = '+<';
        $openMode = '+>' if not -e $filename; # Create empty file
    } # end if writable

    $file->open($filename, $openMode) or croak("Couldn't open `$filename': $!");
    binmode $file; # binmode didn't become a method until IO::File 1.11

    $self->{file}   = $file;
    $self->{actlen} = ($file->stat)[7]; # Get real size of file
    $self->{maxlen} = $self->{actlen};

    $type = 'AppleII::Disk::ProDOS' if $mode =~ /p/;
    $type = 'AppleII::Disk::DOS33'  if $mode =~ /d/;
    $type = (($filename =~ /\.(?:hdv|po)$/i)
             ? 'AppleII::Disk::ProDOS'
             : 'AppleII::Disk::DOS33')
        if ($type eq 'AppleII::Disk');
    bless $self, $type;
} # end AppleII::Disk::new

#---------------------------------------------------------------------
# Pad a block of data:
#
# This is a normal subroutine, NOT a method!
#
# Input:
#   data:    The block to be padded
#   pad:     The character to pad with (default "\0") or '' for no padding
#   length:  The length to pad to (default 0x200)
#
# Returns:
#   The BLOCK padded to LENGTH with PAD
#     Dies if the block is too long.
#     If PAD is the null string, dies if BLOCK is not already LENGTH.

sub pad_block
{
    my ($data, $pad, $length) = @_;

    $pad    = "\0" unless defined $pad;
    $length = $length || 0x200;

    $data .= $pad x ($length - length($data))
        if (length($pad) and length($data) < $length);

    unless (length($data) == $length) {
        local $Carp::CarpLevel = $Carp::CarpLevel;
        ++$Carp::CarpLevel if (caller)[0] =~ /^AppleII::Disk::/;
        croak(sprintf("Data block is %d bytes",length($data)));
    }

    $data;
} # end AppleII::Disk::pad_block

#---------------------------------------------------------------------
# Get or set the disk size:
#
# Input:
#   size:  The number of blocks in the disk image
#          If SIZE is omitted, the disk size is not changed
#
# Returns:
#   The number of blocks in the disk image

sub blocks
{
    my $self = shift;

    if (@_) {
        $self->{maxlen} = $_[0] * 0x200;
        carp "Disk image contains more than $_[0] blocks"
            if $self->{maxlen} < $self->{actlen};
    }

    int($self->{maxlen} / 0x200);
} # end AppleII::Disk::blocks

#---------------------------------------------------------------------
# Extend the image file to its full size:

sub fully_allocate
{
  my $self = shift;

  if ($self->{maxlen} > $self->{actlen}) {
    croak("Disk image is read/only") unless $self->{writable};

    $self->{file}->truncate($self->{maxlen}) or croak "Can't extend file: $!";

    $self->{actlen} = $self->{maxlen};
  } # end if file is not already at maximum size

} # end AppleII::Disk::fully_allocate

#---------------------------------------------------------------------
# Read a ProDOS block:
#
# Input:
#   block:  The block number to read
#
# Returns:
#   A 512 byte block
#
# Implemented in AppleII::Disk::ProDOS & AppleII::Disk::DOS33
#
# sub read_block

#---------------------------------------------------------------------