File Coverage

blib/lib/Win32/CaptureIE.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Win32::CaptureIE;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'default' => [ qw(
  StartIE
  QuitIE
  Navigate
  PopUp
  RunJS
  Wait
  Refresh
  GetElement
  GetAll
  GetDoc

  CaptureElement
  CaptureElements
  CapturePage
  CaptureBrowser
  CaptureRows
  CaptureThumbshot
  CaptureArea

  $IE
  $Doc
  $Body
  $HWND_IE
  $HWND_Browser
  $CaptureBorder
  $PopUp_IE
  $PopUp_HWND_IE
  $PopUp_HWND_Browser
) ] );

$EXPORT_TAGS{all} = [ map {@$_} values %EXPORT_TAGS ];

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = @{ $EXPORT_TAGS{'default'} };

our $VERSION = '1.30';
our $IE;
our $HWND_IE;
our $HWND_Browser;
our $Doc;
our $Body;
our $PopUp_IE;
our $PopUp_HWND_IE;
our $PopUp_HWND_Browser;
our $ProcessPopUps = 0;
our $CaptureBorder = 1;
our ($MOUSE_x, $MOUSE_y);

use Win32::OLE qw(in valof EVENTS);
use Win32::Screenshot qw(:all);
use POSIX qw(ceil floor);
use strict;

##########################################################################

# HACK: DocumentComplete event is not fired when refreshing page but
# only DownloadComplete event, so if refreshing page we need to wait for
# DownloadComplete but not if we are navigating to a page
our $refreshing_page = 0;

sub StartIE {
  my %arg = @_;

  # Open a new browser window and save its' window handle
  $IE = Win32::OLE->new("InternetExplorer.Application");
  Win32::OLE->WithEvents($IE,\&EventHandler,"DWebBrowserEvents2");
  Win32::OLE->Option(Warn => 4);
  $HWND_IE = $IE->{HWND};

  # Let's size the window
  $IE->{height} = $arg{height} || 600;
  $IE->{width} = $arg{width} || 808;
  $IE->{visible} = 1;

  # Show blank page (let the browser create rendering area)
  Navigate('about:blank');

  # We need the window on top because we want to get the screen shots
  Minimize($HWND_IE); Restore($HWND_IE); # this seem to work
  BringWindowToTop( $HWND_IE );

  # Find the largest child window, suppose that this is the area where the page is rendered
  my ($sz, $i) = (0, 0);
  for ( ListChilds($HWND_IE) ) {
    next unless $_->{visible};
    if ( $sz < (($_->{rect}[2]-$_->{rect}[0])*($_->{rect}[3]-$_->{rect}[1])) ) {
      $sz = (($_->{rect}[2]-$_->{rect}[0])*($_->{rect}[3]-$_->{rect}[1]));
      $i = $_->{hwnd};
    }
  }
  $HWND_Browser = $i;

  ($MOUSE_x, $MOUSE_y) = GetCursorPos();
  SetCursorPos(0, 0);
}

sub QuitIE () {
  $IE->Quit();
  $IE = undef;

  SetCursorPos($MOUSE_x, $MOUSE_y);
}

sub Navigate ($) {
  (defined $PopUp_IE ? $PopUp_IE : $IE)->Navigate($_[0]);
  Win32::OLE->MessageLoop();
  GetDoc();
}

sub PopUp (&) {
  $ProcessPopUps = 1;
  &{$_[0]}();
  Win32::OLE->MessageLoop();
  GetDoc();

  # Find the largest child window, suppose that this is the area where the page is rendered
  $PopUp_HWND_IE = $PopUp_IE->{HWND};
  my ($sz, $i) = (0, 0);
  for ( ListChilds($PopUp_HWND_IE) ) {
    next unless $_->{visible};
    if ( $sz < (($_->{rect}[2]-$_->{rect}[0])*($_->{rect}[3]-$_->{rect}[1])) ) {
      $sz = (($_->{rect}[2]-$_->{rect}[0])*($_->{rect}[3]-$_->{rect}[1]));
      $i = $_->{hwnd};
    }
  }
  $PopUp_HWND_Browser = $i;

  $ProcessPopUps = 0;
}

sub RunJS ($) {
  (defined $PopUp_IE ? $PopUp_IE : $IE)->Navigate("javascript:$_[0]");
  Wait(1);
  GetDoc();
}

sub Wait (;$) {
  my $time = shift || 1;
  while ( $time > 0 ) {
    Win32::OLE->SpinMessageLoop;
    select undef, undef, undef, 0.1;
    $time -= 0.1;
  }
}

sub Refresh () {
  $refreshing_page = 1;
  $IE->Refresh2(3);
  Win32::OLE->MessageLoop();
  GetDoc();
}

sub GetDoc () {
  $Doc = defined $PopUp_IE ? $PopUp_IE->{Document} : $IE->{Document};
  $Body = (! $Doc->compatMode || $Doc->compatMode eq 'BackCompat') ? $Doc->{Body} : $Doc->{Body}->{parentNode};
}

sub GetElement ($) {
  return $Doc->getElementById($_[0]);
}

sub GetAll ($;$$) {
  my $tag = uc shift;
  my $sub = ref $_[0] eq 'CODE' ? shift : undef;
  my $idx = shift;
  my @elements;

  local $_;
  for ( my $i = 0 ; $i < $Doc->All->length ; $i++ ) {
    $_ = $Doc->All($i);
    push @elements, $_ if $_->tagName eq $tag && (!defined $sub || &$sub( $_ ));
    last if defined $idx && @elements > $idx;
  }

  return defined $idx ? $elements[$idx] : @elements;
}

#####################################################################

sub CaptureRows {
  my $tab = ref $_[0] ? shift : GetElement(shift);
  my %rows = map {$_ => 1} ref $_[0] ? @{$_[0]} : @_;
  return undef if $tab->tagName ne 'TABLE' || !%rows;

  # temporary disable post processing
  my $img;
  {
    local @Win32::Screenshot::POST_PROCESS = ();
    $img = CaptureElement($tab);
  }

  # skip over CaptureBorder and table border (start on top of 1st row)
  my $pos = $CaptureBorder + $tab->rows(0)->{offsetTop};

  for ( my $row = 0 ; $row < $tab->rows->{length} ; $row++ ) {
    if ( $rows{$row} ) { # we want this row,  skip over it
      $pos += $tab->rows($row)->{offsetHeight};
    } else { # don't want this one, chop it out of the picture
      $img->Chop('x'=>0, 'y'=>$pos, 'width'=>0, 'height'=>$tab->rows($row)->{offsetHeight});
    }
  }

  return PostProcessImage( $img );
}

sub CaptureThumbshot {

  # that's not a good idea to capture thumbshots of popup windows
  return if defined $PopUp_IE;

  GetDoc();

  # resize the window to set the client area to 800x600
  $IE->{width} = $IE->{width} + 800-$Body->clientWidth;
  $IE->{height} = $IE->{height} + 600-$Body->clientHeight;

  # scrollTo(0, 0)
  $Body->{scrollTop} = 0;
  $Body->{scrollLeft} = 0;
  Win32::OLE->SpinMessageLoop();

  return CaptureWindowRect($HWND_Browser, $Body->clientLeft, $Body->clientTop, $Body->clientWidth, $Body->clientHeight );
}

sub CaptureElement {
  my $e = ref $_[0] ? shift : GetElement(shift);
  my $args = ProcessArgs(ref $_[0] eq 'HASH' ? shift : {});
  return CapturePage() if $e->tagName eq 'BODY';

  GetDoc();

  my ($px, $py, $sx, $sy, $w, $h);

  # This is the size of the object including its border
  $w = $e->offsetWidth;
  $h = $e->offsetHeight;

  # Let's calculate the absolute position of the object on the page
  my $p = $e;
  while ( $p ) {
    $px += $p->offsetLeft;
    $py += $p->offsetTop;
    $p = $p->offsetParent;
  }

  # Expand the area by capture border
  $px -= ($args->{border_left}||0);
  $py -= ($args->{border_top}||0);
  $w  += ($args->{border_left}||0) + ($args->{border_right}||0);
  $h  += ($args->{border_top}||0) + ($args->{border_bottom}||0);

  return CaptureArea($px, $py, $w, $h);
}

sub ProcessArgs {
  my $a = shift;
  my %args;

  $args{border_left} =   exists $a->{border_left}   ? $a->{border_left}   : exists $a->{border} ? $a->{border} : $CaptureBorder;
  $args{border_right} =  exists $a->{border_right}  ? $a->{border_right}  : exists $a->{border} ? $a->{border} : $CaptureBorder;
  $args{border_top} =    exists $a->{border_top}    ? $a->{border_top}    : exists $a->{border} ? $a->{border} : $CaptureBorder;
  $args{border_bottom} = exists $a->{border_bottom} ? $a->{border_bottom} : exists $a->{border} ? $a->{border} : $CaptureBorder;
  return \%args;
}

sub CaptureElements {
  my @elements = map { ! ref $_ ? GetElement($_) : $_ } grep { ! ref $_ || ref $_ eq 'Win32::OLE' } @_;
  my $args = ProcessArgs(ref $_[-1] eq 'HASH' ? $_[-1] : {});

  my ($tlx, $tly, $brx, $bry);
  my ($px, $py, $sx, $sy, $w, $h);

  GetDoc();

  # calculate absolute position on the page for all elements
  # and get bounding rect
  for my $e ( @elements ) {
    my $p = $e;

    my ($x, $y) = (0, 0);
    while ( $p ) {
      $x += $p->offsetLeft;
      $y += $p->offsetTop;
      $p = $p->offsetParent;
    }

    $tlx = $x if !defined $tlx || $tlx > $x;
    $tly = $y if !defined $tly || $tly > $y;
    $brx = $x+$e->offsetWidth if !defined $brx || $brx < $x+$e->offsetWidth;
    $bry = $y+$e->offsetHeight if !defined $bry || $bry < $y+$e->offsetHeight;
  }

  $w = $brx - $tlx + 1;
  $h = $bry - $tly + 1;
  $px = $tlx;
  $py = $tly;

  $px -= ($args->{border_left}||0);
  $py -= ($args->{border_top}||0);
  $w  += ($args->{border_left}||0) + ($args->{border_right}||0);
  $h  += ($args->{border_top}||0) + ($args->{border_bottom}||0);

  return CaptureArea($px, $py, $w, $h);
}

sub CapturePage {
  my ($px, $py, $sx, $sy, $w, $h);

  GetDoc();

  return CaptureArea(0, 0, $Body->scrollWidth, $Body->scrollHeight);
}

sub CaptureArea ($$$$) {
  my ($px, $py, $w, $h) = @_;
  my ($sx, $sy);

  $px = 0 if $px < 0;
  $py = 0 if $py < 0;
  $w = $Body->{scrollWidth}-$px if $px+$w > $Body->{scrollWidth};
  $h = $Body->{scrollHeight}-$py if $py+$h > $Body->{scrollHeight};

  # Scrolls the page so that top of the object is visible at the top of the window.
  $Body->{scrollTop} = $py - 2;
  $Body->{scrollLeft} = $px - 2;

  # The position on the screen is different due to page scrolling and Body border
  $sx = $px - $Body->scrollLeft + $Body->clientLeft;
  $sy = $py - $Body->scrollTop + $Body->clientTop;

  if ( $sx+$w < $Body->clientWidth && $sy+$h < $Body->clientHeight ) {

    # If the whole object is visible
    return CaptureWindowRect(defined $PopUp_IE ? $PopUp_HWND_Browser : $HWND_Browser, $sx, $sy, $w, $h );

  } else {

    # If only part of it is visible
    return CaptureAndScroll($px, $py, $w, $h);
  }
}

sub CaptureAndScroll ($$$$) {
  my ($px, $py, $w, $h) = @_;
  my ($strip, $final, $pw, $ph, $ch, $cw, $maxw, $maxh, $sx, $sy);

  GetDoc();

  # Captured area
  $final = '';
  $cw = 0;
  $ch = 0;

  # We will do the screen capturing in more steps by areas of maximum dimensions $maxw x $maxh
  $maxw = $Body->clientWidth;
  $maxh = $Body->clientHeight;

  for ( my $cnt_x=0 ; $cw < $w ; $cnt_x++ ) {

    # Scroll to the top and right
    $Body->{scrollTop} = $px - 2;
    $Body->{scrollLeft} = $px - 2 + $cnt_x * int($maxw*0.9);
    Win32::OLE->SpinMessageLoop;

    $strip = '';
    $ch = 0;

    for ( my $cnt_y=0 ; $ch < $h ; $cnt_y++ ) {

      $Body->{scrollTop} = $px - 2 + $cnt_y * int($maxh*0.9);
      Win32::OLE->SpinMessageLoop;

      # Recalculate the position on the screen
      $sx = $px - $Body->scrollLeft + $Body->clientLeft + $cw;
      $sy = $py - $Body->scrollTop + $Body->clientTop + $ch;

      # Calculate the dimensions of the part to be captured
      $pw = ($px+$cw) - $Body->scrollLeft + $maxw > $maxw ? $maxw - ($px+$cw) + $Body->scrollLeft : $maxw;
      $pw = $cw + $pw > $w ? $w - $cw : $pw;

      $ph = ($py+$ch) - $Body->scrollTop + $maxh > $maxh ? $maxh - ($py+$ch) + $Body->scrollTop : $maxh;
      $ph = $ch + $ph > $h ? $h - $ch : $ph;

      # Capture the part and append it to the strip
      $strip .= (CaptureHwndRect(defined $PopUp_IE ? $PopUp_HWND_Browser : $HWND_Browser, $sx, $sy, $pw, $ph))[2];

      $ch += $ph;
    }

    $final = JoinRawData( $cw, $pw, $h, $final, $strip );

    $cw += $pw;
  }

  return CreateImage( $w, $h, $final );
}


sub CaptureBrowser {

  GetDoc();

  # scrollTo(0, 0)
  $Body->doScroll('pageUp') while $Body->scrollTop > 0;
  $Body->doScroll('pageLeft') while $Body->scrollLeft > 0;

  return CaptureWindow( defined $PopUp_IE ? $PopUp_HWND_IE : $HWND_IE );
}

##########################################################################

sub EventHandler {
  my ($obj,$event,@args) = @_;

  # if the document is fully loaded and ready after Navigate()
  if ($event eq 'DocumentComplete' && $IE->ReadyState() == 4)  {
    Win32::OLE->QuitMessageLoop;
  }

  # if the document is fully loaded and ready after Refresh()
  if ($event eq 'DownloadComplete' && $refreshing_page) {
    $refreshing_page = 0;
    Win32::OLE->QuitMessageLoop;
  }

  # if new window is going to be created
  if ($event eq 'NewWindow2') {

    # if we want to process popups and don't have any yet
    if ( $ProcessPopUps && ! $PopUp_IE ) {

      # create a browser for the window
      $PopUp_IE = Win32::OLE->new("InternetExplorer.Application")->{Application};
      Win32::OLE->WithEvents($PopUp_IE, \&PopUpEventHandler, "DWebBrowserEvents2");
      $args[0]->Put($PopUp_IE);

      # wait while the window is busy
      while ($PopUp_IE->{Busy} == 1) { select(undef, undef, undef, 0.2); }

    # if we do not want any popups, cancel that
    } else {
      $args[1]->Put(1);
    }

  }
}


sub PopUpEventHandler {
  my ($obj,$event,@args) = @_;

  # if the document is fully loaded and ready after Navigate()
  if ($event eq 'DocumentComplete' && $IE->ReadyState() == 4)  {
    Win32::OLE->QuitMessageLoop;
  }

  # if the document is fully loaded and ready after Refresh()
  if ($event eq 'DownloadComplete' && $refreshing_page) {
    $refreshing_page = 0;
    Win32::OLE->QuitMessageLoop;
  }

  # if new window is going to be created, cancel that, we can handle only one popup
  if ($event eq 'NewWindow2') {
    $args[1]->Put(1);
  }

  # if the window has been closed destroy the object
  if ($event eq 'OnQuit') {
    $PopUp_IE = undef;
    $PopUp_HWND_IE = undef;
    $PopUp_HWND_Browser = undef;
  }

}

##########################################################################

1;

__END__