More comments.

$self{qw(error cmd)} is of course just a typo that was meant to be @self{qw(error cmd)}.

I suspect the and vs && issue is due to my not using parens there. Writing $self->endofdata() probably would fix it - if it does, I'd prefer that version as I find and a lot more readable.

I specifically didn't want the assertions block to return $ERROR, because then you can say

my $tape = Device::MagneticTape->new(..) or die Device::MagneticTape->
+error();

# instead of

my $tape = Device::MagneticTape->new(..);
die $tape unless ref $tape;

[download]

The intent in the second version is not readily discernible, and $tape is not a name for something I'd expect to find an error message in. Actually, the point in going through the whole hoopla of writing the _assert() function was to be able to easily provide Device::MagneticTape->error() for the calling code.

The $self{os} block malfunctions because of the dummy entry in %os_specific_cmd and due to scalar context forced by the || after the block. That piece of code will need some unravelling to function correctly..

Not closing $rdh and $wrh in the status method shouldn't have any effect since they're lexicals - they go out of scope at the end of the function and are consequently autoclosed anyway. Is status behaving correctly? That's the one part of the code where I casted enough sorcery to be unsure whether it's bugfree with just a cursory look, but since as I said I don't have a tape drive I coudn't verify.

Also, you are no longer calling execute from anywhere so you can roll it into AUTOLOAD.

But as the module's user I would still like to have the long function names - I wouldn't want to have to learn the cryptic mt syntax. Besides, if this module is ever split to multiple backends so it can, f.ex, also control tapes on Windows with the native methods offered there, the mt syntax would be out of place. You want to offer your own consistent interface. But there's no reason why one shouldn't be able to do that using AUTOLOAD, and that way we also get rid of gotoend().

So, another round:

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

$VERSION=0.1;

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)} = @_;

    $self{os} ||= {
        chomp (my $ostype = `uname`);
        my ($os) =
            grep $ostype =~ /$_/i,
            map quotemeta,
            keys %os_specific_cmd;
        $os;
    };

    _assert(not $self{os} or exists $os_specific_cmd{$self{os}}, "Unkn
+own 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;
    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()
        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() && $self->forwardspace($pos);
} 

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

sub _meta {
    my $self = shift;
    my $cmd = shift;
    my $mode = ('<', '>>')[shift]; # 0=read, 1=write

    return
        unless $self->$cmd()
        and open my $handle, $mode, $self->{device};

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

sub AUTOLOAD {
    my $self = shift;

    my ($method) = $AUTOLOAD =~ m/::([^:])+$/;
    $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->execute($self->{cmd}->{$method}, @_;

    return $self->{error} == 0;
}

1;

[download]
Please tell me how well these work.

Makeshifts last the longest.

In reply to Re^2: Talking to Magnetic Tapes by Aristotle
in thread Talking to Magnetic Tapes by submersible_toaster

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.