my ($os) = 
	grep $ostype =~ /$_/i,
	map quotemeta,
	keys %os_specific_cmd;

##</code><code>##

#!/usr/bin/perl -w
package Device::MagneticTape;
use strict;
use IPC::Open2;
use vars qw($ERROR $AUTOLOAD $VERSION);

$VERSION=0.11;

my %tape_cmd = (
    forwardspace  => 'fsf',
    backwardspace => 'bsf',
    endofdata     => 'eod',
    gotoend       => 'eod',
    eject         => 'unload',
    forwardblock  => 'fsr',
    backwardblock => 'bsr',
    exist         => 'exist',  
    rewind        => 'rewind',
    status        => 'status',
);

my %os_specific_cmd = (
    linux => {
        eject => 'eject',
    },
    irix => {
        endofdata => 'feom',
        gotoend   => '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,
);

sub _assert {
    my ($bool, $msg) = @_;
    $ERROR = $msg unless $bool;
    return $bool;
}

sub new { 
    my ($class, %self) = shift;
    @self{qw(device mt os)} = @_;
    chomp( my $ostype = `uname` );
    $ostype=lc($ostype);
    $self{os}||=$ostype; 
     
    _assert(not $self{os} or 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;

    @self{qw(error cmd)} = (
	    0,
	    {%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;
    return @_ ? $self->{$_[0]} : "";
}

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>;
        /$rx/
    };
    $self->{$_} = 1 for
        map $status_flag[$_],
        grep defined $check[$_],
        0 .. $#check;
    # end deep magic
    $self->{bot} = 0 if $self->{notbot};
}

################### meta methods

sub new_media { 
    my $self = shift;
    $self->{mastername}= $_[0];
    return $self->_meta(rewind => 1, $_[0]);
}

sub write_index {
    my $self = shift;
    return $self->_meta(gotoend => 1, $self->{mastername}, @_);
}

sub get_index {
    my $self = shift;

    my @index = $self->_meta(position_for_write => 0);
    chomp(@index);
    $self->{mastername} = shift @index;
    return @index;
}

sub position_for_write {
    my $self = shift;
    return
      $self->gotoend()
	&& $self->backwardspace(1)
	  && $self->backwardblock(1);
}

sub goto {
    my $self = shift;
    my $pos = shift || return; # no point in goto if no position
    return $self->rewind() and
      $self->forwardspace($pos);
}

############### the back end

sub _meta {
    my $self = shift;
    my $cmd = shift;
    my $mode = ('<', '>>')[shift]; # 0=read, 1=write
    my @args = @_;
    return
        unless $self->$cmd()
        and open my $handle, $mode, $self->{device};

    return 
        $mode eq '<'  ? (<$handle>) :
	print $handle map { chomp;"$_\n" } @args; #@_ not mutatable by map?? 
}

sub DESTROY {  return; }

sub AUTOLOAD {
    my $self = shift;
    my $class = ref $self;
    my ($method) = $AUTOLOAD =~ m/$class::([^:]+)$/;
    $method ||= "";
    die "No such tape command: $method"
        unless $method
        and exists $self->{cmd}->{$method};

    $self->{error} = 0;

    $self->status;
    return if $self->{busy};

    $self->{error} = system
        $self->{mt}, -f => $self->{device},
        $self->{cmd}->{$method}, @_ ;
    return $self->{error} == 0;
}

1;