#  Documents.pl
#  Example 4.9:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script will attempt to discover what type a file is and rename 
#  it to reflect the document type.  THis is useful if you have 
#  documents that have lost their extensions due to file renaming.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Win32::OLE;

my %Total = (
    tested    =>  0,
    files     =>  0,
    recovered =>  0,
);
foreach my $Mask ( @ARGV )
{
    if( $Mask =~ /[*?]/ )
    {
        push( @FileList, glob( $Mask ) );
    }
    else
    {
        push( @FileList, $Mask );
    }
}

foreach my $File ( @FileList )
{
    my $Obj;
    next if( $File eq "." || $File eq ".." );

    $Total{files}++;
    print "$Total{files}) '$File' ";

    if( $Obj = Win32::OLE->GetObject( $File ) )
    {
        my( $Type, $Ext, $Subject, $Title );
        my $NewFileName = "";

        $Total{recovered}++;

        $Type = join( "", Win32::OLE->QueryObjectType( $Obj ) );
        $App  = $Obj->{Application}->{Name};
        if( $App =~ /word/i )
        {
            $Ext = ".doc";
            $Total{type}->{word}++;
        }
        elsif( $App =~ /excel/i )
        {
            $Ext = ".xls";
            $Total{type}->{excel}++;
        }
        elsif( $App =~ /project/i )
        {
            $Ext = ".mpp";
            $Total{type}->{project}++;
        }
        elsif( $App =~ /powerpoint/i )
        {
            $Ext = ".ppt";
            $Total{type}->{powerpoint}++;
        }
        else
        {
            $Ext = ".$Type";
            $Total{type}->{lc $Type}++;
        }

        $Title = $Obj->BuiltinDocumentProperties( "Title" )->{Value};
        $Subject = $Obj->BuiltinDocumentProperties( "Subject" )->{Value};

        my ( $Path, $FileName, $FileExt ) = ( $File =~ /(.*?[\\\/]?)([^\\\/]*?)(\..*)$/ );
        if( ( "" ne $Title ) || ( "" ne $Subject ) )
        {
            $FileName = ( "" ne $Title )? $Title : $Subject; 

            # Replace any bad chars
            $FileName =~ s/[\\\/.?*]/-/g;
            $FilePath = "$FileName$Ext";
        }    
        print " $App document\n";
        
        if( ( $Ext ne $FileExt ) && ( $File ne $FilePath ) )
        {
            my $iCount = 1;
            while( ( -e "$Path$FilePath" ) || ( defined $UsedFileNames{lc $FilePath} ) )
            {
                $iCount++;
                $FilePath = "$FileName$iCount$Ext";
            }
            $UsedFileNames{lc $FilePath} = 1;
            push( @RenameFiles, [$File, $FilePath] );
        }
        else
        {
            print " No need to rename. The file is correctly named already.\n";
        }

        # Try to properly close the application
        if( ! $Obj->Close( 0 ) )
        {
            if( ! $Obj->Quit( 0 ) )
            {
                $Obj->Exit( 0 );
            }
        }
    }
    print "\n";
}

print "Renaming files:\n" if( scalar @RenameFiles );
foreach $File ( @RenameFiles )
{
    my $Result = 0;
    print "  '$File->[0]' -> '$File->[1]' ";
    $Result = rename( $File->[0], $File->[1] );
    print (($Result)? "Success" : "Failed" );
    push( @FailedToRename, $File->[0] ) if( ! $Result );
    print "\n";
}

print "\n\nTotals:\n";
foreach my $Type ( sort( keys( %{$Total{type}} ) ) )
{
    print "\t\u$Type files: $Total{type}->{$Type}\n";
}
print "\t----------------------------------\n";
print "\tTotal tested: $Total{files}\n";
print "\tTotal recovered: $Total{recovered}\n\n";

if( scalar @FailedToRename )
{
    print "\tThe following files are good but failed to rename:\n";
    map { print "\t\t$_\n"; } @FailedToRename;
}