Automaticaly remove old clearcase dinamic views

If you ever had control over a clearcase view server in a medium/big development team, you did encounter this issue for sure: many dinamic views left unused on the view server tacking up space (either team member moved away and left their views behind, new projects apeared and team member forgot about their old views, and so on).

Faced with these issue, I cooked up a short perl script that periodicaly (run by cron weekly) check for views older than 6 months (180 days) and notify the users about their old views being removed next time (one week in future).
Also it forces undo checkouts to avoid troubles.

Bellow is the script:


#!/usr/bin/env perl -w
#===============================================================================
#
# FILE: rm_old_views.pl
#
# USAGE: ./rm_old_views.pl
#
# DESCRIPTION: Remove clearcase views not touched in last 6 months
#
# AUTHOR: MariusCC
# VERSION: 1.0
# CREATED: 08/22/2008 03:08:43 PM Russian Standard Time
# REVISION: 1.0
#===============================================================================

use strict;
use warnings;
use Carp;
use Getopt::Long;
use File::Temp qw/tempfile tempdir/;
use File::Copy;
use Sys::Hostname;

my ($debug, $hostname, $mailhost, $help, $workdir, $lastused, @cmd);

GetOptions(
'debug+' => \$debug,
'hostname:s' => \$hostname,
'mailhost:s' => \$mailhost,
'workdir:s' => \$workdir,
'lastused:s' => \$lastused,
'help' => \$help
);
&usage() if $help;

#set default options
$debug ||= 0;
$mailhost ||= "smtp.yourdomain.com";
$workdir ||= "/var/spool/rmviews";
$hostname ||= hostname();
mkdir $workdir if (!-d $workdir); #create workdir if it doesn't exist
$lastused ||= 180 * 86400;
$lastused = time() - $lastused; #go back a number of days in the past

#define utilities
my $ct = '/usr/atria/bin/cleartool';
my $allviewslst = "$workdir/allviews.lst";
my $oldviewslst = "$workdir/oldviews.lst";
my $lock = "$workdir/lock";

#
#subroutines used in script
#

#execute a system call
sub _system (@) {
my @args = @_;

system(@args) and warn "Could not fork @args\n";
}

#open a file and return the handle
sub _open ($) {
my ($file) = @_;

open(my $fh, $file) or croak "Could not open $file: $!\n";
return ($fh);
}

#remove an old view
sub rmview($) {
my $view = $_;

if (checkoldview($view)) {

#for each view list checkouts, if they exist force unco, then remove view
$view =~ /\/(\w+)\.vws/g; #get view tag
my $viewtag = $1;
my $lsco = "$workdir/lsco";
my @args = qq/$ct setview -exec "$ct lsco -cview -avobs -short |sort > $lsco" $viewtag/;
if ($debug){
print "executing @args\n";
}else{
_system(@args);
}
if (-f $lsco) {
my $fh = _open($lsco);
while (<$fh>) {
@args = qq/$ct setview -exec "$ct unco -rm $_" $viewtag/;
if ($debug){
print "executing @args\n";
}else{
_system(@args);
}
}
close $fh if defined $fh;
undef $fh;
unlink $lsco;
}
@args = qq/$ct rmview -force $view/;
if ($debug){
print "executing @args\n";
}else{
_system(@args);
}
}
}

#check if a view is older then $lastused, return 0/1
sub checkoldview($;$) {
my $view = $_;
my $forcemail = $_;
undef $forcemail if $debug;

my $oldview = 0;
if ($view =~ /\/*.\.vws/i) { #skip garbage from list
$view =~ s/\n//;
if (-d $view) {
print "analize $view/.access_info\n" if $debug;

#my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) =
my @stats = stat "$view/.access_info" if (-f "$view/.access_info");
print "uid=$stats[4]\nmtime=$stats[9]\n" if $debug;
if ($stats[9] < $lastused) {
print "view $view is old\n" if $debug;
my $uid = $stats[4];
$oldview++;
mailuser($view, $uid) if $forcemail;
}
}
}
return $oldview;
}

#mail a user regarding an old view
sub mailuser($$) {
my $view = shift;
my $uid = shift;

$view =~ /\/(\w+)\.vws/g; #get view tag
$view = $1;
print "view tag to be removed: $view\n" if $debug;
print "get name for $uid\n" if $debug;
my $name = getpwuid($uid);
my $name ||= 'root';
my $mailtxt = "$workdir/mailtxt_$name";
$name .= '@yourdomain.com';
print "mail to $name\n" if $debug;
my $fh = _open "> $mailtxt";
my $rmtime = localtime(time() + 604800); #add 7 days from now
print "remove time is $rmtime\n" if $debug;
print $fh <Please read this message in its entirety to avoid losing valuable
project data. In accordance with the Company Management Policy, the
view $view is scheduled to be removed on $rmtime.
If you do not remove or write to the view $view,
it will be removed on $rmtime.
************************************************************************
View info
EOF
close $fh if defined $fh;
undef $fh;
my @args = qq/$ct lsview -long $view >> $mailtxt/;
_system(@args);
@args = qq/cat $mailtxt | \/usr\/bin\/mailx -s "View removal notice: $view" $name/;
print "exec @args\n" if $debug;
_system(@args);
unlink $mailtxt;
}

sub usage() {
print "\n\nUsage : rm_old_views [--option] Remove views not used in the last 6 months using options\n";
print " --debug Run in debug mode\n";
print " --hostname Remove only views hosted on hostname\n";
print " --help This one ;)\n";
exit(1);
}

#
#END of subs definitions
#

#define some more vars
my ($fhr, $fhw, @stats);

die "Another instance of $0 is running!\n" if (-f $lock);
@cmd = qq/date > $lock/;
_system(@cmd);

#remove oldviews from $oldviewslst
if (-f $oldviewslst) {
$fhr = _open($oldviewslst);
while (<$fhr>) {
rmview($_);
}
close $fhr if defined $fhr;
}

#find all views on host
@cmd = qq/$ct lsview \| \/usr\/bin\/grep -i $hostname \| \/usr\/bin\/awk \'{print \$2}\' > $allviewslst/;
_system(@cmd);

#find out how old are they, and add older ones to $oldviewslst
$fhr = _open($allviewslst);
$fhw = _open "> $oldviewslst";
while (<$fhr>) {
my $vws = $_;
$vws =~s/\n//g;
print $fhw "$vws\n" if (checkoldview($vws,1));
}
close $fhr if defined $fhr;
close $fhw if defined $fhw;

@cmd = qq/rm -fr $lock/;
_system(@cmd);