File Coverage

blib/lib/Mac/Macbinary.pm

Criterion	Covered	Total	%
statement	63	64	98.4
branch	7	10	70.0
condition	3	6	50.0
subroutine	12	12	100.0
pod	1	1	100.0
total	86	93	92.4

package Mac::Macbinary;

use strict;
use vars qw($VERSION $AUTOLOAD);
$VERSION = 0.06;

use Carp ();

sub new {
    my($class, $thingy, $attr) = @_;
    my $self = bless {
	validate => $attr->{validate},
    }, $class;

    my $fh = _make_handle($thingy);
    $self->_parse_handle($fh);
    return $self;
}

sub _parse_handle {
    my $self = shift;
    my($fh) = @_;

    read $fh, my ($header), 128;
    $self->{header} = Mac::Macbinary::Header->new($header, {
	validate => $self->{validate},
    });
    read $fh, $self->{data}, $self->header->dflen;

    my $resourceoffset = 128 - (($self->header->dflen) % 128);
    read $fh, my($tmp), $resourceoffset;
    read $fh, $self->{resource}, $self->header->rflen;

    return $self;
}

sub _make_handle($) {
    my $thingy = shift;

    if (! ref($thingy) && -f $thingy) {
	require FileHandle;
	my $fh = FileHandle->new($thingy) or Carp::croak "$thingy: $!";
	return $fh;
    } else {
	# tries to read it
	eval {
	    read $thingy, my($tmp), 0;
	};
	if ($@) {
	  Carp::croak "Can't read $thingy!";
	}
	return $thingy;
    }
}

sub AUTOLOAD {
    my $self = shift;
    $AUTOLOAD =~ s/.*://o;
    return $self->{$AUTOLOAD};
}


package Mac::Macbinary::Header;

use vars qw($AUTOLOAD);

sub new {
    my($class, $h, $attr) = @_;
    my $self = bless { }, $class;
    if ($attr->{validate}) {
	$self->_validate_header($h)
	    or Carp::croak "Macbinary validation failed.";
    }
    $self->_parse_header($h);
    return $self;
}

sub _validate_header {
    my $self = shift;
    my($h) = @_;

    #  stolen from Mac::Conversions
    #
    #  Use a crude heuristic to decide whether or not a file is MacBinary.  The
    #  first byte of any MacBinary file must be zero.  The second has to be
    #  <= 63 according to the MacBinary II standard.  The 122nd and 123rd
    #  each have to be >= 129.  This has about a 1/8000 chance of failing on
    #  random bytes.  This seems to be all that mcvert does.  Unfortunately
    #  we can't also check the checksum because the standard software (Stuffit
    #  Deluxe, etc.) doesn't seem to checksum.

    my($zero,
       $namelength,
       $filename,
       $type,
       $creator,
       $highflag,
       $dum1,
       $dum2,
       $dum3,
       $datalength,
       $reslength,
       $dum4,
       $dum5,
       $dum6,
       $lowflag,
       $dum7,
       $dum8,
       $version_this,
       $version_needed,
       $crc) = unpack("CCA63a4a4CxNnCxNNNNnCx14NnCCN", $h);

    return (!$zero && (($namelength - 1)< 63)
	    && $version_this >= 129 && $version_needed >= 129);
}

sub _parse_header {
    my $self = shift;
    my($h) = @_;

    $self->{name}	= unpack("A*", substr($h, 2, 63));
    $self->{type}	= unpack("A*", substr($h, 65, 4));
    $self->{creator}	= unpack("A*", substr($h, 69, 4));
    $self->{flags}	= unpack("C", substr($h, 73, 1));
    $self->{location}	= unpack("C", substr($h, 80, 6));
    $self->{dflen}	= unpack("N", substr($h, 83, 4));
    $self->{rflen}	= unpack("N", substr($h, 87, 4));
    $self->{cdate}	= unpack("N", substr($h, 91, 4));
    $self->{mdate}	= unpack("N", substr($h, 95, 4));

    return $self;
}


sub AUTOLOAD {
    my $self = shift;
    $AUTOLOAD =~ s/.*://o;
    return $self->{$AUTOLOAD};
}

1;
__END__