File Coverage

blib/lib/Gtk2/WebKit/Mechanize.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Gtk2::WebKit::Mechanize - WWW::Mechanize done with HTML WebKit engine.
4              
5             =head1 SYNOPSIS
6              
7             $mech = Gtk2::WebKit::Mechanize->new;
8              
9             $mech->get('http://www.example.org');
10              
11             $mech->submit_form(fields => { field_a => 'A', field_b => 'B' });
12              
13             # returns "Hello"
14             $mech->run_js('return "He" + "llo"');
15              
16             =head1 DESCRIPTION
17              
18             This module provides WWW::Mechanize like interface using WebKit browser engine.
19              
20             Aditionally it allows access to some of JavaScript functionality (e.g. calling
21             JavaScript functions, accessing alerts and console messages etc.).
22              
23             =cut
24 2     2   46635 use strict;
  2         6  
  2         87  
25 2     2   12 use warnings FATAL => 'all';
  2         4  
  2         130  
26              
27             package Gtk2::WebKit::Mechanize;
28 2     2   10 use base 'Class::Accessor::Fast';
  2         8  
  2         1758  
29              
30             use Gtk2 -init;
31             use Gtk2::WebKit;
32             __PACKAGE__->mk_accessors(qw(console_messages alerts view window));
33              
34             our $VERSION = '0.01';
35              
36             =head1 CONSTRUCTION
37              
38             =head2 Gtk2::WebKit::Mechanize->new;
39              
40             Constructs new Gtk2::WebKit::Mechanize object.
41              
42             =cut
43             sub new {
44             my $class = shift;
45             my $view = Gtk2::WebKit::WebView->new;
46             my $sw = Gtk2::ScrolledWindow->new;
47             $sw->add($view);
48              
49             my $win = Gtk2::Window->new;
50             $win->set_default_size(800, 600);
51             $win->add($sw);
52              
53             my $self = bless { view => $view, window => $win
54             , alerts => [], console_messages => [] }, $class;
55             $view->signal_connect('load-finished' => sub { Gtk2->main_quit });
56             $view->signal_connect('script-alert' => sub {
57             push @{ $self->alerts }, $_[2];
58             });
59             $view->signal_connect('console-message' => sub {
60             push @{ $self->console_messages }, $_[1];
61             });
62              
63             $win->show_all;
64              
65             return $self;
66             }
67              
68             =head1 METHODS
69              
70             =head2 $mech->get($url)
71              
72             Loads C<$url>.
73              
74             =cut
75             sub get {
76             my ($self, $url) = @_;
77             $self->view->open($url);
78             Gtk2->main;
79             }
80              
81             =head2 $mech->run_js($js_str)
82              
83             Evaluates C<$js_str> in the context of the current page.
84              
85             =cut
86             sub run_js {
87             my ($self, $js) = @_;
88             my $fn = "___run_js_$$";
89             $self->view->execute_script("function $fn() { $js }; alert($fn());");
90             return pop @{ $self->alerts };
91             }
92              
93             =head2 $mech->submit_form(%args)
94              
95             Submits first form on pages using $args{fields}.
96              
97             =cut
98             sub submit_form {
99             my ($self, %form) = @_;
100             while (my ($n, $v) = each %{ $form{fields} }) {
101             $self->run_js("(document.getElementsByName('$n'))[0]"
102             . ".value = '$v'");
103             }
104             $self->run_js('(document.getElementsByTagName("FORM"))[0].submit()');
105             Gtk2->main;
106             }
107              
108             =head1 ACCESSORS
109              
110             =head2 $mech->title
111              
112             Returns page title.
113              
114             =cut
115             sub title {
116             return shift()->view->get_main_frame->get_title;
117             }
118              
119             =head2 $mech->content
120              
121             Returns current page source.
122              
123             At present it uses document.body.innerHTML. Therefore page source will not
124             be identical to the one sent by server.
125              
126             =cut
127             sub content {
128             return shift()->run_js('return document.body.innerHTML');
129             }
130              
131             1;
132              
133             =head1 AUTHOR
134              
135             Boris Sukholitko
136             CPAN ID: BOSU
137             boriss@gmail.com
138              
139             =head1 COPYRIGHT
140              
141             This program is free software licensed under the...
142              
143             The GNU Lesser General Public License (LGPL)
144             Version 2.1, February 1999
145              
146             The full text of the license can be found in the
147             LICENSE file included with this module.
148              
149              
150             =head1 SEE ALSO
151              
152             L, L, L
153              
154             =cut