#  CloseFiles.pl
#  Example 4.8:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script forcibly closes open files on servers that are opened by 
#  remote users.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use vars qw( $PATH );
use Getopt::Long;
use Win32::Lanman;

%PATH = (
    max     =>  45,
    filler  =>  ' ... ',
);

Configure( \%Config );
if( $Config{help} )
{
    Syntax();
    exit();
}

foreach my $FileID ( @{$Config{ids}} )
{
    my( %File );
    if( Win32::Lanman::NetFileGetInfo( $Config{machine}, $FileID, \%File ) )
    {
        undef %Data;
        $Data{path}  = $File{pathname};
        $Data{user}  = $File{username};
        $Data{locks} = $File{num_locks};
        $Data{id}    = $File{id};

        if( $PATH{max} < length( $Data{path} ) )
        {
            my $PathLength = int( ( $PATH{max} - length( $PATH{filler} ) ) / 2 );
            my $FillerLength = length( $PATH{filler} );
            $Data{path} =~ s/^(.{$PathLength})(.*?)(.{$PathLength})$/$1$PATH{filler}$3/;
        }

        if( ! Win32::Lanman::NetFileClose( $Config{machine}, $FileID ) )
        {
            my( %Temp ) = %Data;
            push( @Failed, \%Temp );
        }
        else
        {
            my( %Temp ) = %Data;
            push( @Succeeded, \%Temp );
        }
    }
    else
    {
        my %Temp = (
            id          =>  $FileID,
            pathname    =>  'File ID is not in use on this server.',
        );
        push( @Failed, \%Temp );
    }
}

if( scalar @Succeeded )
{
    print "\nThe following files were forced closed:\n";
    $~ = OUTPUT_HEADER;
    write;
    $~ = OUTPUT;

    foreach my $File ( @Succeeded )
    {
        %Data = %$File;
        write;
    }
}

if( scalar @Failed )
{
    print "\nThe following attempts to close files failed:\n";
    $~ = OUTPUT_HEADER;
    write;
    $~ = OUTPUT;

    foreach my $File ( @Failed )
    {
        %Data = %$File;
        write;
    }
}


format OUTPUT_HEADER=
@<<<<<< @<<<<< @<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'ID', 'Locks', 'User', 'Path'
------- ------ ------------------ --------------------------------------
.

format OUTPUT=
@>>>>>> @>>>>> @<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Data{id}, $Data{locks}, $Data{user}, $Data{path}
.

sub Configure
{
    my( $Config ) = @_;
    my $Result = 0;
    Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
    $Result = GetOptions( $Config, 
                qw(
                    machine|m=s
                    help|?|h
                ) );

    if( 0 == scalar @ARGV )
    {
        $Config->{help} = 1;
    }
    else
    {
        push( @{$Config->{ids}}, @ARGV );
    }

}

sub Syntax
{
    my( $Script ) = ( $0 =~ /([^\\\/]*?)$/ );
    my( $Line ) = "-" x length( $0 );

    print <<EOT;

$0
$Line
Force an open file on a server to close.

Syntax:
    perl $0 [-m Machine] FileID [ FileID2 [ ... ] ]
        -m..........Close files on the specified machine.
        FileID......The file ID of the open file.

EOT
}