Listing 1: Code to Adjust a Script's Priority Class

#BEGIN CALLOUT A
use Win32::API::Prototype; 
#END CALLOUT A
BEGIN COMMENT
# This module is available from http://www.roth.net/perl/packages.
END COMMENT

#BEGIN CALLOUT B
$Priority = shift @ARGV || "low";

BEGIN COMMENT
# Low and Idle priority classes set the same priority level.
# Use the Realtime class with care.    
END COMMENT
%PRIORITIES = (
  realtime            => 0x00000100,
  above_normal  =>  0x00008000, # Not supported on Windows NT.
  high                  =>  0x00000080,
  normal              =>  0x00000020,
  below_normal  =>  0x00004000,  # Not supported on NT.
  low                   =>  0x00000040,
  idle                   =>  0x00000040,
);              
#END CALLOUT B

BEGIN COMMENT
# Set the process priority class to prevent CPU drain.
END COMMENT
if( defined $PRIORITIES{lc $Priority} )
{
#BEGIN CALLOUT C  
  ApiLink( 'kernel32.dll', "BOOL SetPriorityClass( HANDLE hThread, 
    DWORD dwPriorityClass )" ) || die "Unable to load SetPriorityClass()";
  ApiLink( 'kernel32.dll', "HANDLE OpenProcess()" ) || die 
    "Unable to load GetCurrentProcess()";
  ApiLink( 'kernel32.dll', "HANDLE GetCurrentProcess()" ) || die 
    "Unable to load GetCurrentProcess()";
  ApiLink( 'kernel32.dll', "BOOL CloseHandle( HANDLE )" ) || die 
    "Unable to load CloseHandle()";
 
BEGIN COMMENT
  # Get a handle to this process. Note that GetCurrentProcess() 
  # returns a pseudo handle.
END COMMENT
  my $hProcess = GetCurrentProcess();
  if( 0 == SetPriorityClass( $hProcess, $PRIORITIES{lc $Priority} ) )
  {
    print "\n\nUnable to set the process scheduling priority to $Priority.\n";
    print "Error: " . Win32::FormatMessage( Win32::GetLastError() ) . "\n\n\n";
  }
  else
  {
    print "\n\nProcess scheduling priority set to $Priority.\n\n\n";
  }
  
BEGIN COMMENT
  # Because this is a pseudo handle, the script doesn't actually 
  # need to call CloseHandle(), but doing so is a good habit. 
END COMMENT
  CloseHandle( $hProcess );
#END CALLOUT C
}    

#BEGIN CALLOUT D
my $iCount = 0;
while( 1 )
{
  print "\rCounting: " . ++$iCount;
}               
#END CALLOUT D