#!/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;