#!/Perl
#
# from : http://www.nntp.perl.org/group/perl.libwin32/56
# *********** CRASHES ON POPUPS ************
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use URI;
use Win32::OLE qw( EVENTS in with valof );
use Win32::OLE::Variant;

my $t_start;
my $tend = gettimeofday;
my $url;
my $urlCounter= 0;
my $timeTestStart = time();
my $t_now;
my $t_last_event;
my $dl_tot = 0;
my $dl_cnt = 0;
my $timedelay = 5;
my $timeout = 60;

$|=1;
# 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( "Cannot create an InternetExplorer.Application" );

$ie->{menubar} = 1;                     
$ie->{toolbar} = 1;
$ie->{statusbar} = 1;
$ie->{visible} = 1;

# give IE a chance to get itself established
prt( "IE should be visible\n" );

$ie->navigate('about:blank');

sleep 5;

Win32::OLE->WithEvents( $ie, \&win32_ie_events, "DWebBrowserEvents2" );

$Win32::OLE::Warn = 2;          # I'll deal with errors myself
#$Win32::OLE::Warn=3;                # force a croak on errors

my $vttrue = Variant(VT_BOOL, 1);

my @urls = qw(
    http://www.whitehouse.gov
    http://www.cnn.com
    http://www.popuptest.com/popuptest12.html
    http://www.popuptest.com/popuptest1.html
    http://www.instantattention.com/?aid=1589
);

foreach $url (@urls) {
    $url =~ s/\s//;
    if( $url =~ /^#/) { next; }     # do not nav to pdf files
    if( $url =~ /^$/) { next; }

    $urlCounter++;

    my $elapsed = time() - $timeTestStart;

    my @xtime = gmtime($elapsed);

    prt( "\n\n" );

    prt( localtime(time) . " elapsed " . $xtime[2] . ":" . $xtime[1] . ":". $xtime[0] . "\n" );

    prt( "url $urlCounter $url\n" );

    $dl_tot = 0;

    $dl_cnt = 0;

    $t_start = $t_last_event = gettimeofday();

    $ie->navigate($url);

    while (1) {

        #print ".";

        Win32::OLE->SpinMessageLoop;

        if(Win32::OLE->LastError) {
            prt( "OLE error after sping loop ". Win32::OLE->LastError ."\n" );
            mydie( "OLE error\n" );
        }

        # get current time

        $t_now = gettimeofday();

        # check if navigation is complete

        if((($t_now - $t_last_event) > $timedelay)  &&   # no events for a bit
            ($ie->ReadyState == 4) &&                   # browser says it's ready
            $dl_tot &&                                  # we've had some downloads
            ($dl_cnt == 0)) {                           # we've had equal number of download completes

            prt( "done ok\n" );
            last;                                       # we're done
        }

        # check for timeout
        if(( $t_now  - $t_start ) > $timeout ) {
            # temp code, this hangs sometimes, need x19 style stuff, sometimes this seems to hang!!
            prt( "timeout\n" );
            sleep 5;
            last;
        }

    }

    my $seconds = $t_last_event - $t_start;

    prt( "Returned after $seconds seconds ...\n" );

}

$ie->close;

exit;

sub win32_ie_events {

    my( $agent, $event, @args ) = @_;

    $t_last_event = gettimeofday();

    prt( "--- " );    
    my $te = sprintf '%6.2f', $t_last_event - $t_start;
    prt( "$te $dl_cnt $dl_tot [$event]\n" );

    CASE: {

        $event eq 'DownloadBegin' and do {
            $dl_cnt++;
            last CASE;
        };

        $event eq 'DownloadComplete' and do {
            if ($dl_cnt) {
				$dl_cnt--;
            }
			$dl_tot++;
            last CASE;
        };

		# getting a CRASH comment out following ...
        #$event eq 'NewWindow2' and do {
        #    prt( "NewWindow2 kill popup\n" );
        #    ###$args[1]->Put( 1 );  # doesn't work
        #    prt( "cancel[" .$args[1]->Value() . "]\n" );
        #    last CASE;
        #};

        #$event eq 'NewWindow3' and do {
        #    prt( "NewWindow3 kill popup\n" );
        #    prt( "$args[2], $args[3], $args[4]\n" );
        #    ###$args[1]->Put( 1 );  # doesn't work
        #    prt( "cancel[" .$args[1]->Value() . "]\n" );
        #    last CASE;
        #}

    }

    ##my $te = sprintf '%6.2f', $t_last_event - $t_start;
    ##prt( "$te $dl_cnt $dl_tot [$event]\n" );

    if(Win32::OLE->LastError) {
        prt( "OLE error ". Win32::OLE->LastError. "\n");
        mydie( "OLE error\n" );
    }

}

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

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 - autoie04.pl

