I assume you left the various warns in there just for development? The OS detection could be abstracted a bit further; some user control over it might not be a bad idea either. I'd also prefer if the commands produced Perlish boolean results, with an extra method to ask for the error code.
I'd pull together the declaration of variables with their initial assignment in many places, though one might argue that's just preference. You could use the boolean results of matches in your stat method. And a map in void context?! :-)
Some more abstraction would help. Note how your command routines all look almost the same. system LIST is usually better than system EXPR. Also, note how many of your routines call other command routines without checking intermediate results - not necessarily a good idea.
The hardest to refactor was your stat routine (status in my version; your status is called get_status there).
The following is untested due to lack of a magnetic tape. :-) It does compile properly at least. I left a couple of notes in a few places where I wasn't sure whether what you really meant.
#!/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: $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; $self{qw(error cmd)} = (0, { %tape_cmd, %{$os_specific_cmd{$self{o +s}}} }); 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 m +ap "$_\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;
Of course the POD will need some minor updates. :-)
Oh, you might possibly want to consider changing your copyright information - the standard boilerplate is "This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself." If you don't want that, make sure your copyright legally really means the things you want it to mean.
Makeshifts last the longest.
In reply to Re^2: Talking to Magnetic Tapes
by Aristotle
in thread Talking to Magnetic Tapes
by submersible_toaster
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |