Win32::OLE crashes

[Richard Bell]

 

I'm trying to make some enhancements to Win32::IE::Mechanize that involve
(in part) blocking popups.  Several online examples suggest catching the
NewWindow event and setting cancel true.  When I attempt to do so I get
Win32::OLE crashes.  I've included an example program that exhibits the
issue on my machines:

 

 

#!/usr/bin/perl -w

#

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;

 

my $ie = Win32::OLE->new( 'InternetExplorer.Application' ) or

    die( "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

print "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);

    print "\n\n";

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

    print "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) {

            print "OLE error after sping loop ", Win32::OLE->LastError,
"\n";

            die "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

            print "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!!

            print "timeout\n";

            sleep 5;

            last;

        }

    }

 

    my $seconds = $t_last_event - $t_start;

    print "Returned $seconds\n";

}

 

$ie->close;

 

exit;

 

sub win32_ie_events {

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

    $t_last_event = gettimeofday();

 

    print "--- ";    

    CASE: {

        $event eq 'DownloadBegin' and do {

            $dl_cnt++;

            last CASE;

        };

        $event eq 'DownloadComplete' and do {

            $dl_cnt--; $dl_tot++;

            last CASE;

        };

        $event eq 'NewWindow2' and do {

            print "NewWindow2 kill popup\n";

            $args[1]->Put( 1 );  # doesn't work

            print "cancel[" .$args[1]->Value() . "]\n";

            last CASE;

        };

        $event eq 'NewWindow3' and do {

            print "NewWindow3 kill popup\n";

            print "$args[2], $args[3], $args[4]\n";

            $args[1]->Put( 1 );  # doesn't work

            print "cancel[" .$args[1]->Value() . "]\n";

            last CASE;

        }

    }

    my $te = sprintf '%6.2f', $t_last_event - $t_start;

    print "$te $dl_cnt $dl_tot [$event]\n";

    if(Win32::OLE->LastError) {

        print "OLE error ", Win32::OLE->LastError, "\n";

        die "OLE error\n";

    }

}