Remove Starlink components from path-like variable

cleanstarpath

#!/usr/bin/perl

=head1 NAME

cleanstarpath - Remove Starlink components from path-like variable

=head1 SYNOPSIS

  setenv PATH `perl cleanstarpath PATH`
  setenv LD_LIBRARY_PATH `perl cleanstarpath LD_LIBRARY_PATH`

=head1 DESCRIPTION

Removes any components of a path-like variable that refer to the
current STARLINK_DIR. Takes a single argument naming the path-like
environment variable to be cleaned. Assumes colon separator.

=cut

use strict;
use File::Spec;

my $INPUT_ENV = shift(@ARGV);

die "Must supply an environment variable name\n"
  unless defined $INPUT_ENV;

die "Must supply an environment variable name that exists ($INPUT_ENV is undefined).\n"
  unless exists $ENV{$INPUT_ENV};

# if we do not have a STARLINK_DIR we return immediately
unless (exists $ENV{STARLINK_DIR} && defined $ENV{STARLINK_DIR}) {
  print $ENV{$INPUT_ENV}."\n";
  exit;
}

# Get an array of Starlink paths
my @starbits = File::Spec->splitdir( File::Spec->canonpath( $ENV{STARLINK_DIR} ) );

# Split the reference into components
my @comps = split(/:/, $ENV{$INPUT_ENV});

my @cleaned;
for my $c (@comps) {
  # Split directory into components
  my @envbits = File::Spec->splitdir( File::Spec->canonpath($c) );

  # compare
  my $matchcount = 0;
  for my $s (@starbits) {
    my $e = shift(@envbits);
    if ($e eq $s) {
      $matchcount++;
    }
  }

  # if we matched fewer than all of the Starlink path we keep it
  if ($matchcount < scalar(@starbits)) {
    push(@cleaned, $c );
  }
}

print join(":", @cleaned) ."\n";

=head1 AUTHOR

Tim Jenness E<lt>[email protected]<gt>

Copyright (C) 2012 Science and Technology Facilities Council.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 3 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful,but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place,Suite 330, Boston, MA  02111-1307, USA

=cut