#!/usr/bin/perl
# Cleans up stale files left by CGI:IRC processes not exited properly
# It basically deletes all files older than an hour which exist under the
# CGI:IRC temp prefix.
use strict;
use vars qw/%config/;

# CHANGE ME! (to the location of the configuration file)
$config{file}="/home/dgl/httpd/cgi-bin/cgiirc/config";

&config($config{file});
$config{tmpfile_prefix} =~ /^(.*)\/([^\/]+)$/;
my ($dir,$prefix)=($1,$2);

opendir(TMP, $dir);
while($_ = readdir(TMP)){
   next if $_ !~ /^\Q$prefix\E/;
   if((stat($dir."/".$_))[8] < time-3600){
	  unlink($dir."/".$_) or print "Unable to delete $dir/$_\n";
   }
}
closedir(TMP);

sub config{
   my $file=shift;
   my $section;
   # I wonder how you are 'supposed' to do this?
   no strict "refs";
   open(CONFIG, $file) or die("Unable to open config file");
   while(<CONFIG>){
      chomp;
      next if /^(#|;)/;
      next if $_ !~ /^\S/;
      if(/^\[(\w+)\]$/){
         my $tmp=$1;
         $section= \%$tmp;
      }else{
         my($key,$value)=split(/=/,$_,2);
         $$section{$key}=$value;
      }
   }
   close(CONFIG);
}

