viewvc.cgi/VRac/Tape.pm

package Tape;

# Dobrica Pavlinusic, <dpavlin@rot13.org> 08/03/07 11:11:56 CEST

use strict;
use warnings;

use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors(qw(tape tape_pos));

use File::Slurp;
use Carp qw/confess/;

=head1 NAME

Tape - implement tape reader/recorder

=cut

=head2 read_tape

  $self->read_tape;

=cut

my $last_warn = '';

sub _warn {
        my $msg = shift;
        if ( $msg ne $last_warn ) {
                warn "$msg\n";
                $last_warn = $msg;
        }
}

sub read_tape {
        my $self = shift;
        if ( ! $self->tape ) {
                _warn "please load tape!";
                return 0;
        }
        my $pos = $self->tape_pos;
        my $tape = $self->tape;
        if ( $pos > length( $tape ) ) {
                _warn "end of tape [$pos]";
                return -1;
        }
        my $byte = substr($self->tape,$pos++,1);
        $self->tape_pos( $pos );
        return ord($byte);
}

=head2 load_tape

  $self->load_tape( '/path/to/file' );

=cut

sub load_tape {
        my $self = shift;
        my $path = shift || return;

        my $tape = read_file( $path ) || confess "can't load $path: $!";

        $self->tape_pos( 0 );
        $self->tape( $tape );
        warn "loaded tape $path ", -s $path, " bytes\n";
        return 1;
}


1;
1	package Tape;
2
3	# Dobrica Pavlinusic, <dpavlin@rot13.org> 08/03/07 11:11:56 CEST
4
5	use strict;
6	use warnings;
7
8	use base qw/Class::Accessor/;
9	__PACKAGE__->mk_accessors(qw(tape tape_pos));
10
11	use File::Slurp;
12	use Carp qw/confess/;
13
14	=head1 NAME
15
16	Tape - implement tape reader/recorder
17
18	=cut
19
20	=head2 read_tape
21
22	$self->read_tape;
23
24	=cut
25
26	my $last_warn = '';
27
28	sub _warn {
29	my $msg = shift;
30	if ( $msg ne $last_warn ) {
31	warn "$msg\n";
32	$last_warn = $msg;
33	}
34	}
35
36	sub read_tape {
37	my $self = shift;
38	if ( ! $self->tape ) {
39	_warn "please load tape!";
40	return 0;
41	}
42	my $pos = $self->tape_pos;
43	my $tape = $self->tape;
44	if ( $pos > length( $tape ) ) {
45	_warn "end of tape [$pos]";
46	return -1;
47	}
48	my $byte = substr($self->tape,$pos++,1);
49	$self->tape_pos( $pos );
50	return ord($byte);
51	}
52
53	=head2 load_tape
54
55	$self->load_tape( '/path/to/file' );
56
57	=cut
58
59	sub load_tape {
60	my $self = shift;
61	my $path = shift \|\| return;
62
63	my $tape = read_file( $path ) \|\| confess "can't load $path: $!";
64
65	$self->tape_pos( 0 );
66	$self->tape( $tape );
67	warn "loaded tape $path ", -s $path, " bytes\n";
68	return 1;
69	}
70
71
72	1;