view release on metacpan or  search on metacpan

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

        vec($self->{bitmap}, $block + $adjust[$block % 8],1) = $mark;
    }
    $self->{free} += ($mark ? 1 : -1) * ($#$blocks + 1);
} # end AppleII::ProDOS::Bitmap::mark

#---------------------------------------------------------------------
# Read bitmap from disk:

sub read_disk
{
    my $self = shift;
    $self->{bitmap} = $self->{disk}->read_blocks($self->{blocks});
    $self->{free}   = unpack('%32b*', $self->{bitmap});
} # end AppleII::ProDOS::Bitmap::read_disk

#---------------------------------------------------------------------
# Return the block number where the bitmap begins:

sub start_block
{
    shift->{blocks}[0];
} # end AppleII::ProDOS::Bitmap::start_block

#---------------------------------------------------------------------
# Write bitmap to disk:

sub write_disk
{
    my $self = shift;
    $self->{disk}->write_blocks($self->{blocks}, $self->{bitmap});
} # end AppleII::ProDOS::Bitmap::write_disk

#=====================================================================
package AppleII::ProDOS::Directory;
#
# Member Variables:
#   access:
#     The access attributes for this directory
#   bitmap:
#     The AppleII::ProDOS::Bitmap for the disk
#   blocks:
#     The list of blocks used by this directory
#   disk:
#     An AppleII::Disk
#   entries:
#     The list of directory entries
#   name:
#     The directory name
#   created:
#     The date/time the directory was created
#   reserved:
#     The contents of the reserved section (8 byte string)
#   type:
#     0xF for a volume directory, 0xE for a subdirectory
#   version:
#     The contents of the VERSION & MIN_VERSION (2 byte string)
#
# For subdirectories:
#   parent:     The block number in the parent directory where our entry is
#   parentNum:  Our entry number within that block of the parent directory
#   fixParent:  True means our parent entry needs to be updated
#
# We also use the os_openDirs field of the disk to keep track of open
# directories.  It contains a hash of Directory objects indexed by key
# block.  The constructors automatically add the new objects to the
# hash, and the destructor removes them.
#---------------------------------------------------------------------

AppleII::ProDOS->import(qw(a2_croak pack_date pack_name parse_name
                           short_date valid_date valid_name));
use Carp;
use bytes;
use strict;
use warnings;

our @ISA = 'AppleII::ProDOS::Members';

my %dir_fields = (
    access      => 0xFF,
    created     => \&valid_date,
    name        => \&valid_name,
    type        => undef,
    version     => undef,
);

#---------------------------------------------------------------------
# Constructor for creating a new directory:
#
# You must supply parent & parentNum when creating a subdirectory.
#
# Input:
#   name:       The name of the new directory
#   disk:       An AppleII::Disk
#   blocks:     A block number or array of block numbers for the directory
#   bitmap:     The AppleII::ProDOS::Bitmap for the disk
#   parent:     The block number in the parent directory where our entry is
#   parentNum:  Our entry number within that block of the parent directory

sub new
{
    my ($type, $name, $disk, $blocks, $bitmap, $parent, $parentNum) = @_;

    a2_croak("Invalid name `$name'") unless valid_name($name);

    my $self = {
        access  => 0xE3,
        bitmap  => $bitmap,
        blocks  => $blocks,
        disk    => $disk,
        entries => [],
        name    => uc $name,
        version => "\0\0",
        created => pack_date(time),
        _permitted => \%dir_fields,
    };

    if ($parent) {
        $self->{type}      = 0xE; # Subdirectory
        $self->{parent}    = $parent;
        $self->{parentNum} = $parentNum;
        $self->{reserved}  = "\x75\x23\x00\xC3\x27\x0D\x00\x00";