fuser i perl

[Jan Eggert Kofoed <sslug@sslug>]

Jeg kunne tænke mig at lave en liste over socket-filer i /tmp
og slette de, der ikke er i brug. /usr/sbin/fuser kan fortælle,
om en fil benyttes. Jeg kan klare dette i bash, og efterfølgende
kalde perl, men sådanne opgave kan sikkert klares helt i perl.

Grunden til min lyst til oprydning er, at hver gang kde har været
i sving, så efterlades nogle socket-filer af FileManager kfm.

Mine scripts (bash og perl):


==========================================================
#!/bin/sh

# Make a list of all socket files in /tmp
find /tmp -type s -name '*' -print 2>/dev/null 1> /tmp/jk_clean.sockets

# Make a list of socket files currently being used.
find /tmp -type s -name '*' -exec /usr/sbin/fuser {} \; 2>/dev/null |
awk '{print substr($1,1,length($1)-1);}' > /tmp/jk_clean.keep

./jk_clean_socks.pl
==========================================================
#!/usr/bin/perl -w

$keep_files="/tmp/jk_clean.keep";
$all_files="/tmp/jk_clean.sockets";

{ # Open $keep_files
    unless (open(KEEP_FILES,"<" . $keep_files))
    {
	die("Cannot open " . $keep_files);
    }
} # Open $keep_files

{ # Open $all_files
    unless (open(ALL_FILES,"<" . $all_files))
    {
	die("Cannot open " . $all_files);
    }
} # Open $all_files

{ # Read $keep_files into an array
    @keep_files = <KEEP_FILES>;
    for ( $i=0; $i<@keep_files; $i++ )
    {
	$keep_files{$keep_files[$i]} = $keep_files[$i];
    } # for $i
} # Read $keep_files into an array

while ( $line = <ALL_FILES> )
{
    if ( exists($keep_files{$line}) )
    {
	print "Keep this file: $line";
    }
    else
    {
	chomp($line);
	if ( unlink($line) )
	{
	    print "$line deleted\n";
	}
	else
	{
	    print "Cannot delete $line\n";
	}
    }
} # ALL_FILES
==========================================================

Jeg blev klar over, at perl meget let kan give mig information
om, at en fil er en socket (-S), men lod det være i bash.
Problemet er at teste om filen benyttes?

mvh
Jan Kofoed