#!/Perl
#
# from : http://www.nntp.perl.org/group/perl.libwin32/61
# In attempting to add popup support to IE automation I've encountered what
# may be a bug in Win32::OLE.  The following code exhibits the problem.

# *********** CRASHES ON POPUPS ************

use strict;
use Data::Dumper;
use Win32::OLE qw( EVENTS );            # we need Win32::OLE with events
use Time::HiRes qw(gettimeofday);       # provide more accurate timings
use IO::Handle;

$|=1;       # do not buffer

my $URL1 = 'http://www.google.com/';
my $URL2 = 'http://www.gozer.org/mozilla/popup_tester/';

my $self = {};

my $donew = 0; # try to turn off offending code, BUT STILL CRASHES!!!

# LOG FILE STUFF
my $write_log = 0;
my $outfile = "temp.$0.txt";
#my $LOG = new FileHandle ">$outfile"; 
my ($LOG); 
if ( open( $LOG, ">$outfile" ) ) {
###if ($LOG) {
    $write_log = 1;
	###select $LOG;
} else {
    $write_log = 0;
    prt( "WARNING: Unable to open $outfile LOG ...\n" );
}

my $ie = Win32::OLE->new( 'InternetExplorer.Application' ) or 
    mydie( "error: failed to get internet explorer ...\n" );

$ie->{visible} = 1;

Win32::OLE->WithEvents( $ie, \&ie_events, 'DWebBrowserEvents2' );

$self->{ie} = $ie;

prt( "self after initialization\n" . Dumper( $self ) );

$self->{popups} = [];
$self->{ts} = $self->{tle} = gettimeofday;

prt( "navigate to google - $URL1 \n" . Dumper($self) );

$ie->navigate( $URL1 ); # = 'http://www.google.com/'

while(gettimeofday - $self->{ts} < 60){
    Win32::OLE->SpinMessageLoop;	# check for events
    last if( gettimeofday - $self->{tle} > 10 );
}

prt( "done google\n" . Dumper( $self ) );

prt( "\n" );

$self->{popups} = [];

$self->{ts} = $self->{tle} = gettimeofday;

prt( "navigate to popup_tester - $URL2 -\n" . Dumper($self) );

$ie->navigate( $URL2 ); # = 'http://www.gozer.org/mozilla/popup_tester/'

while(gettimeofday - $self->{ts} < 60){
    # check for events
    Win32::OLE->SpinMessageLoop;
    # if no events in 10 seconds, declare navigation done
    last if( gettimeofday - $self->{tle} > 10 );
}

prt( "done popup_tester\n" . Dumper( $self ) );

sub ie_events() {
    my( $ie, $event, @args ) = @_;
    
    my $tn = gettimeofday();
    $self->{tle} = $tn;
    
    my $te = sprintf '%6.2f', $tn - $self->{ts};
    ###prt( "$self $ie $te [$event]\n" );
    prt( "$te [$event] $self $ie \n" );

    if ( $donew && ( $event eq 'NewWindow2' )) {
            prt( "self before new window handling\n" );
			prt( Dumper($self) );

            my $popupself = {};
            my $ie2 = Win32::OLE->new( 'InternetExplorer.Application' ) or
                mydie( 'could not start IE on allowed NewWindow2' );

            prt( "self after new IE application\n" );
			prt( Dumper($self) );

            $popupself->{ie} = $ie2;      # remember ie application
            my $xx = $self->{popups};

            # push @{$xx}, $popupself;     # save new IE object
# Curiously the code crashes on the 2nd popup window at
# http://www.gozer.org/mozilla/popup_tester/, not the first.  Somewhat
# surprisingly, commenting out the push that attempts to save $popupself
# allows the code to run to completion.  I'm uncertain why any of this occurs.
# Richard Bell
# rbell01824[at]earthlink.net

            prt( "self after push\n" );
			prt( Dumper($self) );

            #$args[0]->Put( $ie->{application});
            $args[0]->Put( $ie );
            $args[1]->Put( 0 );
    }
}

################################
### output and log file
sub wlog {
	my $ml = shift;
	print $LOG $ml;
	$LOG->flush;
}

sub prt {
	my $m = shift;
	if ($write_log) {
		wlog($m);
	}
	print STDOUT $m;
}

sub mydie {
	my $msg = shift;
	if ($write_log) {
		wlog($msg);
	}
	die $msg;
}

sub close_log {
	if ($write_log) {
		prt( "Closing LOG file, and passing to 'system($outfile)'\nMay need to CLOSE notepad to continue ...\n" );
		close( $LOG );
		system( $outfile );
	}
}

# eof - autoie05.pl

