perl Gtk2::WebKit: how to do a full page screenshot - perl

I'm using the perl module Gtk2::WebKit to create a browser and take a screenshot of a web page. There is no problem to take a screenshot of the visible portion of the page (the window size). However, how can I take a screenshot of the full page, even the part not visible in the window?

I think this is what you're looking for. I found it on Github.
screenshot.pl - Take a screenshot
Save a page as an SVG:
screenshot.pl --type svg http://www.google.com/
Save a page as a PDF:
screenshot.pl --output cpan.pdf http://search.cpan.org/
Save an element of a page taken from an XPath query as a PNG:
screenshot.pl --output ba.png --xpath 'id("content")' http://bratislava.pm.org/

Here is my GTK2 solution to this problem:
#!/usr/bin/perl
use Gtk2 -init;
use Gtk2::WebKit;
use Data::Dumper;
my $window = Gtk2::Window->new;
my $sw = Gtk2::ScrolledWindow->new;
my $view = Gtk2::WebKit::WebView->new;
my $factor = 0;
$window->set_default_size(Gtk2::Gdk->screen_width, Gtk2::Gdk->screen_height);
$window->set_border_width(1);
$sw->add($view);
$window->add($sw);
$window ->signal_connect( 'destroy' => \&delete_event );
$view->signal_connect( 'load-finished' => \&prepare_zoom);
$view->set_full_content_zoom(TRUE);
$view->signal_connect( 'size-allocate' => \&screenshot);
$view->open('http://stackoverflow.com/questions');
$window->show_all;
Gtk2->main;
#####################################
sub delete_event {
Gtk2->main_quit;
return FALSE;
}
#####################################
sub prepare_zoom {
$adj = $sw->get_vadjustment();
$factor = $adj->page_size/$adj->upper;
$view->set_zoom_level($factor);
}
sub screenshot {
return unless defined($window->window) && $factor>0;
my ($width, $height) = $window->window->get_size;
my $sWidth=$width*$factor;
my $gdkpixbuf = Gtk2::Gdk::Pixbuf->new ('rgb', 0, 8, $width, $height);
$gdkpixbuf->get_from_drawable($window->window,
undef, 0, 0, 0, 0, $width, $height);
$gdkpixbuf->save ("screenshot.jpg", 'jpeg', quality => 100);
#Gtk2->main_quit;
return FALSE;
}
This code works, but I'm not a GTK2 / Webkit expert, so I'm sure it can be written in a better way.
The idea behind it is simple:
Load the page
Get full page size and visible page size, then calculate the scale factor needed to see the full page content
Scale the page using that scale factor
Grab the screenshot
NOTES
Depends where you want to apply it, the scale factor calculation may need some corrections
You can crop the screenshot (to remove the blank areas) adjusting the values passed to get_from_drawable.

Related

How can I detect window resize event using Win32::GUI and WM_DISPLAYCHANGE?

I am struggling to make a simple receive WM_DISPLAYCHANGE informing my Win32::GUI app that the Windows Screen Resolution has changed, since the results for this question here is "0" accordingly informed by the search engine.
Could you provide a simple working example of a simple Win32::GUI program that detects a WM_DISPLAYCHANGE message and prints some info about that change in resolution?
From user "beech" at PerlMonks: http://perlmonks.org/index.pl?node_id=1171819
Try using the Hook method:
something like
$main->Hook( WM_DISPLAYCHANGE(), \&onDisplayChange );
sub onDisplayChange {
my( $object, $wParam, $lParam, $type, $msgcode) = #_;
print "Click handler called!\n";
}
Give a name to your window. Let's call it Main.
$main = Win32::GUI::Window->new(
-name => 'Main',
-width => 100,
-height => 100,
);
Now, define an event handler for the window. It should be of below pattern:
<window name>_<event name>
For example, for Resize event the event handler should be Main_Resize.
sub Main_Resize {
my $mw = $main->ScaleWidth();
my $mh = $main->ScaleHeight();
my $lw = $label->Width();
my $lh = $label->Height();
#print the height/width or whatever you want
}
I would suggest going through Win32::GUI::Tutorial.

Perl OpenOffice::OODoc - accessing header/footer elements

How do you get elements in a header/footer of a odt doc?
for example I have:
use OpenOffice::OODoc;
my $doc = odfDocument(file => 'whatever.odt');
my $t=0;
while (my $table = $doc->getTable($t))
{
print "Table $t exists\n";
$t++;
}
When I check the tables they are all from the body. I can't seem to find elements for anything in the header or footer?
I found sample code here which led me to the answer:
#! /usr/local/bin/perl
use OpenOffice::OODoc;
my $file='asdf.odt';
# odfContainer is a representation of the zipped odf file
# and all of its parts.
my $container = odfContainer("$file");
# We're going to look at the 'style' part of the container,
# because that's where the header is located.
my $style = odfDocument
(
container => $container,
part => 'styles'
);
# masterPageHeader takes the style name as its argument.
# This is not at all clear from the documentation.
my $masterPageHeader = $style->masterPageHeader('Standard');
my $headerText = $style->getText( $masterPageHeader );
print "$headerText\n"
The master page style defines the look and feel of the document -- think CSS. Apparently 'Standard' is the default name for the master page style of a document created by OpenOffice... that was the toughest nut to crack... once I found the example code, that fell out in my lap.

WWW::Mechanize fetch frame after submit in another frame

I have a webpage with 3 frames. The first frame has a form and when the form is submitted, the second frame loads some data. I need to be able to read the data in the second frame. What I have so far is this,
# Use WWW::Mechanize to download webpage
my $mechanize = WWW::Mechanize->new(
noproxy => 0,
stack_depth => 5,
autocheck => 1
);
$mechanize->proxy( https => undef );
my #frames;
eval{
my $me=$mechanize->get('link');
$me->is_success or die $me->status_line;
#frames = $mechanize->find_link( 'tag' => 'frame' ); # three frames
$me=$mechanize->get($frames[0]->url);
$me->is_success or die $me->status_line;
};
my $rb_value = 2000;
my $dt = '06/30/2011'
$mechanize->set_fields(
'idxevent' => $rb_value,
'mindate' => $dt
);
$mechanize->submit();
Now I need to retrieve the content of the second frame. What can I do for this?
Don't bother with the frameset, get the url of the frame holding the form directly and submit it. Get the result of $mechanize->submit() in a variable, and then you can access it by calling the content() method:
$result = $mechanize->submit();
print $result->content();
Mechanize does not care about the frameset and the submit target, it just gets the reply from the server so the same will apply for a normal frame-less layout.
You can find an example here
Follow the synopsis of WWW::Mechanize::Frames.

Cannot print on multiple pages using PDF::API2

I have been tinkering around with PDF::API2 and i am facing a problem, create a pdf file very well and add text into it. However say if the text to be written flows over to more than one page, the script does not print over to the next page. I have tried researching for an answer to this but to no avail. I would like each page to have exactly 50 lines of text. My script is as below. It only prints on the first page, creates the other pages but does not print into them. Anyone with a solution
!/usr/bin/perl
use PDF::API2;
use POSIX qw(setsid strftime);
my $filename = scalar(strftime('%F', localtime));
my $pdf = PDF::API2->new(-file => "$filename.pdf");
$pdf->mediabox(595,842);
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
$txt->textstart;
$txt->font($fnt, 20);
$txt->translate(100,800);
$txt->text("Lines for $filename");
my $i=0;
my $line = 780;
while($i<310)
{
if(($i%50) == 0)
{
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
}
$txt->font($fnt, 10);
$txt->translate(100,$line);
$txt->text("$i This is the first line");
$line=$line-15;
$i++;
}
$txt->textend;
$pdf->save;
$pdf->end( );
The problem is that you are making new page, but forget new variables instantly:
if(($i%50) == 0)
{
my $page = $pdf->page;
my $fnt = $pdf->corefont('Arial',-encoding => 'latin1');
my $txt = $page->text;
}
All my variables you make disappear on closing parentheses. Just remove my and you will modify variables from top-level scope.
Edit: You also probably want to reset $line variable when making new page.
The typeface, $fnt, does not have to be changed since it depends on the PDF, $pdf, and not the page, $page.
As much as I love Perl, I learned enough Python to use the ReportLabs library for PDF generation. Creating PDF is one of the weak spots of Perl v. Python.

How can i repeatedly prompt the user with Tkx?

Using Perl Tkx, I want to get some input from the user, close the window, and maybe do it again later. For user input, I'm just displaying some buttons, and the user gets to click on one of them. Here's what I have now:
sub prompt_user {
my $answer;
my $mw = Tkx::widget->new("."); ## the main window is unavailable the second time
$mw->g_wm_title("Window Title"); ## line 40
$mw->g_wm_minsize(300, 200);
my $label = $mw->new_label( -text => "Question to the user?");
$label->g_pack( -padx => 10, -pady => 10);
my $button1 = $mw->new_button(
-text => "Option One",
-command => sub { $answer = 0; $mw->g_destroy; },
);
$button1->g_pack( -padx => 10, -pady => 10);
my $button2 = $mw->new_button(
-text => "Option Two",
-command => sub { $answer = 1; $mw->g_destroy; },
);
$button2->g_pack( -padx => 10, -pady => 10);
Tkx::MainLoop(); ## This blocks until the main window is killed
return $answer;
}
So the user clicks on one of the buttons, the window closes, prompt_user() returns 0 or 1 (depending on which button the user clicked), and execution continues. Until I try to prompt the user again. Then I get an error:
can't invoke "wm" command: application has been destroyed at MyFile.pm line 40
I just want a way to put up a bunch of buttons, let the user click one, wait to see which one is clicked, and maybe do it again later. Is there a way I can wait for a response to the button click without destroying the main window? Maybe create a subwindow?
I'm new to using Tkx, and googling shows lots of simple examples like the above code (using MainLoop/g_destroy), but I couldn't find any examples of recreating windows. I did see stuff about a Dialog Box or Message Box, but those won't suit my needs. I want to put text on the buttons, and use an arbitrary number of buttons (so I don't want to be limited to yes/no/cancel, and only have 3 options).
Update
Here's what I was able to use
# hide the main window, since I'm not using it
my $mw = Tkx::widget->new(".");
$mw->g_wm_withdraw();
# function to prompt the user to answer a question
# displays an arbitrary number of answers, each on its own button
sub prompt {
my $prompt = shift;
my $list_of_answers = shift;
# Note: the window name doesn't matter, as long as it's './something'
my $answer = Tkx::tk___dialog( "./mywindowpath", # window name
"Prompt", # window title
$prompt, # text to display
undef, # tk bmp library icon
undef, # default button
#$list_of_answers); # list of strings to use as buttons
return $answer;
}
# use the button to ask a question
my $index = prompt("Who was the best captain?",
[ "Kirk", "Picard", "Cisco", "Janeway", "Archer" ] );
I'm not really familiar with Tkx but Tk doesn't really work well that way. In general Tk applications are asynchronous. You should re-write your application in term of callbacks (kind of like javascript).
Basically, this kind of logic:
sub do_something {
perform_some_action();
my $result = prompt_user();
perform_some_other_action($result);
}
should be re-written to something like:
sub do_something {
perform_some_action();
prompt_user(perform_some_other_action);
}
Your program should basically not have a main loop. Instead the call to Tkx::MainLoop at the end of your program becomes the main loop and you should do all processing by handling events.
Having said that, there are some mechanisms available that emulates blocking. Read the documantation for vwait. Though, I think even that requires a running Tkx::MainLoop so it does not necessarily avoid refactoring your whole program.
On the question of how to create and destroy windows there are two solutions:
Use the main window (.) but don't destroy it at the end. Instead hide it and destroy all its children. You can then later reuse . by unhiding it.
Hide . and don't use it. Instead create other windows (toplevels) and use them. Since toplevels are children of . they are safe to destroy without screwing up Tk.