# Before `./Build install' is performed this script should be runnable with
# `./Build test'. After `./Build install' it should work as `perl 20_ProDOS.t'
#---------------------------------------------------------------------
# $Id: 20_ProDOS.t 1538 2006-10-09 03:37:20Z cjm $
# Copyright 2006 Christopher J. Madsen
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# Test the AppleII::ProDOS module
#---------------------------------------------------------------------

use FindBin;

use strict;
use Test::More tests => 38;
BEGIN { use_ok('AppleII::ProDOS', qw(pack_date)) }

#---------------------------------------------------------------------
# Simple RLE file decompression:
#
# A compressed file just alternates between a count of null bytes and
# a data chunk (count + raw data).  All counts are unsigned network
# shorts.  See compact.pl for the compression code.

sub expand
{
  my ($infile, $outfile) = @_;

  open(IN,  '<', $infile)  or die "Can't open $infile: $!";
  open(OUT, '>', $outfile) or die "Can't open $outfile: $!";
  binmode IN;
  binmode OUT;

  my ($buf, $len, $result) = '';
  while (1) {
    defined($result = read(IN, $buf, 2)) or die $!;
    last unless $result;

    print OUT "\0" x unpack('n', $buf);

    defined($result = read(IN, $buf, 2)) or die $!;
    last unless $result;

    $len = unpack('n', $buf);

    if ($len) {
      read(IN, $buf, $len) or die $!;
      print OUT $buf;
    } # end if data chunk is not empty
  } # end while more data in compressed file

  close IN;
  close OUT or die "Closing $outfile: $!";
} # end expand

#=====================================================================
# Create the test file:

my $dir = "$FindBin::Bin/tmpdir";
mkdir $dir;
chdir $dir or die "Can't cd $dir: $!";

expand('../testdisk.cmp', 'testdisk.PO');

#---------------------------------------------------------------------
# Tests begin here:

my $vol = AppleII::ProDOS->open("testdisk.PO", 'rw');
isa_ok($vol, 'AppleII::ProDOS', '$vol');

is($vol->name, 'TESTDISK', 'Volume /TESTDISK');

is($vol->disk_size, 280, '280 blocks');

my $bit = $vol->bitmap;
isa_ok($bit, 'AppleII::ProDOS::Bitmap', '$vol->bitmap');

is($bit->free, 260, '260 blocks free');

is($vol->catalog, <<'', 'Catalog /TESTDISK');
Name           Type Blocks  Modified        Created            Size Subtype
SEEDLING        TXT     1  23-Mar-06 11:28 23-Mar-06 11:28        6  $0000
SPARSE.SAPLING  TXT     3  23-Mar-06 19:47 23-Mar-06 11:34    65032  $0000
SUBDIR          DIR     1  24-Mar-06 15:36 23-Mar-06 19:48      512  $0000
Blocks free: 260     Blocks used: 20     Total blocks: 280

sub test_files_in_root {
  my $file = $vol->get_file('SEEDLING');
  isa_ok($file, 'AppleII::ProDOS::File', 'SEEDLING $file');

  is($file->as_text, "Hello\n", '$file says Hello');

  $file = $vol->get_file('SPARSE.SAPLING');
  isa_ok($file, 'AppleII::ProDOS::File', 'SPARSE.SAPLING $file');

  is($file->as_text, "Hello," . ("\0" x 0xFDFA) . "World!\n\0",
     'SPARSE.SAPLING says Hello, World!');
} # end test_files_in_root
test_files_in_root();

is($vol->path('SUBDIR'), '/TESTDISK/SUBDIR/', 'cd SUBDIR');

is($vol->catalog, <<'', 'Catalog /TESTDISK/SUBDIR');
Name           Type Blocks  Modified        Created            Size Subtype
SAPLING         TXT     3  23-Mar-06 19:52 23-Mar-06 19:50      531  $0000
SPARSE.TREE     BIN     5  24-Mar-06 15:36 24-Mar-06 15:35   131106  $1000
Blocks free: 260     Blocks used: 20     Total blocks: 280

sub test_files_in_subdir
{
  my $file = $vol->get_file('SAPLING');
  isa_ok($file, 'AppleII::ProDOS::File', 'SAPLING $file');

  is($file->as_text,
     "This is a sapling file.\n" . ("\0" x 488) . "This is block two.\n",
     'SAPLING $file contents');

  $file = $vol->get_file('SPARSE.TREE');
  isa_ok($file, 'AppleII::ProDOS::File', 'SPARSE.TREE $file');

  is($file->as_text,
     "This is a sparse tree file.\n" . ("\0" x 0x1FFE4)
     . "This is the end of the tree file.\n",
     'SPARSE.TREE $file contents');
} # end test_files_in_subdir
test_files_in_subdir();

#---------------------------------------------------------------------
# Now try some write tests:

my $contents = "Hello, World!\x0D" x 256;

my $file = AppleII::ProDOS::File->new('Sample.File', $contents);
isa_ok($file, 'AppleII::ProDOS::File', 'Sample.File $file');

$file->created( pack_date(1977, 1,  1));
$file->modified(pack_date(1999, 3, 25, 12, 34));

eval { $vol->put_file($file); };
is($@, '', "Wrote Sample.File");

is($vol->catalog, <<'', 'Catalog /TESTDISK/SUBDIR after write');
Name           Type Blocks  Modified        Created            Size Subtype
SAPLING         TXT     3  23-Mar-06 19:52 23-Mar-06 19:50      531  $0000
SPARSE.TREE     BIN     5  24-Mar-06 15:36 24-Mar-06 15:35   131106  $1000
SAMPLE.FILE     NON     8  25-Mar-99 12:34  1-Jan-77  0:00     3584  $0000
Blocks free: 252     Blocks used: 28     Total blocks: 280

undef $file;

$file = $vol->get_file('SAMPLE.FILE');
isa_ok($file, 'AppleII::ProDOS::File', 'Read Sample.File');

is($file->data, $contents, 'SAMPLE.FILE contents');

$contents =~ s/\x0D/\n/g;
is($file->as_text, $contents, 'SAMPLE.FILE as_text');

#.....................................................................
$contents = ("Another sparse tree file.\n" . ("\0" x 0x20400) .
             "End of another sparse tree file.\n");

$file = AppleII::ProDOS::File->new('sparser.tree', $contents);
isa_ok($file, 'AppleII::ProDOS::File', 'sparser.tree $file');

eval { $vol->put_file($file); };
is($@, '', "Wrote sparser.tree");

is($vol->catalog, <<'', 'Catalog /TESTDISK/SUBDIR after sparser.tree');
Name           Type Blocks  Modified        Created            Size Subtype
SAPLING         TXT     3  23-Mar-06 19:52 23-Mar-06 19:50      531  $0000
SPARSE.TREE     BIN     5  24-Mar-06 15:36 24-Mar-06 15:35   131106  $1000
SAMPLE.FILE     NON     8  25-Mar-99 12:34  1-Jan-77  0:00     3584  $0000
SPARSER.TREE    NON     5  <No Date>       <No Date>         132155  $0000
Blocks free: 247     Blocks used: 33     Total blocks: 280

undef $file;

$file = $vol->get_file('Sparser.Tree');
isa_ok($file, 'AppleII::ProDOS::File', 'Read Sparser.Tree');

is($file->data, $contents, 'Sparser.Tree contents');

#---------------------------------------------------------------------
# Finally, try the read tests again:

is($vol->path('/TESTDISK'), '/TESTDISK/', 'cd /');

test_files_in_root();

is($vol->path('SUBDIR'), '/TESTDISK/SUBDIR/', 'cd SUBDIR again');

test_files_in_subdir();

#---------------------------------------------------------------------
# Local Variables:
# mode: perl
# End: