swg-main/tools/coremail.pl

#!/usr/bin/perl

die "usage: coremail.pl original_core_directory save_core_directory email_to [... email_to]\n" if (@ARGV < 3);

$coreDirectory = shift;
$saveDirectory = shift;

# pick a name for the backup file
open(DATE, "date \"+%Y%m%d_%H%M\" |");
$date = <DATE>;
chomp $date;
close(DATE);

# make the destination directory
mkdir($saveDirectory);

# search for new core files
$cores = 0;
opendir(DIR, $coreDirectory) || die "could not open directory $_\n";
@files = readdir(DIR);
closedir(DIR);
foreach (@files)
{
	if (/core\./)
	{
		$cores += 1;

		$new = $_;

		$new =~ s/\./\.$date\./;
		system("mv $coreDirectory/$_ $saveDirectory/$new");
		
		$exe = "";
#		open(GDB1, "gdb -batch -c $saveDirectory/$new |");
#		while (<GDB1>)
#		{
#			chomp;
#			$exe = $_ if (s/^Core was generated by \`// && s/ .*//);
#		}
#		close(GDB1);

#		push(@cores, "$saveDirectory/$new\t$exe\n");

#		if ($exe ne "")
#		{
#			open(BT, ">/tmp/gdb.bt");
#			print BT "bt\n";
#			close(BT);

#			open(GDB2, "gdb $coreDirectory/$exe $saveDirectory/$new -batch -x /tmp/gdb.bt |");
#			while (<GDB2>)
#			{
#				push(@cores, "\t" . $_);
#			}
#			close(GDB2);

#			unlink("/tmp/gdb.bt");
#		}		
#		else
#		{
#			open(FILE, "file $saveDirectory/$new |");
#			close(FILE);
#			while (<FILE>)
#			{
#				push(@cores, "\t" . $_);
#			}
#			close(FILE);
#		}

		system("gzip $saveDirectory/$new");
	}
}

# send out mail if necessary
if ($cores)
{
	# get the host name
	open(HOSTNAME, "hostname -s |");
	$hostname = <HOSTNAME>;
	close(HOSTNAME);
	chomp $hostname; 

	# send the email
	$s = "";
	$s = "s" if ($cores > 1);
	open(MAIL, "| mail -s \"[cores] $hostname has $cores new core file$s\" " . join(" ", @ARGV), );
	print MAIL join("", @cores);
	close(MAIL);
}