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

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) = @_;
    $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;
    } || ""; # make sure it's defined

    _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;

    $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;
    my $var = shift;
    return defined $var ? $self->{$var} : "";
}

sub status { 
    my $self = shift;

    open2(
        my ($rdh, $wrh),
        $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;
    chomp(my $name = shift);

    {
        my $try_rw;
        ($try_rw = $self->rewind) or return $try_rw;
    }

    return unless open my $index , '>>' , $self->{device};
    print $index "$name\n";
    close $index;
    return 1;
}

sub write_index {
    my $self = shift;
    chomp(my @index = @_);
    unshift @index, $self->{mastername};

    {
        my $try_ff;
        ($try_ff = $self->gotoend) or return $try_ff;
    }

    return unless open my $index, '>>' , $self->{device};
    print $index join("\n" , @index); # are you sure it shouldn't be map "$_\n"?
    close $index;

    return 1;
}

sub get_index {
    my $self = shift;
    $self->positionforwrite;

    return unless open my $index, "<", $self->{device};
    chomp(my @index = <$index>);
    close $index;

    $self->{mastername} = shift @index;

    return @index;
}

sub position_for_write {
    my $self = shift;
    return
        $self->gotoend
        and $self->backwardspace(1)
        and $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);
} 

sub gotoend {
    my $self = shift;
    return $self->endofdata;
}

################### workhorses

sub execute {
    my $self = shift;
    $self->{error} = 0;

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

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

sub endofdata {
    my $self = shift;
    return $self->execute($self->{cmd}->{eod});
}

sub rewind {
    my $self = shift;
    return $self->execute($self->{cmd}->{rewind});
}
 
sub forwardspace {
    my $self = shift;
    my $distance = shift || 1;
    return $self->execute($self->{cmd}->{fsf}, $distance);
}

sub backwardspace {
    my $self = shift;
    my $distance = shift || 1;
    return $self->execute($self->{cmd}->{bsf}, $distance);
}

sub forwardblock {
    my $self = shift;
    my $blocks = shift || 1;
    return $self->execute($self->{cmd}->{fsr}, $blocks);
}

sub backwardblock {
    my $self = shift;
    my $blocks = shift || 1;
    return $self->execute($self->{cmd}->{bsr}, $blocks);
}

1;