in reply to Talking to Magnetic Tapes

Thanks Aristotle for turning my module inside out. I'm still struggling to work it all out.
I found that this line in the constructor.
$self{qw(error cmd)} = (0, { %tape_cmd, %{$os_specific_cmd{$self{os}}} + });

would create $self->{errorcmd} instead of setting error=>0 and cmd=>{hashstuff}
So I put this one on two lines and it worked.

$self{error}=0; $self{cmd}= { %tape_cmd , %{os_specific_cmd{$self{os}}} };

One thing that has put me into a tailspin is your use of $" and $/ . As an interesting aside, I think there is a misprint in Perl In a Nutshell-2ndEdition , whilst the index points to page 55 for global variable $" , page 55 claims the list separator is either $ or $LIST_SEPARATOR, no mention of $" - hmmm.

This will compile on perl5.6.1 , my poor Indy's/Octane's are still on 5.004 (something that will be remedied asap). I will read further into the behaviour of IPC::Open2 , I'm not certain yet but something is now breaking the get_index method. More on this as I investigate.

I think OO and hashes and nested data are slowly beginning to make sense to me.

Update : Have made some more modifications around some of the logic here, Aristotle wisely spoke of examining more closely the return values of each methodcall. I discovered that the lowerprecedence 'and' used in the position_for_write method was only calling one thing.

return $self->endofdata and $self->backwardspace(1) and $self->backwardblock(1);
Only ever executes 'endofdata' , whereas
return $self->endofdata && $self->backwardspace(1) && $self->backwardblock(1);
behaves as I would expect.
Reading about 'or' vs '', '&&' vs 'and' didn't really explain this though.


Update: More abstraction/less abstraction, I wonder about the needs for methodnames like backwardspace, forwardspace . Decided to catch-all the commands in %cmd via AUTOLOAD and execute them, applying this to Aristotle's code reduces to workhorses down to an execute method and the AUTOLOADer.

#!/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: $sel +f{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{$se +lf{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;

Replies are listed 'Best First'.
Re^2: Talking to Magnetic Tapes
by Aristotle (Chancellor) on Oct 31, 2002 at 22:01 UTC

    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;

    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:

    Please tell me how well these work.

    Makeshifts last the longest.

      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;
      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).