$self{qw(error cmd)} = (0, { %tape_cmd, %{$os_specific_cmd{$self{os}}} });
####
$self{error}=0;
$self{cmd}= { %tape_cmd , %{os_specific_cmd{$self{os}}} };
####
return
$self->endofdata
and $self->backwardspace(1)
and $self->backwardblock(1);
####
return
$self->endofdata
&& $self->backwardspace(1)
&& $self->backwardblock(1);
####
#!/usr/bin/perl -w
package Device::MagneticTape;
$VERSION=0.1;
use strict;
use IPC::Open2;
use Data::Dumper;
use vars qw($ERROR $AUTOLOAD);
my %tape_cmd = (
fsf => 'fsf',
bsf => 'bsf',
eod => 'eod',
unload => 'unload',
fsr => 'fsr',
bsr => 'bsr',
status => 'status',
exist => 'exist',
rewind => 'rewind',
);
my %os_specific_cmd = (
"" => {}, # dummy entry
linux => {
unload =>'eject',
},
irix => {
eod => 'feom',
},
);
my %status = (
busy => qr/\bresource busy\b/i,
bot => qr/\bbot\b/i,
notbot => qr/\bnot at bot\b/i,
eod => qr/\beod\b/i,
eof => qr/\beof\b|\bat fmk\b/i,
wr_prot => qr/\bwr_prot\b/i,
online => qr/\bonline\b/i,
# eot => qr//i, # what are these?
# dr_open => qr//i,
);
sub _assert {
my ($bool, $msg) = @_;
#warn "Assert , $bool , $msg";
$ERROR = $msg unless $bool;
return $bool;
}
sub new {
my ($class, %self) = shift;
@self{qw(device mt os)} = @_;
$self{os} ||= do {
chomp ( my $ostype = `uname` );
grep $ostype =~ /$_/i, keys %os_specific_cmd;
# MODIFIED , $self{os} ||= was being set to 2.
# presumably that is what grep is evaluating to.
lc($ostype);
} || ""; # make sure it's defined
# MODIFIED the _assert block to return $ERROR.
_assert(exists $os_specific_cmd{$self{os}}, "Unknown OS type: $self{os}")
and _assert(-e $self{mt}, "No such binary: $self{mt}")
and _assert(-x _, "No permission to execute binary: $self{mt}")
and _assert(-e $self{device}, "No such device: $self{device}")
and _assert(-r _, "No permission to read device: $self{device}")
and _assert(-w _, "No permission to write device: $self{device}")
or return $ERROR;
#$self{qw(error cmd)} = ( 0 , ( %tape_cmd, %{$os_specific_cmd{$self{os}}} ) );
# MODIFIED
$self{error}=0;
$self{cmd} = { %tape_cmd, %{$os_specific_cmd{$self{os}}} } ;
my $self = bless \%self, $class;
$self->status;
return $self;
}
sub error { # CLASS *AND* INSTANCE METHOD
my $self = shift;
my ($code, $err);
$err = ref $self ? \$self->{error} : \$ERROR;
($code, $$err) = ($$err, 0);
return $code;
}
sub get_status {
my $self = shift;
my $var = shift;
return defined $var ? $self->{$var} : "";
}
sub status {
my $self = shift;
open2( my ($rdh , $wdh) ,
$self->{mt}, -f => $self->{device},
$self->{cmd}->{status} );
# begin deep magic
my @status_flag = keys %status;
my $rx = do {
local $" = '|';
qr/@{[map "($_)", values %status]}/;
};
$self->{$_} = 0 for @status_flag;
my @check = do {
local $/;
#local $_ = <$rdh>;
local $_ = <$rdh>;
/$rx/
};
$self->{$_} = 1 for
map $status_flag[$_],
grep defined $check[$_],
0 .. $#check;
# end deep magic
# MODIFIED
#close $rdh;
#close $wdh;
$self->{bot} = 0 if $self->{notbot};
}
################### meta methods
sub new_media {
my $self = shift;
chomp(my $name = shift);
{
my $try_rw;
($try_rw = $self->rewind) or return $try_rw;
}
return unless open my $handle , '>>' , $self->{device};
print $handle "$name\n";
close $handle;
return 1;
}
sub write_index {
my $self = shift;
chomp(my @index = @_);
unshift @index, $self->{mastername};
{
my $try_ff;
($try_ff = $self->eod) or return $try_ff;
}
return unless open my $handle, '>>' , $self->{device};
print $handle map { "$_\n" } @index;
close $handle;
return 1;
}
sub get_index {
my $self = shift;
{
my $try;
($try = $self->position_for_write) or return $try;
}
$self->status;
return unless open ( my $handle, "<", $self->{device} );
my @index = <$handle>;
close $handle;
chomp(@index);
$self->{mastername} = shift @index ;
return @index;
}
sub position_for_write {
my $self = shift;
#MODIFIED.
return
$self->eod
&& $self->bsf(1)
&& $self->bsr(1);
}
sub goto {
my $self = shift;
my $pos = shift || return; # no point in goto if no position
return $self->rewind() && $self->fsf($pos);
}
sub gotoend {
my $self = shift;
return $self->eod;
}
################### workhorses
sub execute {
my $self = shift;
$self->{error} = 0;
$self->status;
return if $self->{busy};
$self->{error} = system $self->{mt}, -f => $self->{device}, @_;
#print Dumper @_;
return $self->{error} == 0;
}
sub AUTOLOAD {
my $self = shift;
my $method = $AUTOLOAD;
my $arg = shift;
print"$arg\n";
$method =~ s/^.+:://;
( exists $self->{cmd}->{$method} ) and
return $arg ? $self->execute($self->{cmd}->{$method}, $arg )
: $self->execute($self->{cmd}->{$method});
return;
}
1;