in reply to Talking to Magnetic Tapes

Inspired to clean up my code (slightly) here is a wrapper for mt. I'm eager for fellow monks to give me some feedback on this. 
#!/usr/bin/perl -w
package Device::MagneticTape;
use Data::Dumper;
use strict;

my %self;
my %cmd;
my %dc = ( fsf=>'fsf',
        bsf=>'bsf',
        eod=>'eod',
        unload=>'unload',
        fsr=>'fsr',
        bsr=>'bsr',
        status=>'status',
        exist=>'exist',  
        rewind=>'rewind'
      );

my %statval = ( eof=>'EOF' ,
                bot=>'BOT' ,
                eot=>'EOT' ,
                eod=>'EOD' ,
                online=>'ONLINE' ,
                dr_open=>'DR_OPEN' ,
                busy=>'BUSY' ,
              );

my %linux = ( unload=>'eject' );
my %irix = ( eod=>'feom' );

my $ostype = `uname`;
chomp $ostype;

%cmd = ( %dc , %linux ) if ($ostype =~ /linux/i);
%cmd = ( %dc , %irix ) if ($ostype =~ /irix/i);



sub new { 
  my $self = shift;
  my $device = shift;
  my $mt = shift;
  my %tape = ( mt => $mt,
            device => $device,
            command => "$mt -f $device "
          );
  # Sanity check the device and mt binary
  # if all is good then bless %tape and return,
  return bless {%tape} , $self;
}

# END contsructor


#Methods;

sub rewind {
  my $self = shift;
  my $command = $self->{command} . $cmd{rewind};
  warn "rewind\n";
  my $err;
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}
 
sub gotoend {
  my $self = shift;
  my $command = $self->{command} . $cmd{eod};
  my $err;
  warn "gotoend\n";
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub goto {
  my $self = shift;
  my $val = shift; 
  $self->rewind;
  return $self->forwardspace($val);
} 

sub forwardspace {
  my $self = shift;
  my $distance = shift;
  my $err;
  $distance = 1 unless defined $distance;
  warn "forwardspace $distance\n";
  my $command = join " " , $self->{command} ,  $cmd{fsf} , $distance;

  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub backwardspace {
  my $self = shift;
  my $distance = shift;
  my $err;
  $distance = 1 unless defined $distance;
  warn "backwardspace $distance\n";
  my $command = join " " , $self->{command} ,  $cmd{bsf} , $distance;
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub forwardblock {
  my $self = shift;
  my $blocks = shift;
  my $err;
  
  $blocks = 1 unless defined $blocks;
  warn "forwardblock $blocks\n";
  my $command = join " " , $self->{command} ,  $cmd{fsr} , $blocks;
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub backwardblock {
  my $self = shift;
  my $blocks = shift;
  my $err;
  $blocks = 1 unless defined $blocks;
  warn "backwardblock $blocks\n";
  my $command = join " " , $self->{command} ,  $cmd{bsr} , $blocks;
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub endofdata {
  my $self = shift;
  my $err;
  warn "endofdata\n";
  my $command = join " " , $self->{command} ,  $cmd{eod};
  $self->stat;
  $err = system ( $command ) unless ($self->{busy});
  return $err;
}

sub stat { 
  my $self = shift;
  my $command = join " " , $self->{command} , $cmd{status};
  warn "stat\n";
  my @stats = `$command`;
  # Blank the hash
  map {$self{$_}=0} keys %statval;

  foreach (@stats) { 

    $self->{busy} = 1 if ($_ =~ /resource busy/i);

    $self->{bot}=1 if ( $_ =~ / bot /i );
    $self->{bot}=0 if ( $_ =~ /not at bot/i );

    $self->{eod}=1 if ( $_ =~ / eod /i );

    $self->{eof}=1 if ( $_ =~ / eof /i );
    $self->{eof}=1 if ( $_ =~ /at fmk /i );

    $self->{wr_prot}=1 if ( $_ =~ / wr_prot /i );
    $self->{online}=1 if ( $_ =~ / online /i ); 
  }
  print "\nStatComplete\n";
}

# MetaMethods
sub new_media { 
 my $self = shift;
 my $name = shift;
 chomp $name;
 $self->rewind;
 open ( INDEX , '>>' , $self->{device} ) || die "Cant make newmedia $!
+";
 print INDEX "$name\n";
 close INDEX;
}
sub writeindex {
 my $self = shift;
 my @index = @_;
 chomp(@index);
 $self->gotoend;
 unshift (@index , $self->{mastername});
 print "Writing Index\n";
 open ( INDEX , '>>' , $self->{device} ) || die "Cant write index $!";
 print INDEX  join "\n" , @index;
 close INDEX;
}

sub getindex {
 my $self = shift;
 my @index;
 $self->positionforwrite;
 open( INDEX , $self->{device} ) || die "Can't open index from device"
+ ;
 @index = <INDEX>;
 close INDEX;
 my $name = shift @index;
 chomp($name);
 $self->{mastername} = $name ;
 print "Media Label : ".$self->{mastername} . "\n";
 my $i=0;
 #foreach (@index) {
 # print "$i : $_";
 # ++$i;
 #}
 return @index;
}


sub positionforwrite {
 my $self = shift;
 $self->gotoend;
 $self->backwardspace(1);
 $self->backwardblock(1);
}

#writemyindex

#getmyindex

# Data Accessors

sub status {
  my $self = shift;
  my $var = shift;
  return "" unless defined $var;
  return $self->{$var};
}

1;

=head1  NAME

 Device::MagneticTape

=head1  SYNOPSIS

 my $tape = Device::MagneticTape->new( $device , $mtbin );
 my @index =  $tape->getindex;
 $tape->positionforwrite;
 my $target = '/something/to/archive'
 # write to tape using your favorite archiver 
 push (@index , $target);
 $tape->writeindex(@index); 

 The standard methods return the same exit status as mt, generally thi
+s is - 0 for success. 1 for unrecognised commands. 2 if an operation 
+fails. A method will return an undef if it was unable to execute due 
+to the device being 'busy'.

=head1  METHODS
 
 
=over 1

=head2 new ( $device , $mtbin )

takes two arguments, the device to use (make sure you use NO-rewind), 
+and the path to your system's mt binary. Returns a new Device::Magnet
+icTape object with the following methods.


=head2 rewind

Rewind the tape. erm..
 

=head2 gotoend

Space forward on the tape until reaching the end of data (B<EOD>). 
 

=head2 goto ( $tapefile )

Goto the numeric tapefile from BOT. Remember the first tapefile is num
+ber 0. 
 
=head2 forwardspace ( $distance )

Space forware $distance tapefiles.
 
=head2 backwardspace ( $distance ) 

Space backward $distance tapefiles. B<Note: To position correctly for 
+a read you should also move forwardblock(1) after any backwardspace>.
 
=head2 forwardblock ( $blocks )

Move forward on the tape any given number of $blocks.

 
=head2 backwardblock ( $blocks )

Move backward on the tape any given number of $blocks.


=head2 endofdata

See B<gotoend> above.


=head2 stat

Query the object's status as given by 'mt -f /dev/tape stat'. 


=back 1

=head1 META-METHODS

In addition to supporting basic tape transport, the following methods 
+are provided.

=over 1

=head2 new_media ( $name )

Create the first instance of an index on the current object, $name def
+ines the media name.

=head2 writeindex ( @index )

Accepts a list as it's argument , writeindex will update the tape inde
+x to reflect @index.


=head2 getindex 

Returns a list as it was stored by ->writeindex


=head2 positionforwrite 

Positions the tape on the FMK B<before> the index is stored. When usin
+g indexed tapes, ->positionforwrite B<before> appending to a tape.


=back 1

=head1 BUGS

Bound to be really, you should let me know if you find them <abramble@
+bigpond.net.au>. I would think this POD still needs work. 

=head1 AUTHOR

Andrew Bramble <abramble@bigpond.net.au>

=head1 SEE ALSO

mt(1) , st(4)

=head1 COPYRIGHT

Copyright 2002 Andrew Bramble <abramble@bigpond.net.au>
Now hear this. Distribute, repair, reuse, recycle, modify as much as y
+ou like or can - it's free.

=cut

[download]

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

    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;

    [download]

    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.

[reply]
[d/l]

In Section Meditations