Listing 1: ClipboardMonitor.pl

use strict;
use Win32::Clipboard;
my $iTotalCopyCount = 0;
# BEGIN CALLOUT A
my $Clip = Win32::Clipboard()->new() || die;
# BEGIN COMMENT
# Wait a few milliseconds for a Clipboard change. This 
# clears out any outstanding change.
# END COMMENT
$Clip->WaitForChange( 100 );

while( $Clip->WaitForChange() )
# END CALLOUT A
{
  printf( "\n---------------------\n%d) " . localtime() . "\n", ++$iTotalCopyCount );
# BEGIN CALLOUT B
  if( $Clip->IsText() )
  {
    my $ClipboardBuffer;
    my %List;
    my $Data = $Clip->Get();
# BEGIN COMMENT
    # Collect any URLs in the Clipboard data.
# END COMMENT
    foreach my $Url (  $Data =~ m#((?:http|https|ftp|gopher)://[-%\.\w\/\(\)&^\$\#@!]+)#gi )
    {
      $Url =~ s/[^\w\/]+$//i;
      $List{url}->{ lc $Url } = $Url;
    }
# BEGIN COMMENT
    # Collect any email addresses in the Clipboard data.
# END COMMENT
    foreach my $Email ( $Data =~ m#([\w-]+@[\w-]+\.[\w-\.]+)#gi )
    {
      $Email =~ s/[^\w]+$//i;
      $List{email}->{ lc $Email } = $Email;
    }

# BEGIN COMMENT
    # Collect any paths in the Clipboard data.
# END COMMENT
    foreach my $Path ( $Data =~ m#(\b(?:[a-z]:|\\\\\w+\\)[\w \\/\.\-\!\@\#\$^\(\)=+]+\b)#gi ) 
    {
      $List{path}->{ lc $Path } = $Path;
    }
# END CALLOUT B
# BEGIN CALLOUT C
# BEGIN COMMENT
      # Sort the data.
# END COMMENT
      foreach my $Type ( sort( keys( %List ) ) ) 
      {
        $ClipboardBuffer .= "\t\u$Type list (" . scalar( keys( %{$List{$Type}} ) ). " items):\n";
        my $iCount = 0;
        foreach my $Object ( sort( keys( %{$List{$Type}} ) ) )
        {
          $ClipboardBuffer .= sprintf( "\t  % 3d) %s\n", ++$iCount, $List{$Type}->{$Object} );
        }
        $ClipboardBuffer .= "\n";
      }
# END CALLOUT C
# BEGIN CALLOUT D
# BEGIN COMMENT
      # Display the sorted data.
# END COMMENT
      if( scalar( keys( %List ) ) )
      {
        print $ClipboardBuffer;
# BEGIN COMMENT
        # Store the results on the Clipboard.
# END COMMENT
        $ClipboardBuffer =~ s/\n/\r\n/g;
        $Clip->Set( $ClipboardBuffer );
# END CALLOUT D
      }
      else
      {
        print "\tNo Urls, email addresses or paths found.\n";
      }
  }
# BEGIN CALLOUT E
  elsif( $Clip->IsBitmap() )
  {
    my $FilePath;
    my $iCount = 0;
# BEGIN COMMENT
    # Save the graphic in a file, picking a unique filename.
# END COMMENT
    do
    {
      $FilePath = sprintf( "%s\\Saved_Image_%06d.bmp", $ENV{temp}, $iCount++ );
    } while( -f $FilePath );
# BEGIN COMMENT
      # Open the file.
# END COMMENT
      if( open( IMAGE, "> $FilePath" ) )
      {
        binmode IMAGE;
        print IMAGE $Clip->GetBitmap();
        close IMAGE;
        print "\n\tCopied graphic stored: \"$FilePath\"\n";
# BEGIN COMMENT
         # Copy the file's path to the Clipboard.
# END COMMENT
         $Clip->Set( $FilePath );
# END CALLOUT E
      }
      else
      {
        print "\tUnable to save graphic file. (Error: $!)\n";
      }
  }
# BEGIN CALLOUT F
  elsif( $Clip->IsFiles() )
  {
    my $iCount = 0;
    my %List;
    my $ClipboardBuffer;
# BEGIN COMMENT
    # Collect the file or folder paths in the Clipboard.
# END COMMENT
    foreach my $Path ($Clip->GetFiles()) 
    {
      if( -d $Path )
      {
        $List{directories}->{lc $Path} = $Path;
      }
      elsif( -f $Path )
      {
        $List{files}->{lc $Path} = $Path;
      }
      else
      {
        $List{unknown}->{lc $Path} = $Path;
      }
    }
# END CALLOUT F
# BEGIN CALLOUT G
# BEGIN COMMENT
    # Sort the data.
# END COMMENT
    foreach my $Type ( sort( keys( %List ) ) )
    {
      my $iCount = 0;
      $ClipboardBuffer .= "\n\tCopied following \u$Type:\n";
      foreach my $Path ( sort( keys( %{$List{$Type}} ) ) ) 
      {
        $ClipboardBuffer .= sprintf( "\t  % 6d) %s\n", ++$iCount, $List{$Type}->{$Path} );
      }
    }
# BEGIN COMMENT
    # Display the sorted data.
# END COMMENT
      if( scalar( keys( %List ) ) )
      {
        print "$ClipboardBuffer\n";
# BEGIN COMMENT
        # Store the results on the Clipboard.
# END COMMENT
        $ClipboardBuffer =~ s/\n/\r\n/g;
        $Clip->Set( $ClipboardBuffer );
# END CALLOUT G
      }
      else
      {
        print "\tNo valid files were copied.\n";
      }
  }
  else
  {
    print "\tCan not determine what was copied.\n";
  }
}