/[VRac]/Tape.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /Tape.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 172 - (hide annotations)
Mon Aug 6 11:49:37 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 1763 byte(s)
bugfix: removed obsolete accessor
1 dpavlin 109 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 dpavlin 169 __PACKAGE__->mk_accessors(qw(tape tape_path tape_pos trace));
10 dpavlin 109
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 dpavlin 145 my $byte = $self->read_tape;
23 dpavlin 109
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 dpavlin 110
49 dpavlin 145 my $byte = ord( substr($self->tape,$pos,1) );
50 dpavlin 169 warn sprintf("tape pos %d = %02x\n", $pos, $byte); # if $self->trace;
51 dpavlin 114
52 dpavlin 145 $pos++;
53     $self->tape_pos( $pos );
54 dpavlin 114
55 dpavlin 145 return $byte;
56 dpavlin 109 }
57    
58 dpavlin 145 =head2 write_tape
59    
60     $self->write_tape( $byte );
61    
62     =cut
63    
64    
65     sub write_tape {
66     my ( $self, $byte ) = @_;
67    
68     $self->append_to_file( 'tape.dmp', chr($byte) );
69    
70     return $byte;
71     }
72    
73 dpavlin 109 =head2 load_tape
74    
75     $self->load_tape( '/path/to/file' );
76    
77     =cut
78    
79     sub load_tape {
80     my $self = shift;
81     my $path = shift || return;
82    
83     my $tape = read_file( $path ) || confess "can't load $path: $!";
84 dpavlin 169 $self->tape_path( $path );
85 dpavlin 109
86     $self->tape_pos( 0 );
87     $self->tape( $tape );
88 dpavlin 172 warn "loaded tape $path ", -s $path, " bytes\n";
89 dpavlin 109 return 1;
90     }
91    
92 dpavlin 169 =head tape_status
93    
94     print $self->tape_status;
95    
96     =cut
97    
98     sub tape_status {
99     my $self = shift;
100    
101     return "No tape in (simulated) drive" unless $self->tape;
102    
103     my $size = length( $self->tape );
104    
105     return sprintf(
106     "tape file: %s with %d 0x%x bytes, current position: %d 0x%x",
107     $self->tape_path, $size, $size, $self->pos, $self->pos,
108     );
109     }
110    
111 dpavlin 145 =head1 SEE ALSO
112 dpavlin 109
113 dpavlin 145 L<VRac>
114    
115     =cut
116    
117 dpavlin 109 1;

  ViewVC Help
Powered by ViewVC 1.1.26