Re^2: Talking to Magnetic Tapes

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.

Comment on Re^2: Talking to Magnetic Tapes Select or Download Code

Replies are listed 'Best First'.
Re: Re^2: Talking to Magnetic Tapes by submersible_toaster (Chaplain) on Nov 04, 2002 at 03:44 UTC
Cool! - This _almost_ went through without a hitch Aristotle. But first with the changes I made. The os detection still needs some work, I think that `my ($os) = grep $ostype =~ /$_/i, map quotemeta, keys %os_specific_cmd;` [download] is assigning the number of grep matches to $os, rather than $_ from a successful match. The assignment to @self{qw(error cmd)} required an extra set of curly-ones to enclose the hashes that are combined into $self->{cmd}. Fixed one typo ->{status} NOT ->{_status}. Despite what I believe to be valid syntax, the chaining with and is not honoured - even with parens after the method calls, so sadly these read &&. Used the @args variable within the scope of _meta because map complained about 'trying to modify readonly value' , which I presume to be @_. AUTOLOAD's method detection I have maybe over engineered, by adding $class, the regex also modified with the + immediatly after the character class, as opposed to after the parens.. (this would match only one char otherwise). Read more... (5 kB)	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re: Re^2: Talking to Magnetic Tapes
by submersible_toaster (Chaplain) on Nov 04, 2002 at 03:44 UTC

Cool! - This _almost_ went through without a hitch Aristotle. But first with the changes I made.

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

and