TapeChanger::MTX - use 'mtx' to manipulate a tape library

  use TapeChanger::MTX;

  my $loaded = TapeChanger::MTX->loadedtape;
  print "Currently loaded: $loaded\n" if ($loaded);

  TapeChanger::MTX->loadtape('next');
  my $nowloaded = TapeChanger::MTX->loadedtape; 
  print "Currently loaded: $nowloaded\n" if ($nowloaded);

$VERSION = '1.01';

package TapeChanger::MTX;
# -*- Perl -*- Fri Jan 16 11:07:17 CST 2004 
###############################################################################
# Written by Tim Skirvin <tskirvin@ks.uiuc.edu>
# Copyright 2001-2004, Tim Skirvin and UIUC Board of Trustees.  
# Redistribution terms are below.
###############################################################################
my $VERSION = '1.01';

###############################################################################
### Initialization ############################################################
###############################################################################

require 5.6.0;
use strict;

###############################################################################
### Variables #################################################################
###############################################################################

                                         
use vars qw( $MTX $DRIVE $CONTROL $MT $EJECT $READY_TIME $DEBUG );

$MT      = "/usr/bin/mt";
$MTX     = "/usr/local/sbin/mtx";

$DRIVE   = "/dev/rmt/0";
$CONTROL = "/dev/changer";

$EJECT   = 1;

$READY_TIME = 60;

$DEBUG     = 0;

###############################################################################
### Internal Variables ########################################################
###############################################################################

## Define where .mtxrc actually is.  Doesn't get edited locally, so I'm not 
our $MTXRC     = "$ENV{HOME}/.mtxrc";	

## Default value for the internal "@RETURN".  
our @RETURN = ('');

###############################################################################
### Functions #################################################################
###############################################################################

sub tape_cmd { shift->_run("$MTX -f $CONTROL @_") }
sub mt_cmd   { shift->_run("$MT -f $DRIVE @_") }

### _run( STRING )
# Actually does the work of 'tape_cmd' and 'mt_cmd'.  Just runs the
# command that's supposed to be run.  Puts the return text into @RETURN 
# for future reference.  

sub _run {
  my ($self, $string) = @_;
  warn "$string\n" if debug();
  my @return;  
  my $return = open (CMD, "$string 2>&1 |") or
                        (warn "Couldn't run $string: $!\n" and return undef);
  if (debug()) { foreach (<CMD>) { print; chomp; push @return, $_ } } 
  else         { @return = <CMD>; chomp @return; }
  close(CMD);
  @RETURN = @return || ('');
  wantarray ? @return : join("\n", @return);
}

sub numdrives    { (shift->_getchangerparms)[0] || 0 }
sub numslots     { (shift->_getchangerparms)[1] || 0 }
sub loadedtape   { (shift->_getchangerparms)[2] || 0 }
sub numloaded    { (shift->_getchangerparms)[3] || 0 }
sub nummailslots { (shift->_getchangerparms)[4] || 0 }

### _getchangerparms ()
# Does the work for the above functions.
sub _getchangerparms {
  my ($self) = @_;
  my @status = split("\n", $self->tape_cmd('status'));
  unless ($? eq 0) { return (0, 0, 0, 0, 0) }
  
  my ($numdrives, $numslots, $loadedtape, $numloaded, $mailslots) = 0;
  foreach (@status) 
   {
    if (/^Data Transfer Element/) 
       { 
       $numdrives++;
       if (/\(Storage Element (\d+) Loaded\).*$/) 
         { $loadedtape = $1, $numloaded ++ };
       }
    else
       { 
       if (/^\s*Storage Element \d+/) { $numslots++ };
       if (/^\s*Storage Element \d+ IMPORT\/EXPORT:/) { $mailslots++ };
       };
   }
  ($numdrives, $numslots, $loadedtape, $numloaded, $mailslots);
}

sub slothash {
  my $self = shift;
  my %slots;
  my @status = split("\n", $self->tape_cmd('status'));
  my @slot;
  unless ($? eq 0) { return undef }
  foreach (@status) {
    if (/^\s*Storage Element (\d+)(\s([^:]*))*:([^(:|\s)]*)\s*(:VolumeTag=([^\s]*))*.*/) {
    # $1-slot number, $3-slot type, $4-Full or Empty, $6 Volume tag if exist
    @slot=($3,$4,$6);
    $slots{$1}=[@slot]
    }
  }
 %slots;
}

sub drivehash()
{
  my ($self) = shift;
  my %drives;
  my @status = split("\n", $self->tape_cmd('status'));
  my @drive;
  unless ($? eq 0) { return undef }
  foreach (@status) {
    if (/Data Transfer Element (\d+):([^\s|\(]*)(\s*\(Storage Element (\d+) Loaded\))*(:VolumeTag = ([^\s]*))*.*/) {
      # $1-drive number, $2-Full, $4-Element loaded ,$6-VolumeTag
      @drive=($2,$4,$6);
      $drives{$1}=[@drive];
    }
  }
 %drives;
}

sub loadtape {
  my ($self, $slot, $drive) = @_;	$drive ||= 0;
  
  if    (lc $slot eq 'current') { $self->loadedtape } 
  elsif (lc $slot eq 'prev')    { $self->loadprevtape($drive) }
  elsif (lc $slot eq 'next')    { $self->loadnexttape($drive) } 
  elsif (lc $slot eq 'first')   { $self->loadfirsttape($drive) }
  elsif (lc $slot eq 'last')    { $self->loadlasttape($drive) }
  elsif (lc $slot =~ /^(\d+)$/) { $self->_doloadtape($1, $drive) }
  else { return "No valid slot specified" }

  $self->checkdrive || return "Drive wouldn't report ready: @RETURN\n";
}

### _doloadtape( SLOT, DRIVE )
# Does the actual work for loading tapes, when it's not done by mtx itself.
sub _doloadtape {
  my ($self, $slot, $drive) = @_;  $slot ||= 0;
  my $loaded = $self->loadedtape || 0;
  return 1 if ($slot eq $loaded);
  if ($loaded) { $self->_ejectdrive && $self->tape_cmd('unload') }
  $loaded = $self->loadedtape || 0;
  return "Couldn't unload tape $loaded" if $loaded;
  $slot ? $self->tape_cmd('load', $slot, $drive) : "No slot to load";
}

sub loadnexttape  { 
  my $self = shift;
  $self->_ejectdrive();
  $self->tape_cmd('next',     @_) 
}
sub loadprevtape  { 
  my $self = shift;
  $self->_ejectdrive();
  $self->tape_cmd('previous', @_) 
}
sub loadfirsttape { 
  my $self = shift;
  $self->_ejectdrive();
  $self->tape_cmd('first',    @_) 
}
sub loadlasttape  { 
  my $self = shift;
  $self->_ejectdrive();
  $self->tape_cmd('last',     @_) 
}

sub transfertape {
  my ($self, $from, $to) = @_;
  my %slots = $self->slothash;
  
  if ($slots{$from}[1] eq 'Empty') {
    print "Cannot transfer from Empty slot\n";
    return 1;
  }
  if ($slots{$to}[1] eq 'Full') {
    print "Cannot transfer to Full slot\n";
    return 1;
  }
  $self->tape_cmd('transfer', $from, $to);
}

sub tagtoslot {
  my ($self, $tag) = @_;
  chomp($tag);
  my @status = split("\n", $self->tape_cmd('status'));
  unless ($? eq 0) { return 0 }
   
  my $slot;
  foreach( @status ) {
    if (/^\s*Storage Element (\d+)[^:]*:Full :VolumeTag=$tag/) { $slot = $1 }
  }
  $slot || 0;
}

sub slottotag {
  my ($self, $slot) = @_;
    
  my @status = split("\n", $self->tape_cmd('status'));
  unless ($? eq 0) { return 0 }

  my $tag = "";
  foreach(@status) {
    if (/^\s*Storage Element $slot[^:]*:Full :VolumeTag=(.*)/) { $tag = $1 }
  }
  return $tag;
}

sub tagtodrive {
  my ($self, $tag) = @_;

  chomp($tag);
  my @status = split("\n", $self->tape_cmd('status'));
  unless ($? eq 0) { return -1 }
  
  my $drive;
  foreach(@status) {
    if (/^Data Transfer Element (\d+):Full (Storage Element \d+ Loaded):VolumeTag = $tag/) { $drive=$1 }
  };
  return $drive || -1;
}

sub drivetotag {
  my ($self, $drive) = @_;

  my @status = split("\n", $self->tape_cmd('status'));
  unless ($? eq 0) { return '' }

  my $tag;
  foreach (@status) {
    if (/^Data Transfer Element $drive:Full \(Storage Element \d+ Loaded\):VolumeTag = ([^\s]*)/) { $tag=$1 }
  }
  return $tag || "";
}

sub ejecttape {
  my ($self, $drive) = @_;	$drive ||= 0;
  my ($drives, $slots, $loaded) = $self->_getchangerparms;
  if ($loaded) {
    $self->_ejectdrive($drive);
    $self->tape_cmd('unload');   
    return $? ? 0 : 1;
  } else { return 1 }	# Already unloaded
}

### _ejectdrive ( [DRIVE] )
# Does the rewinding, and that's it
sub _ejectdrive {
  my ($self) = @_;
  my $loaded = $self->loadedtape;
  return 1 unless $loaded;
  if ($EJECT) { 
    $self->mt_cmd('rewind');
    if ($? ne 0) { 	# rewind failed
      return 0 if ($RETURN[0] !~ /no tape/);	# not because there was no tape
    }
    $self->mt_cmd('offline');
  } 
  1;
}

sub resetchanger {
  my ($self) = @_;
  $self->_ejectdrive;
  $self->loadtape('first');
}

sub checkdrive {
  my ($self) = @_;
  my $start = time;	# We're using clock-seconds here
  while (time - $start < $READY_TIME) {	
    $self->mt_cmd('status');
    return 1 unless $?;
    sleep 1;
  }
  return 0;
}

sub reportstatus { (shift->loadedtape || 'unloaded') . " $DRIVE" }

sub inventory  { shift->tape_cmd('inventory'); }

sub cannot_run {
  my @problems;

  unless (-x $MTX)     { push @problems, "Can't run $MTX" }
  unless (-x $MT)      { push @problems, "Can't run $MT" }
  unless (-r $DRIVE)   { push @problems, "Can't read from $DRIVE" }
  unless (-w $DRIVE)   { push @problems, "Can't write to $DRIVE" }
  unless (-r $CONTROL) { push @problems, "Can't read from $CONTROL" }
  unless (-w $CONTROL) { push @problems, "Can't write to $CONTROL" }
  
  return scalar @problems ? @problems : ();
}

###############################################################################
### Internal Subroutines ######################################################
###############################################################################

sub doit { 
  my $file = shift || return undef;
  if (-f $file) { 
    my $return = do $file;
    unless ($return) {
      warn "couldn't parse $file: $@" if $@;
      warn "couldn't do $file: $!" unless defined $return;
      warn "couldn't run $file" unless $return;
    }
    $return;
  } else { return undef }
}

sub debug { $DEBUG > 0 ? 1 : 0 }
sub quiet { $DEBUG < 0 ? 1 : 0 }

###############################################################################
### main() ####################################################################
###############################################################################

doit($MTXRC);		# Override the defaults with what's in $MTXRC
1;

##### Version History
# v0.5b 	Fri Nov  9 15:39:15 CST 2001
### Initial version, based off old mtx-changer code (also self-written).
### Documentation and such are written.
# v0.51b 	Tue Nov 13 09:16:49 CST 2001
### Took out support for multiple drives in the 'eject' option, because it 
### operates weirdly.  'reportstatus' is a bit different.
# v0.60b	Tue Nov 13 16:00:29 CST 2001
### Fixed 'nexttape' and such to eject the drive first.  
# v0.61b	Fri Dec 14 15:22:25 CST 2001
### Took out 'eject from drive #' from eject(), because it didn't work.
# v0.70b	Fri Feb  1 13:13:08 CST 2002
### Fixed _doloadtape() to eject the tape first.
# v0.71b	Fri Feb  1 13:38:13 CST 2002
### Changed _doloadtape() again to check the return status
# v1.00		Fri Jan 16 11:07:23 CST 2004 
### Might as well make this v1.0 some time.  Added a fair bit of contributed 
### code to support multi-slot tape drives and volume tags.
# v1.01		Mon Mar 01 16:57:54 CST 2004 
### Doesn't echo STDERR in _run() anymore, which makes things look
### cleaner, unless we're debugging.