File Coverage

blib/lib/SWF/BinStream/File.pm

Criterion	Covered	Total	%
statement	47	79	59.4
branch	6	24	25.0
condition	1	9	11.1
subroutine	11	19	57.8
pod			n/a
total	65	131	49.6

package SWF::BinStream::File;

use strict;
use vars qw($VERSION);
use SWF::BinStream;

$VERSION = '0.043';

package SWF::BinStream::File::Read;

use Carp;
use vars qw(@ISA);

@ISA = ('SWF::BinStream::Read');

sub new {
    my ($class, $file, $version) = @_;

    my $self = $class->SUPER::new('', \&_readfile, $version);
    $self->open($file) if defined $file;
    $self;
}

sub _readfile {
    my ($self, $bytes) = @_;
    my $file = $self->{_file};
    my $count = 0;

    return 0 unless defined $file;
    while (not eof($file) and $count < $bytes) {
	my $data;
	$count += read($file, $data, 1024);
	$self->SUPER::add_stream($data);
    }
    return ($count >= $bytes);
}

sub open {
    my ($self, $file) = @_;

    $self->close if defined $self->{_file};
    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	local *F;
	open(F, $file) or croak "Can't open $file: $!";
	$file = *F;
    }
    binmode $file;
    $self->{_file} = $file;
    $self;
}

sub close {
    my $self = shift;
    my $res;

    $self->close;
    $res = close $self->{_file} if defined $self->{_file};
    undef $self->{_file};
    $res;
}

sub add_stream {
    croak "Can't add data to a file stream ";
}

sub DESTROY {
    shift->close;
}

#####

package SWF::BinStream::File::Write;

use Carp;
use vars qw(@ISA);

@ISA = ('SWF::BinStream::Write');

sub new {
    my ($class, $file, $version) = @_;

    my $self = $class->SUPER::new($version);
    $self->SUPER::autoflush(1024, \&_writefile);
    $self->open($file) if defined $file;
    $self;
}

sub _writefile {
    my ($self, $data) = @_;
    my $file = $self->{_file};

    croak "The file to write has not opened " unless defined $file;
    print $file $data;
}

sub open {
    my ($self, $file) = @_;

    $self->close if defined $self->{_file};
    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	local *F;
	open(F, '>', $file) or croak "Can't open $file: $!";
	$file = *F;
    }
    binmode $file;
    $self->{_file} = $file;
    $self;
}

sub close {
    my $self = shift;
    my $file = $self->{_file};
    my $res;

    if (defined $file) {
	$self->SUPER::close;
	$res = close $file;
	undef $self->{_file};
    }
    $res;
}

sub autoflush {
}

sub DESTROY {
    shift->close;
}

1;
__END__