├── .gitignore ├── .travis.yml ├── Changes ├── INSTALL ├── LICENSE ├── MANIFEST ├── MANIFEST.SKIP ├── META.json ├── META.yml ├── Makefile.PL ├── README ├── README.mkdn ├── examples ├── README ├── bcat.pl ├── dump-links.pl ├── fullscreen.pl ├── gen_examples_pod.pl ├── javascript.pl ├── js-console.pl ├── manipulate-javascript.pl ├── open-local-file.pl ├── open-url.pl ├── proxy-settings.pl ├── scrape-ff.pl ├── screenshot.pl ├── tail-console.pl └── urlbar.pl ├── lib ├── Firefox │ ├── Application.pm │ └── Application │ │ ├── API35.pm │ │ ├── API36.pm │ │ └── API40.pm ├── HTML │ └── Display │ │ └── MozRepl.pm ├── HTTP │ └── Cookies │ │ └── MozRepl.pm └── WWW │ └── Mechanize │ ├── Firefox.pm │ └── Firefox │ ├── Cookbook.pod │ ├── DSL.pm │ ├── Examples.pm │ ├── FAQ.pod │ ├── Installation.pod │ └── Troubleshooting.pod ├── makeppd.pl ├── runtests.pl ├── t ├── 00-load.t ├── 01-mech-destroy.t ├── 401-server ├── 47-mech-memleak2.t ├── 47-mech-ref-memleak.t ├── 47-mech-simplest.t ├── 48-mech-launch.t ├── 49-mech-get-file.html ├── 49-mech-get-file.t ├── 49-mech-nav.t ├── 49-mech-reuse.t ├── 50-allow-js.t ├── 50-app-new.t ├── 50-app-profile.t ├── 50-click-coordinates-js.html ├── 50-click-coordinates-js.t ├── 50-click-coordinates.t ├── 50-click.html ├── 50-click.t ├── 50-follow-link.t ├── 50-form-with-fields.t ├── 50-form2.html ├── 50-form2.t ├── 50-form3.html ├── 50-load-and-load.t ├── 50-mech-activateTab.t ├── 50-mech-bufsize.t ├── 50-mech-closeTab.t ├── 50-mech-content.t ├── 50-mech-ct.t ├── 50-mech-encoding.t ├── 50-mech-error.t ├── 50-mech-event.t ├── 50-mech-forms.t ├── 50-mech-get-nocache.t ├── 50-mech-get.t ├── 50-mech-multi-event.t ├── 50-mech-new-dsl.t ├── 50-mech-new-with-tab.t ├── 50-mech-new.t ├── 50-mech-post.t ├── 50-mech-save-dialog.t ├── 50-mech-set-fields-875912.htm ├── 50-mech-set-fields-875912.t ├── 50-mech-status.t ├── 50-popup.t ├── 50-rt65615.t ├── 50-tick.html ├── 50-tick.t ├── 51-click_button.t ├── 51-click_js.html ├── 51-click_js.t ├── 51-empty-page.html ├── 51-form-number-blakew.html ├── 51-form-number-blakew.t ├── 51-mech-field-frameset.html ├── 51-mech-field.t ├── 51-mech-form-with-fields.t ├── 51-mech-links-base.html ├── 51-mech-links-nobase.html ├── 51-mech-links.t ├── 51-mech-navigation.t ├── 51-mech-sandbox.html ├── 51-mech-sandbox.t ├── 51-mech-set-content.t ├── 51-mech-submit.html ├── 51-mech-submit.t ├── 52-frame-document.t ├── 52-frame-event.t ├── 52-frameset-deep.html ├── 52-frameset-partly-404.html ├── 52-frameset-recursive.html ├── 52-frameset.html ├── 52-iframeset.html ├── 52-mech-api-find_link-frames.t ├── 52-mech-api-find_link.html ├── 52-mech-api-find_link.t ├── 52-mech-xpath.t ├── 52-selector-frames.t ├── 52-selector-noframes.t ├── 52-selector-relative.html ├── 52-selector-relative.t ├── 52-subframe.html ├── 53-mech-capture-js-error.html ├── 53-mech-capture-js-error.t ├── 53-mech-capture-js-noerror.html ├── 55-basic-auth.t ├── 60-mech-cookies.t ├── 60-mech-custom-headers.t ├── 65-is_visible.t ├── 65-is_visible_class.html ├── 65-is_visible_hidden.html ├── 65-is_visible_none.html ├── 65-is_visible_reload.html ├── 65-is_visible_remove.html ├── 65-is_visible_text.html ├── 65-mech-meta.html ├── 65-mech-meta.t ├── 65-set_visible.t ├── 70-download-url.t ├── 70-mech-png.t ├── 70-real-status-timeout.tx ├── 70-real-status.t ├── 70-rt70106-reload.t ├── 70-rt71216.html ├── 70-rt71216.t ├── 70-tag-team.t ├── 70-two-instances.t ├── 70-urlbar-2.html ├── 70-urlbar.html ├── 70-urlbar.t ├── 75-save_url-cookies.t ├── helper.pm ├── mechanize │ ├── autocheck.t │ └── content.t ├── mixi_jp_index.html ├── rt65615.html ├── rt65615.t ├── rt78706.t ├── rt84418.t ├── rt88100-continuation.t ├── sample.html ├── select.html ├── select.t └── sophos_co_jp_index.html └── xt ├── 99-changes.t ├── 99-compile.t ├── 99-examples.t ├── 99-manifest.t ├── 99-pod.t ├── 99-todo.t ├── 99-unix-text.t ├── 99-versions.t └── meta-lint.t /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | Makefile.old 3 | *.tar.gz 4 | *.bak 5 | pm_to_blib 6 | blib/ 7 | WWW-Mechanize-FireFox-* 8 | WWW-Mechanize-FireFox-*/ 9 | WWW-Mechanize-Firefox-* 10 | WWW-Mechanize-Firefox-*/ 11 | .releaserc 12 | cover_db 13 | firefox-versions/ 14 | MYMETA.* -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | # Selenium::Remote::Driver needs Perl 5.10 4 | #- "5.6.2" # ancient 5 | #- "5.8" 6 | #- "5.8.4" 7 | #- "5.8.4-thr" 8 | #- "5.8.8" # common, prebuilt version 9 | - "5.10" 10 | - "5.12" 11 | - "5.14" 12 | - "5.16" 13 | - "5.18" 14 | - "5.18.1-thr" 15 | - "5.20" 16 | - "5.22" 17 | - "5.24" 18 | - "dev" 19 | - "blead" 20 | 21 | matrix: 22 | allow_failures: 23 | - perl: blead 24 | - perl: 5.6.2 25 | 26 | sudo: required 27 | 28 | before_install: 29 | - sudo apt-get -qq update 30 | - sudo apt-get -y install firefox 31 | # This won't test with Firefox until we also find out how to install 32 | # the mozrepl add-on, but oh well 33 | - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers 34 | - export SPLIT_BUILD=0 35 | - source ~/travis-perl-helpers/init 36 | - build-perl 37 | - perl -V 38 | - build-dist 39 | - cd $BUILD_DIR 40 | 41 | install: 42 | - cpan-install ExtUtils::MakeMaker~6.68 43 | - cpan-install --deps 44 | 45 | script: 46 | - cd $BUILD_DIR 47 | - perl Makefile.PL && make 48 | - prove -blv $(test-dirs) 49 | 50 | branches: 51 | except: 52 | - /^wip\// 53 | - /^blocked/ 54 | #notifications: 55 | # email: false 56 | # irc: 57 | # channels: 58 | # - "irc.perl.org#moo-smoke" 59 | # template: 60 | # - "%{repository}#%{build_number} %{branch} by %{author}: %{message} (%{build_url})" 61 | # on_success: change 62 | # on_failure: always 63 | # skip_join: true 64 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | See lib/WWW/Mechanize/Firefox/Installation.pod -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | .cvsignore$ 2 | ^.git/ 3 | ^.lwpcookies 4 | ^.releaserc 5 | ^blib/ 6 | ^MozRepl-RemoteObject-.* 7 | ^WWW-Mechanize-Firefox-.* 8 | CVS/ 9 | ^pm_to_blib 10 | \.tar.gz$ 11 | \.tmp$ 12 | \.old$ 13 | ^Makefile$ 14 | ^cvstest$ 15 | ^blibdirs$ 16 | .bak$ 17 | ^cover_db/ 18 | ^db/ 19 | ^firefox-versions/ 20 | ^ppds/ 21 | t/70-real-status-timeout.t 22 | ^MYMETA.* 23 | ^clicktest.pl 24 | ^new-tab.pl 25 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "use Firefox as if it were WWW::Mechanize", 3 | "author" : [ 4 | "Max Maischein " 5 | ], 6 | "dynamic_config" : 0, 7 | "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : 2 14 | }, 15 | "name" : "WWW-Mechanize-Firefox", 16 | "no_index" : { 17 | "directory" : [ 18 | "t", 19 | "inc" 20 | ] 21 | }, 22 | "prereqs" : { 23 | "build" : { 24 | "requires" : { 25 | "ExtUtils::MakeMaker" : "0" 26 | } 27 | }, 28 | "configure" : { 29 | "requires" : { 30 | "ExtUtils::MakeMaker" : "0" 31 | } 32 | }, 33 | "runtime" : { 34 | "requires" : { 35 | "Cwd" : "0", 36 | "File::Basename" : "0", 37 | "HTML::Selector::XPath" : "0", 38 | "HTTP::Cookies" : "0", 39 | "HTTP::Date" : "0", 40 | "HTTP::Request::Common" : "0", 41 | "HTTP::Response" : "0", 42 | "MIME::Base64" : "0", 43 | "MozRepl::RemoteObject" : "0.39", 44 | "Object::Import" : "0", 45 | "Scalar::Util" : "1.14", 46 | "Shell::Command" : "0", 47 | "URI" : "0", 48 | "URI::data" : "0", 49 | "WWW::Mechanize" : "0", 50 | "WWW::Mechanize::Link" : "0", 51 | "parent" : "0", 52 | "perl" : "5.006" 53 | } 54 | }, 55 | "test" : { 56 | "requires" : { 57 | "Data::Dumper" : "0", 58 | "Image::Info" : "0", 59 | "Test::Deep" : "0", 60 | "Test::HTTP::LocalServer" : "0.61", 61 | "Test::More" : "0", 62 | "URI" : "0", 63 | "URI::file" : "0" 64 | } 65 | } 66 | }, 67 | "release_status" : "stable", 68 | "resources" : { 69 | "repository" : { 70 | "type" : "git", 71 | "url" : "git://github.com/Corion/www-mechanize-firefox.git", 72 | "web" : "https://github.com/Corion/www-mechanize-firefox" 73 | } 74 | }, 75 | "version" : "0.80", 76 | "x_serialization_backend" : "JSON::PP version 2.97001", 77 | "x_static_install" : 1 78 | } 79 | -------------------------------------------------------------------------------- /META.yml: -------------------------------------------------------------------------------- 1 | --- 2 | abstract: 'use Firefox as if it were WWW::Mechanize' 3 | author: 4 | - 'Max Maischein ' 5 | build_requires: 6 | Data::Dumper: '0' 7 | ExtUtils::MakeMaker: '0' 8 | Image::Info: '0' 9 | Test::Deep: '0' 10 | Test::HTTP::LocalServer: '0.61' 11 | Test::More: '0' 12 | URI: '0' 13 | URI::file: '0' 14 | configure_requires: 15 | ExtUtils::MakeMaker: '0' 16 | dynamic_config: 0 17 | generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' 18 | license: perl 19 | meta-spec: 20 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 21 | version: '1.4' 22 | name: WWW-Mechanize-Firefox 23 | no_index: 24 | directory: 25 | - t 26 | - inc 27 | requires: 28 | Cwd: '0' 29 | File::Basename: '0' 30 | HTML::Selector::XPath: '0' 31 | HTTP::Cookies: '0' 32 | HTTP::Date: '0' 33 | HTTP::Request::Common: '0' 34 | HTTP::Response: '0' 35 | MIME::Base64: '0' 36 | MozRepl::RemoteObject: '0.39' 37 | Object::Import: '0' 38 | Scalar::Util: '1.14' 39 | Shell::Command: '0' 40 | URI: '0' 41 | URI::data: '0' 42 | WWW::Mechanize: '0' 43 | WWW::Mechanize::Link: '0' 44 | parent: '0' 45 | perl: '5.006' 46 | resources: 47 | repository: git://github.com/Corion/www-mechanize-firefox.git 48 | version: '0.80' 49 | x_serialization_backend: 'CPAN::Meta::YAML version 0.018' 50 | x_static_install: 1 51 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | WWW::Mechanize::Firefox - use Firefox as if it were WWW::Mechanize 2 | 3 | 4 | 5 | INSTALLATION 6 | 7 | This is a Perl module distribution. It should be installed with whichever 8 | tool you use to manage your installation of Perl, e.g. any of 9 | 10 | cpanm . 11 | cpan . 12 | cpanp -i . 13 | 14 | Consult http://www.cpan.org/modules/INSTALL.html for further instruction. 15 | Should you wish to install this module manually, the procedure is 16 | 17 | perl Makefile.PL 18 | make 19 | make test 20 | make install 21 | 22 | 23 | REPOSITORY 24 | 25 | The public repository of this module is 26 | L. 27 | 28 | SUPPORT 29 | 30 | The public support forum of this module is 31 | L. 32 | 33 | TALKS 34 | 35 | I've given two talks about this module at Perl conferences: 36 | 37 | L 38 | 39 | L 40 | 41 | 42 | BUG TRACKER 43 | 44 | Please report bugs in this module via the RT CPAN bug queue at 45 | L 46 | or via mail to L. 47 | 48 | 49 | SEE ALSO 50 | 51 | AUTHOR 52 | 53 | Max Maischein C 54 | 55 | LICENSE 56 | 57 | This module is released under the same terms as Perl itself. 58 | 59 | COPYRIGHT (c) 60 | 61 | Copyright 2009-2013 by Max Maischein C. 62 | -------------------------------------------------------------------------------- /examples/README: -------------------------------------------------------------------------------- 1 | The following is a description of the example files that are provided 2 | with WWW::Mechanize::Firefox. They are intended to demonstrate the 3 | different features and options of the module. 4 | 5 | 6 | Getting started 7 | =============== 8 | open-local-file.pl Open a local file in Firefox 9 | open-url.pl Open an URL in Firefox 10 | screenshot.pl Take a screenshot of a website 11 | dump-links.pl Dump links on a webpage 12 | bcat.pl Send console text to the browser 13 | 14 | Javascript 15 | ========== 16 | manipulate-javascript.pl Make changes to Javascript values in a webpage 17 | javascript.pl Execute Javascript in the webpage context 18 | js-console.pl Send messages to the Error Console 19 | tail-console.pl Display messages from the Error Console to STDOUT 20 | 21 | Advanced / Firefox application 22 | ======== 23 | urlbar.pl Listen to changes in the location bar 24 | fullscreen.pl Switch the browser to full screen 25 | proxy-settings.pl Change the proxy settings and other settings in Firefox -------------------------------------------------------------------------------- /examples/bcat.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Getopt::Long; 5 | use Pod::Usage; 6 | use Cwd qw(getcwd); 7 | 8 | GetOptions( 9 | 'mozrepl|m:s' => \my $mozrepl, 10 | 'tab:s' => \my $tab, 11 | 'current|c' => \my $use_current_tab, 12 | 'close|q' => \my $close, 13 | 'title|t:s' => \my $title, 14 | 'type:s' => \my $encode_type, 15 | #'focus|f' => \my $focus, 16 | ) or pod2usage(); 17 | 18 | $tab = $use_current_tab ? 'current' 19 | : $tab ? qr/$tab/ 20 | : undef 21 | ; 22 | 23 | $title ||= getcwd; 24 | 25 | my $mech = WWW::Mechanize::Firefox->new( 26 | tab => $tab, 27 | repl => $mozrepl, 28 | create => 1, 29 | autoclose => $close, 30 | ); 31 | 32 | local $/; 33 | binmode STDIN; 34 | my $html = <>; 35 | 36 | # Find out whether we have HTML: 37 | if (! $encode_type) { 38 | if ($html =~ /^\s* '<', 48 | '>' => '>', 49 | '&' => '&', 50 | ); 51 | $html =~ s/([<>&])/$map{$1} || $1/ge; 52 | $html =~ s/\r?\n/
/g; 53 | $html = "$title
$html
"; 54 | }; 55 | 56 | $mech->update_html($html); 57 | 58 | =head1 NAME 59 | 60 | bcat.pl - cat HTML to browser 61 | 62 | =head1 SYNOPSIS 63 | 64 | bcat.pl 79 | 80 | Name of the tab to (re)use. A substring is enough. 81 | 82 | =item B<--current> 83 | 84 | Use the currently focused tab. 85 | 86 | =item B<--title> 87 | 88 | Give the title of the page that is shown. 89 | 90 | =item B<--close> 91 | 92 | Automatically close the tab when the input closes. This is good 93 | for displaying intermediate information. 94 | 95 | =item B<--type TYPE> 96 | 97 | Force the type to be either C or C. If the type is 98 | C, line wrapping will be added. 99 | 100 | =item B<--mozrepl> 101 | 102 | Connection information for the mozrepl instance to use. 103 | 104 | =back 105 | 106 | =head1 DESCRIPTION 107 | 108 | B will display HTML read from STDIN 109 | in a browser tab. 110 | 111 | =head1 SEE ALSO 112 | 113 | The original C utility which inspired this program 114 | at L. 115 | 116 | =cut -------------------------------------------------------------------------------- /examples/dump-links.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = WWW::Mechanize::Firefox->new(); 6 | $mech->get_local('links.html'); 7 | 8 | $mech->highlight_node( 9 | $mech->selector('a.download')); 10 | 11 | print $_->{href}, " - ", $_->{innerHTML}, "\n" 12 | for $mech->selector('a.download'); 13 | 14 | <>; 15 | 16 | =head1 NAME 17 | 18 | dump-links.pl - Dump links on a webpage 19 | 20 | =head1 SYNOPSIS 21 | 22 | dump-links.pl 23 | 24 | =head1 DESCRIPTION 25 | 26 | This program demonstrates how to read elements out of the Firefox 27 | DOM and how to get at text within nodes. 28 | 29 | It also demonstrates how you can modify elements in a webpage. 30 | 31 | =cut -------------------------------------------------------------------------------- /examples/fullscreen.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Time::HiRes; 5 | 6 | my $mech = WWW::Mechanize::Firefox->new( 7 | #log => ['debug'], 8 | ); 9 | 10 | my ($window, $type) = $mech->eval('window'); 11 | 12 | print "Going fullscreen\n"; 13 | $window->{fullScreen} = 1; 14 | 15 | sleep 10; 16 | 17 | print "Going back to normal\n"; 18 | $window->{fullScreen} = 0; 19 | 20 | =head1 NAME 21 | 22 | fullscreen.pl - toggle fullscreen mode of Firefox 23 | 24 | =head1 SYNOPSIS 25 | 26 | fullscreen.pl 27 | 28 | =head1 DESCRIPTION 29 | 30 | This program switches Firefox into fullscreen mode. It shows 31 | how to access Firefox-internal variables and how to manipulate them. 32 | 33 | =cut -------------------------------------------------------------------------------- /examples/javascript.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = WWW::Mechanize::Firefox->new(); 6 | $mech->get_local('links.html'); 7 | 8 | $mech->eval_in_page(<<'JS'); 9 | alert('Hallo Frankfurt.pm'); 10 | JS 11 | 12 | <>; 13 | 14 | =head1 NAME 15 | 16 | javascript.pl - execute Javascript in a page 17 | 18 | =head1 SYNOPSIS 19 | 20 | javascript.pl 21 | 22 | =head1 DESCRIPTION 23 | 24 | B demonstrates how to execute simple 25 | Javascript in a page. 26 | 27 | =cut -------------------------------------------------------------------------------- /examples/js-console.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Time::HiRes; 5 | use Getopt::Long; 6 | use Pod::Usage; 7 | 8 | GetOptions( 9 | 'clear|c' => \my $clear, 10 | 'mozrepl|m:s' => \my $mozrepl, 11 | 'text|t:s' => \my $text, 12 | ) or pod2usage(); 13 | 14 | my $mech = WWW::Mechanize::Firefox->new( 15 | #log => ['debug'], 16 | mozrepl => $mozrepl, 17 | ); 18 | 19 | my $console = $mech->js_console; 20 | 21 | $mech->clear_js_errors 22 | if ($clear); 23 | 24 | if ($text) { 25 | $console->logStringMessage($text); 26 | } else { 27 | while (<>) { 28 | $console->logStringMessage($_); 29 | }; 30 | }; 31 | 32 | =head1 NAME 33 | 34 | js-console.pl - send STDIN to the Javascript Console 35 | 36 | =head1 SYNOPSIS 37 | 38 | echo "Hello World" | js-console.pl 39 | 40 | Options: 41 | --clear Clear console before sending text 42 | --mozrepl connection string to Firefox 43 | --close automatically close the tab at the end of input 44 | --type TYPE Fix the type to 'html' or 'text' 45 | 46 | =head1 OPTIONS 47 | 48 | =over 4 49 | 50 | =item B<--clear> 51 | 52 | Clear the console before sending the text. 53 | 54 | =item B<--text TEXT> 55 | 56 | Send the text TEXT instead of reading from STDIN. 57 | 58 | =item B<--mozrepl> 59 | 60 | Connection information for the mozrepl instance to use. 61 | 62 | =back 63 | 64 | =head1 DESCRIPTION 65 | 66 | This program sends text read from standard input to the 67 | Javascript Console in Firefox. This can be convenient 68 | if you want to do testing and log the start or stop 69 | of a test run to the console. 70 | 71 | =head1 SEE ALSO 72 | 73 | L 74 | 75 | L - the underlying 76 | Console Service that also shows how to listen to events getting 77 | added. 78 | 79 | =cut -------------------------------------------------------------------------------- /examples/manipulate-javascript.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = WWW::Mechanize::Firefox->new(); 6 | $mech->get_local('javascript.html'); 7 | 8 | my ($val,$type) = $mech->eval_in_page(<<'JS'); 9 | secret 10 | JS 11 | 12 | if ($type ne 'string') { 13 | die "Unbekannter Ergebnistyp: $type"; 14 | }; 15 | print "Das Kennwort ist $val"; 16 | 17 | $mech->value('pass',$val); 18 | 19 | <>; 20 | 21 | =head1 NAME 22 | 23 | manipulate-javascript.pl - demonstrate how to manipulate Javascript in a page 24 | 25 | =head1 SYNOPSIS 26 | 27 | manipulate-javascript.pl 28 | 29 | =head1 DESCRIPTION 30 | 31 | This program demonstrates that you have write access to Javascript 32 | variables in Firefox and in webpages displayed through Firefox. 33 | 34 | =cut -------------------------------------------------------------------------------- /examples/open-local-file.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = WWW::Mechanize::Firefox->new(); 6 | $mech->get_local('datei.html'); 7 | 8 | <>; -------------------------------------------------------------------------------- /examples/open-url.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = WWW::Mechanize::Firefox->new( 6 | activate => 1, # bring the tab to the foreground 7 | ); 8 | $mech->get('http://www.perlworkshop.de'); 9 | 10 | <>; -------------------------------------------------------------------------------- /examples/proxy-settings.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Getopt::Long; 4 | use Firefox::Application; 5 | 6 | my $ff = Firefox::Application->new(); 7 | 8 | # Check the network proxy settings 9 | my $prefs = $ff->repl->expr(<<'JS'); 10 | Components.classes["@mozilla.org/preferences-service;1"] 11 | .getService(Components.interfaces.nsIPrefBranch); 12 | JS 13 | 14 | print "Your proxy settings are\n"; 15 | print "Proxy type\t", $prefs->getIntPref('network.proxy.type'),"\n"; 16 | print "HTTP proxy\t", $prefs->getCharPref('network.proxy.http'),"\n"; 17 | print "HTTP port\t", $prefs->getIntPref('network.proxy.http_port'),"\n"; 18 | print "SOCKS proxy\t", $prefs->getCharPref('network.proxy.socks'),"\n"; 19 | print "SOCKS port\t", $prefs->getIntPref('network.proxy.socks_port'),"\n"; 20 | 21 | # Switch off the proxy 22 | if ($prefs->getIntPref('network.proxy.type') != 0) { 23 | $prefs->setIntPref('network.proxy.type',0); 24 | }; 25 | 26 | # Switch on the manual proxy configuration 27 | $prefs->setIntPref('network.proxy.type',1); 28 | 29 | 30 | =head1 NAME 31 | 32 | proxy-settings.pl - display and change the proxy settings of Firefox 33 | 34 | =head1 SYNOPSIS 35 | 36 | proxy-settings.pl 37 | 38 | =head1 DESCRIPTION 39 | 40 | This shows how to read and write configuration settings 41 | from L . Particularly, it shows how 42 | to switch the proxy settings in Firefox on and off. 43 | 44 | =cut -------------------------------------------------------------------------------- /examples/screenshot.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Getopt::Long; 5 | use Pod::Usage; 6 | 7 | GetOptions( 8 | 'mozrepl|m:s' => \my $mozrepl, 9 | 'outfile|o:s' => \my $outfile, 10 | 'tab|t:s' => \my $tab, 11 | 'target-width|tw:s' => \my $target_w, 12 | 'target-height|th:s' => \my $target_h, 13 | 'target-scale|s:s' => \my $target_scale, 14 | 'target-scale-x|sx:s' => \my $target_scale_w, 15 | 'target-scale-y|sy:s' => \my $target_scale_h, 16 | 'current|c' => \my $current, 17 | ) or pod2usage(); 18 | $outfile ||= 'screenshot.png'; 19 | 20 | my @args; 21 | if (! @ARGV) { 22 | push @args, tab => 'current'; 23 | }; 24 | 25 | if ($tab) { 26 | $tab = qr/$tab/; 27 | } elsif ($current) { 28 | $tab = $current 29 | }; 30 | 31 | my $mech = WWW::Mechanize::Firefox->new( 32 | launch => 'firefox', 33 | create => 1, 34 | tab => $tab, 35 | autoclose => (!$tab), 36 | @args 37 | ); 38 | 39 | if (@ARGV) { 40 | $mech->get($ARGV[0]); 41 | }; 42 | 43 | my $png = $mech->content_as_png(undef,undef, 44 | { 45 | width => $target_w, 46 | height => $target_h, 47 | scalex => ($target_scale_w||$target_scale), 48 | scaley => ($target_scale_h||$target_scale), 49 | } 50 | ); 51 | 52 | open my $out, '>', $outfile 53 | or die "Couldn't create '$outfile': $!"; 54 | binmode $out; 55 | print {$out} $png; 56 | 57 | =head1 NAME 58 | 59 | screenshot.pl - take a screenshot of a webpage 60 | 61 | =head1 SYNOPSIS 62 | 63 | screenshot.pl [options] [url] 64 | 65 | Options: 66 | --outfile name of output file 67 | --mozrepl connection string to Firefox 68 | --tab name of the tab title to use 69 | --current use currently active tab 70 | --target-width width of target image (in pixels) 71 | --target-height height of target image (in pixels) 72 | --target-scale scale of target image (ratio) 73 | 74 | =head1 OPTIONS 75 | 76 | =over 4 77 | 78 | =item B<--outfile> 79 | 80 | Name of the output file. The image will always be written 81 | in PNG format. 82 | 83 | =item B<--mozrepl> 84 | 85 | Connection information for the mozrepl instance to use. 86 | 87 | =back 88 | 89 | =head1 DESCRIPTION 90 | 91 | B will take a screenshot 92 | of the given URL (including plugins) and 93 | write it to the given file or the file C. 94 | 95 | =cut -------------------------------------------------------------------------------- /examples/tail-console.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Time::HiRes; 5 | use Getopt::Long; 6 | use Pod::Usage; 7 | 8 | GetOptions( 9 | 'mozrepl|m:s' => \my $mozrepl, 10 | 'follow|f' => \my $install_listener, 11 | 'clear|c' => \my $clear, 12 | 'number|n:i' => \my $lines, 13 | ) or pod2usage(2); 14 | $lines ||= 5; 15 | 16 | my $mech = WWW::Mechanize::Firefox->new( 17 | #log => ['debug'], 18 | mozrepl => $mozrepl, 19 | ); 20 | 21 | sub install_listener { 22 | warn "Creating logListener"; 23 | my $logListener = $mech->repl->declare(<<'JS'); 24 | function(callback) { 25 | return { 26 | observe: callback, 27 | QueryInterface: function (iid) { 28 | if (!iid.equals(Components.interfaces.nsIConsoleListener) && 29 | !iid.equals(Components.interfaces.nsISupports)) { 30 | throw Components.results.NS_ERROR_NO_INTERFACE; 31 | } 32 | return this; 33 | }, 34 | }; 35 | } 36 | JS 37 | 38 | warn "Creating registerListener"; 39 | 40 | my $registerListener = $mech->repl->declare(<<'JS'); 41 | function (listener) { 42 | var aConsoleService = Components.classes["@mozilla.org/consoleservice;1"] 43 | .getService(Components.interfaces.nsIConsoleService); 44 | aConsoleService.registerListener(listener); 45 | }; 46 | JS 47 | 48 | my $listener = $logListener->(sub {output_message($_[0])}); 49 | $registerListener->($listener); 50 | }; 51 | 52 | sub output_message { 53 | print "$_[0]->{message}\n"; 54 | }; 55 | 56 | my $console = $mech->js_console; 57 | 58 | $mech->clear_js_errors 59 | if ($clear); 60 | 61 | output_message $_ for reverse (grep {defined} ($mech->js_errors)[-$lines..0]); 62 | 63 | if ($install_listener) { 64 | my $l = install_listener; 65 | while (1) { 66 | $mech->repl->poll; 67 | sleep 0.25; 68 | }; 69 | }; 70 | 71 | =head1 NAME 72 | 73 | js-console.pl - send STDIN to the Javascript Console 74 | 75 | =head1 SYNOPSIS 76 | 77 | tail-console.pl -f 78 | 79 | Options: 80 | --clear Clear console before receiving new messages 81 | --follow Read more messages as they are being added 82 | --mozrepl connection string to Firefox 83 | 84 | =head1 OPTIONS 85 | 86 | =over 4 87 | 88 | =item B<--clear> 89 | 90 | Clear the console before sending the text. 91 | 92 | =item B<--follow> 93 | 94 | Keep watching the console and output text as it gets added. 95 | 96 | =item B<--mozrepl> 97 | 98 | Connection information for the mozrepl instance to use. 99 | 100 | =back 101 | 102 | =head1 DESCRIPTION 103 | 104 | This program reads messages from the Error Console and sends them 105 | to STDOUT. 106 | 107 | =head1 SEE ALSO 108 | 109 | L 110 | 111 | L - the underlying 112 | Console Service that also shows how to listen to events getting 113 | added. 114 | 115 | =cut -------------------------------------------------------------------------------- /examples/urlbar.pl: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Time::HiRes; 5 | 6 | my $mech = WWW::Mechanize::Firefox->new( 7 | #log => ['debug'], 8 | ); 9 | $mech->get('http://www.cpan.org'); 10 | 11 | my $mk_listener = $mech->repl->declare(<<'JS'); 12 | function (myListener,source) { 13 | myListener.source = source; 14 | const STATE_START = Components.interfaces.nsIWebProgressListener.STATE_START; 15 | const STATE_STOP = Components.interfaces.nsIWebProgressListener.STATE_STOP; 16 | var callbacks = ['onStateChange', 17 | 'onLocationChange', 18 | "onProgressChange", 19 | "onStatusChange", 20 | "onSecurityChange", 21 | ]; 22 | for (var h in callbacks) { 23 | var e = callbacks[h]; 24 | if (! myListener[e]) { 25 | myListener[e] = function(){} 26 | }; 27 | }; 28 | myListener.QueryInterface = function(aIID) { 29 | if (aIID.equals(Components.interfaces.nsIWebProgressListener) || 30 | aIID.equals(Components.interfaces.nsISupportsWeakReference) || 31 | aIID.equals(Components.interfaces.nsISupports)) 32 | return this; 33 | throw Components.results.NS_NOINTERFACE; 34 | }; 35 | return myListener 36 | } 37 | JS 38 | 39 | =begin JSDoc 40 | 41 | "onStateChange": handlers[ 42 | function(aWebProgress, aRequest, aFlag, aStatus) 43 | { 44 | // If you use myListener for more than one tab/window, use 45 | // aWebProgress.DOMWindow to obtain the tab/window which triggers the state change 46 | if(aFlag & STATE_START) 47 | { 48 | // This fires when the load event is initiated 49 | onLoadStart(aWebProgress,aRequest,aStatus); 50 | } 51 | if(aFlag & STATE_STOP) 52 | { 53 | // This fires when the load finishes 54 | onLoadStop(aWebProgress,aRequest,aStatus); 55 | } 56 | }, 57 | 58 | "onLocationChange": function(aProgress, aRequest, aURI) 59 | { 60 | // This fires when the location bar changes; i.e load event is confirmed 61 | // or when the user switches tabs. If you use myListener for more than one tab/window, 62 | // use aProgress.DOMWindow to obtain the tab/window which triggered the change. 63 | }, 64 | 65 | // For definitions of the remaining functions see related documentation 66 | "onProgressChange": function(aWebProgress, aRequest, curSelf, maxSelf, curTot, maxTot) { }, 67 | "onStatusChange": function(aWebProgress, aRequest, aStatus, aMessage) { }, 68 | "onSecurityChange": function(aWebProgress, aRequest, aState) { }, 69 | }; 70 | =cut 71 | 72 | sub onStateChange { 73 | my ($progress,$request,$flag,$status) = @_; 74 | print "@_\n"; 75 | } 76 | 77 | sub onLocationChange { 78 | my ($progress,$request,$uri) = @_; 79 | print "Location :", $uri->{spec},"\n"; 80 | } 81 | 82 | my $NOTIFY_STATE_DOCUMENT = $mech->repl->expr('Components.interfaces.nsIWebProgress.NOTIFY_STATE_DOCUMENT'); 83 | sub event_listener { 84 | my ($source,%handlers) = @_; 85 | my ($obj) = $mech->repl->expr('new Object'); 86 | for my $key (keys %handlers) { 87 | $obj->{$key} = $handlers{$key}; 88 | }; 89 | my $lsn = $mk_listener->($obj,$source); 90 | $lsn->__release_action('self.source.removeEventListener(self)'); 91 | $source->addProgressListener($lsn,$NOTIFY_STATE_DOCUMENT); 92 | $lsn; 93 | }; 94 | 95 | my $browser = $mech->repl->expr('window.getBrowser()'); 96 | 97 | my $eventlistener = event_listener( 98 | $browser, 99 | onLocationChange => \&onLocationChange, 100 | ); 101 | 102 | while (1) { 103 | $mech->repl->poll(); 104 | sleep 1; 105 | }; 106 | -------------------------------------------------------------------------------- /lib/Firefox/Application/API36.pm: -------------------------------------------------------------------------------- 1 | package Firefox::Application::API36; 2 | use strict; 3 | use parent 'Firefox::Application'; 4 | use Firefox::Application::API35; 5 | our $VERSION = '0.80'; 6 | 7 | =head1 NAME 8 | 9 | Firefox::Application::API36 - API wrapper for Firefox 3.6+ 10 | 11 | =head1 SYNOPSIS 12 | 13 | use Firefox::Application; 14 | my $ff = Firefox::Application->new( 15 | # Force the Firefox 3.5 API 16 | api => 'Firefox::Application::API35', 17 | ); 18 | 19 | =head1 METHODS 20 | 21 | =head2 C<< $api->updateitems( %args ) >> 22 | 23 | for my $item ($api->updateitems) { 24 | print sprintf "Name: %s\n", $item->{name}; 25 | print sprintf "Version: %s\n", $item->{version}; 26 | print sprintf "GUID: %s\n", $item->{id}; 27 | }; 28 | 29 | Returns the list of updateable items. Under Firefox 4, 30 | can be restricted by the C option. 31 | 32 | =over 4 33 | 34 | =item * C - type of items to fetch 35 | 36 | C - fetch any item 37 | 38 | C - fetch add-ons 39 | 40 | C - fetch locales 41 | 42 | C - fetch themes 43 | 44 | =back 45 | 46 | =cut 47 | 48 | sub import_from_api35 { 49 | my ($name) = @_; 50 | no strict 'refs'; 51 | *{"$name"} = \&{ "Firefox::Application::API35::$name" }; 52 | }; 53 | 54 | import_from_api35($_) 55 | for (qw(updateitems addons themes locales 56 | selectedTab addTab autoclose_tab closeTab openTabs 57 | )); 58 | 59 | =head2 C<< $ff->closeTab( $tab [,$repl] ) >> 60 | 61 | $ff->closeTab( $tab ); 62 | 63 | Close the given tab. 64 | 65 | =cut 66 | 67 | =head2 C<< $api->element_query( \@elements, \%attributes ) >> 68 | 69 | my $query = $element_query(['input', 'select', 'textarea'], 70 | { name => 'foo' }); 71 | 72 | Returns the XPath query that searches for all elements with Cs 73 | in C<@elements> having the attributes C<%attributes>. The C<@elements> 74 | will form an C condition, while the attributes will form an C 75 | condition. 76 | 77 | =cut 78 | 79 | sub element_query { 80 | my ($self, $elements, $attributes) = @_; 81 | my $query = 82 | './/*[(' . 83 | join( ' or ', 84 | map { 85 | sprintf qq{local-name(.)="%s"}, lc $_ 86 | } @$elements 87 | ) 88 | . ') and ' 89 | . join( " and ", 90 | map { sprintf q{@%s="%s"}, $_, $attributes->{$_} } 91 | sort keys(%$attributes) 92 | ) 93 | . ']'; 94 | }; 95 | 96 | 1; 97 | 98 | =head1 AUTHOR 99 | 100 | Max Maischein C 101 | 102 | =head1 COPYRIGHT (c) 103 | 104 | Copyright 2009-2014 by Max Maischein C. 105 | 106 | =head1 LICENSE 107 | 108 | This module is released under the same terms as Perl itself. 109 | 110 | =cut 111 | -------------------------------------------------------------------------------- /lib/HTML/Display/MozRepl.pm: -------------------------------------------------------------------------------- 1 | package HTML::Display::MozRepl; 2 | use strict; 3 | use Carp qw(carp); 4 | use WWW::Mechanize::Firefox; 5 | use parent 'HTML::Display::Common'; 6 | our $VERSION = '0.80'; 7 | 8 | =head1 NAME 9 | 10 | HTML::Display::MozRepl - use a mozrepl enabled Firefox to display HTML 11 | 12 | =head1 SYNOPSIS 13 | 14 | $ENV{PERL_HTML_DISPLAY} = 'HTML::Display::MozRepl'; 15 | 16 | =cut 17 | 18 | sub new { 19 | my ($class,%options) = @_; 20 | my $self = $class->SUPER::new(); 21 | my $ff = WWW::Mechanize::Firefox->new( 22 | autoclose => 0, 23 | %options, 24 | ); 25 | $self->{ff} = $ff; 26 | $self; 27 | }; 28 | 29 | sub ff { $_[0]->{ff} }; 30 | 31 | sub display_html { 32 | my ($self,$html) = @_; 33 | if ($html) { 34 | my $browser = $self->ff; 35 | $browser->update_html($html); 36 | } else { 37 | carp "No HTML given" unless $html; 38 | }; 39 | }; 40 | 41 | =head1 SEE ALSO 42 | 43 | L 44 | 45 | =head1 REPOSITORY 46 | 47 | The public repository of this module is 48 | L. 49 | 50 | =head1 AUTHOR 51 | 52 | Copyright (c) 2009-2014 Max Maischein C<< >> 53 | 54 | =head1 LICENSE 55 | 56 | This module is released under the same terms as Perl itself. 57 | 58 | =cut 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/WWW/Mechanize/Firefox/DSL.pm: -------------------------------------------------------------------------------- 1 | package WWW::Mechanize::Firefox::DSL; 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Object::Import; 5 | use Carp qw(croak); 6 | 7 | our $VERSION = '0.80'; 8 | 9 | our @CARP_NOT = (qw[ 10 | WWW::Mechanize::Firefox 11 | ]); 12 | 13 | =head1 NAME 14 | 15 | WWW::Mechanize::Firefox::DSL - Domain Specific Language for short scripts 16 | 17 | =head1 SYNOPSIS 18 | 19 | use WWW::Mechanize::Firefox::DSL '$mech'; 20 | 21 | get 'http://google.de'; 22 | 23 | my @links = selector('a'); 24 | print $_->{innerHTML},"\n" for @links; 25 | 26 | click($links[0]); 27 | 28 | print content; 29 | 30 | This module exports all methods of one WWW::Mechanize::Firefox 31 | object as subroutines. That way, you can write short scripts without 32 | cluttering every line with C<< $mech-> >>. 33 | 34 | This module is highly experimental and might vanish from the distribution 35 | again if I find that it is useless. 36 | 37 | =cut 38 | 39 | sub import { 40 | my ($class, %options); 41 | if (@_ == 2) { 42 | ($class, $options{ name }) = @_; 43 | } else { 44 | ($class, %options) = @_; 45 | }; 46 | my $target = delete $options{ target } || caller; 47 | my $name = delete $options{ name } || '$mech'; 48 | my $mech = WWW::Mechanize::Firefox->new(%options); 49 | 50 | $name =~ s/^[\$]// 51 | or croak 'Variable name must start with $'; 52 | { 53 | no strict 'refs'; 54 | *{"$target\::$name"} = \$mech; 55 | import Object::Import \${"$target\::$name"}, 56 | deref => 1, 57 | target => $target, 58 | ; 59 | }; 60 | }; 61 | 62 | 1; 63 | 64 | =head1 AUTHORS 65 | 66 | Max Maischein C 67 | 68 | =head1 COPYRIGHT (c) 69 | 70 | Copyright 2009-2014 by Max Maischein C. 71 | 72 | =head1 LICENSE 73 | 74 | This module is released under the same terms as Perl itself. 75 | 76 | =cut 77 | -------------------------------------------------------------------------------- /lib/WWW/Mechanize/Firefox/Installation.pod: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =head1 NAME 4 | 5 | WWW::Mechanize::Firefox::Installation - How to install the components 6 | 7 | =head1 Installation 8 | 9 | If you notice that tests get skipped and/or the module installs 10 | but "does not seem to work", there are some more steps required 11 | to configure Firefox: 12 | 13 | =over 4 14 | 15 | =item 1. 16 | 17 | Download mozrepl 1.1.2 available from 18 | 19 | L 20 | 21 | or a later version from 22 | 23 | L 24 | 25 | 26 | =item 2. 27 | 28 | If you downloaded the version from C, skip to 5. 29 | 30 | If you downloaded a version from github, unpack the zip archive into a directory. 31 | The version distributed by C is ready for direct installation. 32 | 33 | The archive contains one subdirectory with a name 34 | of the form C. 35 | 36 | =item 3. 37 | 38 | Create a new zip archive with the files in the subdirectory 39 | C. This new archive must have 40 | the files at the root entry, not in a subdirectory. 41 | 42 | The file layout should look like this: 43 | 44 | chrome/ 45 | components/ 46 | defaults/ 47 | chrome.manifest 48 | install.rdf 49 | logo.png 50 | 51 | =item 4. 52 | 53 | Rename your new zip archive from C<.zip> to C<.xpi>. 54 | 55 | =item 5. 56 | 57 | Launch Firefox 58 | 59 | =item 6. 60 | 61 | Install the downloaded or freshly created C<.xpi> file into Firefox. 62 | For example you can drag and drop the file into Firefox. 63 | 64 | =item 7. 65 | 66 | Start C in Firefox by going to the menu: 67 | 68 | "Tools" -> "MozRepl" -> "Start" 69 | 70 | You may want to tick the "Activate on startup" item. 71 | 72 | Alternatively, launch the Firefox binary with the C<-mozrepl> command line 73 | switch: 74 | 75 | firefox -repl 76 | 77 | =back 78 | 79 | If tests still fail, especially t/50-click.t and 51-mech-submit.t , 80 | this might be because you use the NoScript Mozilla extension 81 | and have it blocking Javascript for file:// URLs. While this is good, 82 | the tests need Javascript enabled. 83 | 84 | =over 4 85 | 86 | =item 1. 87 | 88 | Open t/50-click.html in Firefox 89 | 90 | =item 2. 91 | 92 | Allow Javascript for all file:// URLs 93 | 94 | =item 3. 95 | 96 | Re-run tests 97 | 98 | perl Makefile.PL 99 | nmake test 100 | 101 | or if you are using Strawberry Perl or Citrus Perl 102 | 103 | perl Makefile.PL 104 | dmake test 105 | 106 | =item 4. 107 | 108 | No test should fail 109 | 110 | =back 111 | 112 | If tests fail with an error from Firefox that a file could not 113 | be found, check that the test suite and the Firefox process are 114 | run using the same user. Otherwise, the Firefox process might not 115 | have the permissions to access the files created by the test suite. 116 | 117 | =head1 PPMs 118 | 119 | If you use ActiveStates package manager, you can find 120 | some pre-packaged but untested PPMs at 121 | L . 122 | 123 | As I don't use C, I can't offer any support for them. 124 | 125 | =head1 AUTHOR 126 | 127 | Max Maischein C 128 | 129 | =head1 COPYRIGHT 130 | 131 | Copyright 2010-2014 by Max Maischein C. 132 | 133 | All Rights Reserved. This module is free software. It may be used, 134 | redistributed and/or modified under the same terms as Perl itself. 135 | 136 | =cut -------------------------------------------------------------------------------- /makeppd.pl: -------------------------------------------------------------------------------- 1 | #makeppd.pl 2.0 2 | use FileHandle; 3 | use File::DosGlob qw(bsd_glob); 4 | #use Win32::FileOp; 5 | use Config; 6 | 7 | $make=$Config{make}; 8 | 9 | my $has_xs = 0; 10 | 11 | system('perl Makefile.PL'); 12 | system($make) and die "Failed to make!\n"; 13 | 14 | system($make, 'dist'); # this creates the ordinary distribution 15 | # I need the archive to find the version number! 16 | # If you comment this out, always copy the archive to current directory. 17 | 18 | # this part of code finds the latest distribution, I don't have time to 19 | # explore how to find the version number 20 | @archives = grep {!/-PPM\.tar\.gz$/i} bsd_glob('*.tar.gz'); 21 | $archive = findNewest (@archives); 22 | 23 | ($name = $archive) =~ s/\.tar\.gz$//; 24 | ($module = $name) =~ s/-[\d.]+$//; 25 | ($file = $module) =~ s/^.*-(.*?)$/$1/; 26 | 27 | $ppd = $module.".ppd"; 28 | $module =~ s/-/\\/g; 29 | 30 | print "Module name : $file\n"; 31 | print "Newest archive is $archive\n"; 32 | 33 | system('perl','Makefile.PL', "BINARY_LOCATION=$name-PPM.tar.gz"); 34 | #system($make, 'ppd'); 35 | # you may do something like 36 | system($make, 'ppd', "BINARY_LOCATION=$name-PPM.tar.gz"); 37 | # if you do not apply my patch to ExtUtils\MM_Unix.pm 38 | 39 | system("tar cvf $name-PPM.tar blib"); 40 | system("gzip --best $name-PPM.tar"); 41 | 42 | #Delete qw(blib pod2html-dircache pod2html-itemcache pm_to_blib pod2htmd.x~~ pod2htmi.x~~); 43 | 44 | if (! $has_xs) { 45 | open $PPD, "<$ppd" or die "Can't open the $ppd file: $!\n"; 46 | open $NEWPPD, ">$ppd.tmp" or die "Can't create the $ppd.tmp file: $!\n"; 47 | while (<$PPD>) { 48 | next if (/ $ppd; 54 | } 55 | 56 | exit; 57 | 58 | #================== 59 | 60 | sub findNewest { 61 | my $maxitem; 62 | my $maxver = pack('C4',0,0,0,0); 63 | foreach my $item (@_) { 64 | $item =~ /-(\d+)\.(\d+)\.(?:(\d+)\.(?:(\d+)\.)?)?tar\.gz/; 65 | my $ver = pack('C4',$1,$2,$3,$4); 66 | 67 | if ($ver gt $maxver) { 68 | $maxver = $ver; 69 | $maxitem = $item; 70 | } 71 | } 72 | return $maxitem; 73 | } 74 | 75 | -------------------------------------------------------------------------------- /runtests.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib '.'; 5 | use t::helper; 6 | use WWW::Mechanize::Firefox; 7 | use File::Glob qw( bsd_glob ); 8 | use Config; 9 | use Getopt::Long; 10 | 11 | GetOptions( 12 | 't|test:s' => \my $tests, 13 | 'c|continue' => \my $continue, 14 | ); 15 | my @tests; 16 | if( $tests ) { 17 | @tests= bsd_glob( $tests ); 18 | }; 19 | 20 | =head1 NAME 21 | 22 | runtests.pl - runs the test suite across several instances of Firefox 23 | 24 | =cut 25 | 26 | my @instances = @ARGV 27 | ? map { bsd_glob $_ } @ARGV 28 | : t::helper::firefox_instances; 29 | my $port = 4243; 30 | 31 | # Later, we could even parallelize the test suite 32 | # if I find out how to make the mozrepl port dynamic 33 | for my $instance (@instances) { 34 | # Launch firefox 35 | my $vis_instance = $instance ? $instance : "local instance"; 36 | warn $vis_instance; 37 | my @launch = $instance 38 | ? (launch => [$instance,'-repl', $port, 'about:blank']) 39 | : () 40 | ; 41 | 42 | if( $instance ) { 43 | $ENV{TEST_WWW_MECHANIZE_FIREFOX_VERSIONS} = $instance; 44 | $ENV{MOZREPL}= "localhost:$port"; 45 | } else { 46 | $ENV{TEST_WWW_MECHANIZE_FIREFOX_VERSIONS} = "don't test other instances"; 47 | delete $ENV{MOZREPL}; # my local setup ... 48 | }; 49 | my $retries = 3; 50 | 51 | my $ff; 52 | while( $retries-- and !$ff) { 53 | $ff= eval { 54 | Firefox::Application->new( 55 | @launch, 56 | ); 57 | }; 58 | }; 59 | die "Couldn't launch Firefox instance from $instance" 60 | unless $ff; 61 | 62 | if( @tests ) { 63 | for my $test (@tests) { 64 | system(qq{perl -Ilib -w "$test"}) == 0 65 | or ($continue and warn "Error while testing $vis_instance: $!/$?") 66 | or die "Error while testing $vis_instance: $!/$?"; 67 | }; 68 | } else { # run all tests 69 | system("$Config{ make } test") == 0 70 | or ($continue and warn "Error while testing $vis_instance: $!/$?") 71 | or die "Error while testing $vis_instance"; 72 | }; 73 | 74 | if( $instance ) { 75 | # Close firefox again 76 | # Quit in 500ms, so we have time to shut our socket down 77 | $ff->repl->expr(<<'JS'); 78 | var wm = Components.classes["@mozilla.org/appshell/window-mediator;1"] 79 | .getService(Components.interfaces.nsIWindowMediator); 80 | var win = wm.getMostRecentWindow('navigator:browser'); 81 | win.setTimeout(function() { 82 | Components.classes["@mozilla.org/toolkit/app-startup;1"] 83 | .getService(Components.interfaces.nsIAppStartup).quit(0x02); 84 | }, 500); 85 | JS 86 | }; 87 | undef $ff; 88 | # Safe wait until shutdown 89 | sleep 5; 90 | }; -------------------------------------------------------------------------------- /t/00-load.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More tests => 1; 7 | 8 | my $module; 9 | 10 | BEGIN { 11 | $module = "WWW::Mechanize::Firefox"; 12 | require_ok( $module ); 13 | } 14 | 15 | diag( sprintf "Testing %s %s, Perl %s", $module, $module->VERSION, $] ); 16 | 17 | for (sort grep /\.pm\z/, keys %INC) { 18 | s/\.pm\z//; 19 | s!/!::!g; 20 | eval { diag(join(' ', $_, $_->VERSION || '')) }; 21 | } 22 | -------------------------------------------------------------------------------- /t/01-mech-destroy.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use Cwd; 5 | use URI::file; 6 | use File::Basename; 7 | use File::Spec; 8 | use WWW::Mechanize::Firefox; 9 | 10 | my $mech = eval { WWW::Mechanize::Firefox->new( 11 | autodie => 0, 12 | #log => [qw[debug]] 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 2; 21 | }; 22 | 23 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 24 | 25 | my $destroyed; 26 | no warnings 'redefine'; 27 | *WWW::Mechanize::Firefox::DESTROY = sub { 28 | $destroyed++ 29 | }; 30 | undef $mech; 31 | is $destroyed, 1, "Nothing keeps the instance alive"; 32 | -------------------------------------------------------------------------------- /t/401-server: -------------------------------------------------------------------------------- 1 | # Thanks to merlyn for nudging me and giving me this snippet! 2 | use strict; 3 | use HTTP::Daemon; 4 | use LWP::UserAgent; 5 | 6 | $|++; 7 | 8 | my $d = HTTP::Daemon->new or die; 9 | print $d->url, "\n"; 10 | 11 | # How many requests do we expect? 12 | my ($ex_user,$ex_pass) = @ARGV; 13 | 14 | my $verbose = $ENV{TEST_HTTP_VERBOSE}; 15 | 16 | my $done = 0; 17 | while (! $done and my $c = $d->accept) { 18 | while (my $req = $c->get_request) { 19 | if ($verbose) { 20 | warn "# Request URI: " . $req->url->path; 21 | my @lines = split "\n",$req->as_string; 22 | warn "# $_\n" for @lines; 23 | }; 24 | 25 | my $res; 26 | my ($user,$pass); 27 | if ($req->url->path eq '/exit') { 28 | $done = 1; 29 | $res = HTTP::Response->new(200, "OK", undef, "done"); 30 | 31 | } elsif ( ($user, $pass) = $req->authorization_basic 32 | and $user eq $ex_user 33 | and $pass eq $ex_pass) { 34 | $res = HTTP::Response->new(200, "OK", undef, 35 | "user = '$user' pass = '$pass'"); 36 | $res->header('Connection' => 'close');# bye 37 | 38 | } else { 39 | warn "# User : '$user' Password : '$pass'\n" 40 | if $verbose; 41 | $res = HTTP::Response->new(401, "Auth Required", undef, 42 | "auth required ($user/$pass)"); 43 | $res->www_authenticate("Basic realm=\"testing realm\""); 44 | }; 45 | 46 | if ($verbose) { 47 | warn "---\n"; 48 | my @lines = split "\n",$res->as_string; 49 | warn "# $_\n" for @lines; 50 | }; 51 | $c->send_response($res); 52 | } 53 | $c->close; 54 | undef($c); 55 | }; 56 | -------------------------------------------------------------------------------- /t/47-mech-memleak2.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | #use_queue => 0, 10 | )}; 11 | 12 | if (! $mech) { 13 | my $err = $@; 14 | plan skip_all => "Couldn't connect to MozRepl: $@"; 15 | exit 16 | } else { 17 | plan tests => 2; 18 | }; 19 | 20 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 21 | 22 | $mech->get_local('52-frameset.html'); 23 | 24 | my @content = $mech->xpath('//*[@id="content"]', frames => 1); 25 | @content = (); 26 | 27 | # Check that refcounting works and releases the bridge once we release 28 | # our $mech instance 29 | my $destroyed; 30 | my $old_DESTROY = \&MozRepl::RemoteObject::DESTROY; 31 | { no warnings 'redefine'; 32 | *MozRepl::RemoteObject::DESTROY = sub { 33 | $destroyed++; 34 | goto $old_DESTROY; 35 | } 36 | }; 37 | 38 | $MozRepl::RemoteObject::WARN_ON_LEAKS = 1; 39 | undef $mech; 40 | is $destroyed, 1, "Bridge was torn down"; 41 | -------------------------------------------------------------------------------- /t/47-mech-ref-memleak.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 2; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | sub is_object($$$) { 22 | my ($l,$r,$name) = @_; 23 | my $is_id = $mech->repl->declare(<<'JS'); 24 | function (l,r) { 25 | return l === r 26 | }; 27 | JS 28 | ok $is_id->($l,$r), $name 29 | or diag "Got $l->{tagName}, expected $r->{tagName}"; 30 | }; 31 | 32 | # Check that refcounting works and releases the bridge once we release 33 | # our $mech instance 34 | my $destroyed; 35 | my $old_DESTROY = \&MozRepl::RemoteObject::DESTROY; 36 | { no warnings 'redefine'; 37 | *MozRepl::RemoteObject::DESTROY = sub { 38 | $destroyed++; 39 | goto $old_DESTROY; 40 | } 41 | }; 42 | 43 | undef $mech; 44 | $MozRepl::RemoteObject::WARN_ON_LEAKS = 1; 45 | is $destroyed, 1, "Bridge was torn down"; 46 | -------------------------------------------------------------------------------- /t/47-mech-simplest.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 1; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | -------------------------------------------------------------------------------- /t/48-mech-launch.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use Cwd; 5 | use URI::file; 6 | use File::Basename; 7 | use File::Spec; 8 | use WWW::Mechanize::Firefox; 9 | 10 | my $mech = eval { WWW::Mechanize::Firefox->new( 11 | autodie => 0, 12 | launch => 'C:/Programme/Mozilla Firefox/firefox', 13 | #log => [qw[debug]] 14 | )}; 15 | 16 | if (! $mech) { 17 | my $err = $@; 18 | plan skip_all => "Couldn't connect to MozRepl: $@"; 19 | exit 20 | } else { 21 | plan tests => 1; 22 | }; 23 | 24 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 25 | 26 | undef $mech; -------------------------------------------------------------------------------- /t/49-mech-get-file.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 49-mech-get-file.html 5 | 8 | 9 | 10 |

A Javascript page that has no (JS) errors

11 | 12 | -------------------------------------------------------------------------------- /t/49-mech-get-file.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use Cwd; 5 | use URI::file; 6 | use File::Basename; 7 | use File::Spec; 8 | use WWW::Mechanize::Firefox; 9 | 10 | my $mech = eval { WWW::Mechanize::Firefox->new( 11 | autodie => 0, 12 | #log => [qw[debug]] 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 8; 21 | }; 22 | 23 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 24 | 25 | sub load_file_ok { 26 | my ($htmlfile,@options) = @_; 27 | my $fn = File::Spec->rel2abs( 28 | File::Spec->catfile(dirname($0),$htmlfile), 29 | getcwd, 30 | ); 31 | $mech->allow(@options); 32 | $fn =~ s!\\!/!g; # fakey "make file:// URL" 33 | diag "Loading $fn"; 34 | $mech->get("file://$fn"); 35 | ok $mech->success, $htmlfile; 36 | is $mech->title, $htmlfile, "We loaded the right file (@options)"; 37 | }; 38 | 39 | load_file_ok('49-mech-get-file.html', javascript => 0); 40 | $mech->get('about:blank'); 41 | load_file_ok('49-mech-get-file.html', javascript => 1); 42 | $mech->get('about:blank'); 43 | 44 | $mech->get_local('49-mech-get-file.html'); 45 | ok $mech->success, '49-mech-get-file.html'; 46 | is $mech->title, '49-mech-get-file.html', "We loaded the right file"; 47 | 48 | ok $mech->is_html, "The local file gets identified as HTML"; 49 | 50 | undef $mech; -------------------------------------------------------------------------------- /t/49-mech-nav.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use warnings; 4 | use strict; 5 | use Test::More; 6 | 7 | use WWW::Mechanize::Firefox; 8 | use lib './inc', '../inc'; 9 | use Test::HTTP::LocalServer; 10 | 11 | my $mech = eval { WWW::Mechanize::Firefox->new( 12 | autodie => 1, 13 | #log => [qw[debug]], 14 | #on_event => 1, 15 | )}; 16 | 17 | if (! $mech) { 18 | my $err = $@; 19 | plan skip_all => "Couldn't connect to MozRepl: $@"; 20 | exit 21 | } else { 22 | plan tests => 3; 23 | }; 24 | 25 | my $server = Test::HTTP::LocalServer->spawn( 26 | #debug => 1, 27 | ); 28 | 29 | $mech->get($server->url); 30 | 31 | $mech->click_button(number => 1); 32 | like( $mech->uri, qr/formsubmit/, 'Clicking on button by number' ); 33 | my $last = $mech->uri; 34 | 35 | diag "Going back"; 36 | $mech->back; 37 | is $mech->uri, $server->url, 'We went back'; 38 | 39 | diag "Going forward"; 40 | $mech->forward; 41 | is $mech->uri, $last, 'We went forward'; 42 | -------------------------------------------------------------------------------- /t/49-mech-reuse.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use Cwd; 5 | use URI::file; 6 | use File::Basename; 7 | use File::Spec; 8 | use WWW::Mechanize::Firefox; 9 | 10 | my $mech = eval { WWW::Mechanize::Firefox->new( 11 | autodie => 0, 12 | autoclose => 0, 13 | #log => [qw[debug]] 14 | )}; 15 | 16 | if (! $mech) { 17 | my $err = $@; 18 | plan skip_all => "Couldn't connect to MozRepl: $@"; 19 | exit 20 | } else { 21 | plan tests => 7; 22 | }; 23 | 24 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 25 | 26 | $mech->get_local('49-mech-get-file.html'); 27 | ok $mech->success, '49-mech-get-file.html'; 28 | is $mech->title, '49-mech-get-file.html', "We loaded the right file"; 29 | 30 | undef $mech; 31 | 32 | $mech = eval { WWW::Mechanize::Firefox->new( 33 | tab => qr/^\Q49-mech-get-file.html/, 34 | autoclose => 1, 35 | #log => [qw[debug]] 36 | )}; 37 | is $@, ''; 38 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 39 | undef $mech; 40 | 41 | $mech = eval { WWW::Mechanize::Firefox->new( 42 | tab => qr/^\Q49-mech-get-file.html/, 43 | )}; 44 | is $mech, undef, "If a tab doesn't exist, that's fatal"; 45 | 46 | $mech = eval { WWW::Mechanize::Firefox->new( 47 | tab => qr/^\Q49-mech-get-file.html/, 48 | create => 1, 49 | autoclose => 1, 50 | #log => [qw[debug]] 51 | )}; 52 | # but we can (re)create it 53 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 54 | undef $mech; 55 | -------------------------------------------------------------------------------- /t/50-allow-js.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 7; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | $mech->autodie(1); 21 | 22 | # Why doesn't this disallow JS when NoScript is installed? 23 | $mech->allow('javascript' => 0); 24 | $mech->get_local('50-click.html'); 25 | $mech->allow('javascript' => 0); 26 | 27 | my ($clicked,$type,$end); 28 | eval { 29 | ($clicked, $type) = $mech->eval_in_page('clicked'); 30 | $end = 1; 31 | }; 32 | if (! $end) { 33 | is $end, undef, "We didn't run to the end of the block"; 34 | like $@, qr/clicked is not defined/, "JS is disallowed" or diag $clicked; 35 | SKIP: { 36 | skip "We won't even see the timer", 1 37 | }; 38 | } else { 39 | SKIP: { 40 | skip "Noscript is installed", 2 41 | }; 42 | 43 | # Now, check that the timer does not fire: 44 | sleep 2; 45 | eval { 46 | ($clicked, $type) = $mech->eval_in_page('counter'); 47 | $end = 1; 48 | }; 49 | is $clicked, 0, "Timer didn't fire"; 50 | }; 51 | 52 | $end = undef; 53 | $mech->allow('javascript' => 1); 54 | $mech->get_local('50-click.html'); 55 | eval { 56 | ($clicked, $type) = $mech->eval_in_page('clicked'); 57 | $end = 1; 58 | }; 59 | 60 | # Meh - recent versions of Firefox don't let us at page variables anymore :-( 61 | if( ! $end) { 62 | SKIP: { skip "recent versions of Firefox don't let us at page variables anymore :-(", 3; }; 63 | exit; 64 | }; 65 | 66 | ok $end, "No exception" 67 | or diag $@; 68 | ok $clicked, "We found 'clicked'"; 69 | 70 | sleep 2; 71 | eval { 72 | ($clicked, $type) = $mech->eval_in_page('counter'); 73 | $end = 1; 74 | }; 75 | is $clicked, 1, "Timer did fire"; 76 | -------------------------------------------------------------------------------- /t/50-app-new.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use Firefox::Application; 7 | use lib '.'; 8 | 9 | use t::helper; 10 | if (my $err = t::helper::default_unavailable) { 11 | plan skip_all => "Couldn't connect to MozRepl: $@"; 12 | exit 13 | } else { 14 | plan tests => 8; 15 | }; 16 | 17 | my $ff =Firefox::Application->new( 18 | autodie => 0, 19 | #log => [qw[debug]], 20 | ); 21 | 22 | my $lives; 23 | my @addons; 24 | 25 | diag sprintf "Connected to %s version %s", 26 | $ff->appinfo->{name}, 27 | $ff->appinfo->{version}; 28 | 29 | # This test is broken as we don't pass the expected version around anymore... 30 | if (('') =~ /\b(\d+(\.\d+)+)\b/) { 31 | my $expected_version = $1; 32 | is $ff->appinfo->{version}, $expected_version, "We connect to an instance with version $expected_version"; 33 | } else { 34 | SKIP: { 35 | skip "Don't know what version to expect", 1; 36 | }; 37 | }; 38 | 39 | eval { @addons = $ff->addons; $lives++ }; 40 | ok $lives, "We can query the addons" 41 | or diag $@; 42 | 43 | diag "Found " . scalar @addons . " addons"; 44 | ok @addons >= 1, "You have at least one addon"; # The mozrepl addon, duh 45 | 46 | my ($mozrepl) = grep { $_->{id} eq 'mozrepl@hyperstruct.net' } @addons; 47 | isn't $mozrepl, undef, "We find the mozrepl addon"; 48 | is $mozrepl->{name}, 'MozRepl', 'The name is "MozRepl"'; 49 | diag "Using MozRepl version $mozrepl->{version}"; 50 | 51 | my @locales = $ff->locales; 52 | ok @locales >= 0, "We can ask for ->locales"; 53 | diag $_->{name} for @locales; 54 | 55 | my @themes = $ff->themes; 56 | ok 1, "We can ask for ->themes"; 57 | my ($standard_theme) = grep { $_->{id} eq '{972ce4c6-7e08-4474-a285-3208198ce6fd}' } @themes; 58 | isn't $standard_theme, undef, "We find the Standard theme"; 59 | # is $standard_theme->{name}, 'Standard', 'The name is "Standard"'; 60 | # This test fails, as the name is localized. Duh. 61 | -------------------------------------------------------------------------------- /t/50-app-profile.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use Firefox::Application; 7 | use lib '.'; 8 | use t::helper; 9 | 10 | if (my $err = t::helper::default_unavailable) { 11 | plan skip_all => "Couldn't connect to MozRepl: $@"; 12 | exit 13 | } else { 14 | plan tests => 9; 15 | }; 16 | 17 | my $ff= Firefox::Application->new( 18 | autodie => 0, 19 | #log => [qw[debug]], 20 | ); 21 | 22 | my $lives; 23 | my $profile; 24 | 25 | eval { $profile = $ff->current_profile; $lives++ }; 26 | ok $lives, "We can query the current profile" 27 | or diag $@; 28 | 29 | ok $profile, "You have a valid profile"; # At least 'default' 30 | 31 | my $found_profile = $ff->find_profile($profile->{name}); 32 | ok $found_profile, "We can (re)find the current profile"; 33 | is $found_profile->{name}, $profile->{name}, "And we find the correct name"; 34 | 35 | my $default_profile = $ff->find_profile('default'); # hopefully this always exists 36 | ok $default_profile, "You have a valid 'default' profile"; # At least 'default' 37 | is $default_profile->{name}, 'default'; 38 | 39 | my @profiles = $ff->profiles; 40 | cmp_ok 0+@profiles, '>=', 1, "You have at least one profile"; # see above 41 | 42 | ok( 0+(grep {$_->{name} eq $profile->{name}} @profiles), "We find the current profile"); 43 | ok( 0+(grep {$_->{name} eq $found_profile->{name}} @profiles), "We find the default profile"); 44 | -------------------------------------------------------------------------------- /t/50-click-coordinates-js.html: -------------------------------------------------------------------------------- 1 | 2 | 10 | 13 | -------------------------------------------------------------------------------- /t/50-click-coordinates-js.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use warnings; 4 | use strict; 5 | use Test::More; 6 | 7 | use WWW::Mechanize::Firefox; 8 | 9 | my $mech = eval { WWW::Mechanize::Firefox->new( 10 | autodie => 1, 11 | #log => [qw[debug]], 12 | #on_event => 1, 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 3; 21 | }; 22 | 23 | $mech->get_local("50-click-coordinates-js.html"); 24 | 25 | my $clicky_image = $mech->selector('#maplink', single => 1 ); 26 | my $pos= $clicky_image->getBoundingClientRect(); 27 | isa_ok( $clicky_image, 'MozRepl::RemoteObject::Instance', 'Found the image' ); 28 | 29 | # Check if we can get to stuff in the page at all (FF 40+ is bad there) 30 | my ($val,$type,$ok); 31 | eval { 32 | ($val, $type) = $mech->eval_in_page('cX'); 33 | $ok = 1; 34 | }; 35 | 36 | if( ! $ok) { 37 | SKIP: { 38 | skip "Your version of Firefox doesn't let us see JS variables in a page", 2; 39 | }; 40 | exit; 41 | }; 42 | 43 | my $resp = $mech->click({ dom => $clicky_image, synchronize => 0 }, 10, 12 ); 44 | 45 | my( $type,$co ); 46 | ($co,$type)= $mech->eval_in_page('cX'); 47 | is( $co - $pos->{left}, 10, 'X co-ordinates got transmitted OK' ); 48 | ($co,$type)= $mech->eval_in_page('cY'); 49 | is( $co - $pos->{top}, 12, 'Y co-ordinates got transmitted OK' ); 50 | -------------------------------------------------------------------------------- /t/50-click-coordinates.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use warnings; 4 | use strict; 5 | use Test::More; 6 | 7 | use WWW::Mechanize::Firefox; 8 | use lib './inc', '../inc', '.'; 9 | use Test::HTTP::LocalServer; 10 | 11 | plan skip_all => "ISMAP seems unsupported from Javascript. Need to investigate further."; 12 | 13 | my $mech = eval { WWW::Mechanize::Firefox->new( 14 | autodie => 1, 15 | #log => [qw[debug]], 16 | #on_event => 1, 17 | )}; 18 | 19 | if (! $mech) { 20 | my $err = $@; 21 | plan skip_all => "Couldn't connect to MozRepl: $@"; 22 | exit 23 | } else { 24 | plan tests => 2; 25 | }; 26 | 27 | my $server = Test::HTTP::LocalServer->spawn(); 28 | 29 | $mech->get($server->url); 30 | 31 | SKIP: { 32 | my $clicky_image = $mech->selector('#ismap', single => 1 ); 33 | isa_ok( $clicky_image, 'MozRepl::RemoteObject::Instance', 'Found the image' ); 34 | 35 | my $resp = $mech->click({ dom => $clicky_image }, 10, 12 ); 36 | 37 | like( $mech->uri, qr/\?10,12/, 'Co-ordinates got transmitted OK' ); 38 | 39 | } 40 | 41 | 42 | -------------------------------------------------------------------------------- /t/50-click.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 50-click.html 4 | 5 | 12 | 13 | 14 |
15 | 17 | 18 | 19 | 20 |
21 | A link 22 |
Some div
23 | Open a window (or tab) 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /t/50-follow-link.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 9; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | $mech->autodie(1); 21 | 22 | $mech->get_local('50-click.html'); 23 | $mech->allow('javascript' => 1); 24 | 25 | my ($clicked,$type,$ok); 26 | 27 | eval { 28 | ($clicked, $type) = $mech->eval_in_page('clicked'); 29 | $ok = 1; 30 | }; 31 | 32 | if (! $clicked) { 33 | SKIP: { skip "Couldn't get at 'clicked'. Do you have a Javascript blocker?", 8; }; 34 | exit; 35 | }; 36 | 37 | ok $clicked, "We found 'clicked'"; 38 | 39 | # Xpath 40 | $mech->get_local('50-click.html'); 41 | $mech->allow('javascript' => 1); 42 | $mech->follow_link( xpath => '//*[@id="a_link"]', synchronize=>0, ); 43 | ($clicked,$type) = $mech->eval_in_page('clicked'); 44 | is $clicked, 'a_link', "->follow_link() with an xpath selector works"; 45 | 46 | # CSS 47 | $mech->get_local('50-click.html'); 48 | $mech->allow('javascript' => 1); 49 | $mech->follow_link( selector => '#a_link', synchronize=>0, ); 50 | ($clicked,$type) = $mech->eval_in_page('clicked'); 51 | is $clicked, 'a_link', "->follow_link() with a CSS selector works"; 52 | 53 | # Regex 54 | $mech->get_local('50-click.html'); 55 | $mech->allow('javascript' => 1); 56 | $mech->follow_link( text_regex => qr/A link/, synchronize => 0 ); 57 | ($clicked,$type) = $mech->eval_in_page('clicked'); 58 | is $clicked, 'a_link', "->follow_link() with a RE works"; 59 | 60 | # Non-existing link 61 | $mech->get_local('50-click.html'); 62 | my $lives = eval { $mech->follow_link('foobar'); 1 }; 63 | my $msg = $@; 64 | ok !$lives, "->follow_link() on non-existing parameter fails correctly"; 65 | like $msg, qr/No elements found for Button with name 'foobar'/, 66 | "... with the right error message"; 67 | 68 | # Non-existing link via CSS selector 69 | $mech->get_local('50-click.html'); 70 | $lives = eval { $mech->follow_link({ selector => 'foobar' }); 1 }; 71 | $msg = $@; 72 | ok !$lives, "->follow_link() on non-existing parameter fails correctly"; 73 | like $msg, qr/No elements found for CSS selector 'foobar'/, 74 | "... with the right error message"; -------------------------------------------------------------------------------- /t/50-form-with-fields.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | # file 50-form3.t 4 | use strict; 5 | 6 | 7 | use WWW::Mechanize::Firefox; 8 | use Test::More; 9 | 10 | my $mech = eval { WWW::Mechanize::Firefox->new( 11 | autodie => 0, 12 | #log => [qw[debug]] 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 9; 21 | }; 22 | 23 | $mech->get_local('50-form3.html'); 24 | $mech->form_number(1); 25 | my $the_form_dom_node = $mech->current_form; 26 | my $button = $mech->selector('#btn_ok', single => 1); 27 | isa_ok $button, 'MozRepl::RemoteObject::Instance', "The button image"; 28 | 29 | ok $mech->submit, 'Sent the page'; 30 | 31 | $mech->get_local('50-form3.html'); 32 | @{$mech->{event_log}} = (); 33 | $mech->form_id('snd'); 34 | if(! ok $mech->current_form, "We can find a form by its id") { 35 | for (@{$mech->{event_log}}) { 36 | diag $_ 37 | }; 38 | }; 39 | 40 | $mech->get_local('50-form3.html'); 41 | $mech->form_with_fields('r1[name]'); 42 | ok $mech->current_form, "We can find a form by its contained input fields (single,matched)"; 43 | 44 | $mech->get_local('50-form3.html'); 45 | $mech->form_with_fields('r1[name]','r2[name]'); 46 | ok $mech->current_form, "We can find a form by its contained input fields (double,matched)"; 47 | 48 | $mech->get_local('50-form3.html'); 49 | $mech->form_with_fields('r3name]'); 50 | ok $mech->current_form, "We can find a form by its contained input fields (single,closing)"; 51 | 52 | $mech->get_local('50-form3.html'); 53 | $mech->form_with_fields('r4[name'); 54 | ok $mech->current_form, "We can find a form by its contained input fields (single,opening)"; 55 | 56 | $mech->get_local('50-form3.html'); 57 | $mech->form_name('snd'); 58 | ok $mech->current_form, "We can find a form by its name"; 59 | 60 | # Check that refcounting works and releases the bridge once we release 61 | # our $mech instance 62 | my $destroyed; 63 | my $old_DESTROY = \&MozRepl::RemoteObject::DESTROY; 64 | { no warnings 'redefine'; 65 | *MozRepl::RemoteObject::DESTROY = sub { 66 | $destroyed++; 67 | goto $old_DESTROY; 68 | } 69 | }; 70 | 71 | $MozRepl::RemoteObject::WARN_ON_LEAKS = 1; 72 | undef $the_form_dom_node; 73 | undef $button; 74 | undef $mech; 75 | is $destroyed, 1, "Bridge was torn down"; -------------------------------------------------------------------------------- /t/50-form2.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | untitled 5 | 6 | 7 |
8 | 9 |
10 | 11 |
12 | 13 | 14 | 17 | 21 | 24 | 27 | 28 | 29 | 32 | 35 | 38 | 39 | 42 | 43 | 46 | 50 | 53 | 56 | 57 | 58 | 61 | 64 | 67 | 68 | 71 |
15 | Legno 16 | 18 | 19 | Legno: 20 | 22 | 23 | 25 | (1800) 26 |
30 | Argilla 31 | 33 | Argilla: 34 | 36 | 37 | 40 | (1800) 41 |
44 | Ferro 45 | 47 | 48 | Ferro: 49 | 51 | 52 | 54 | (1800) 55 |
59 | Grano 60 | 62 | Grano: 63 | 65 | 66 | 69 | (1800) 70 |
72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 83 | 84 | 85 | 86 | 87 | 88 | 92 | 93 |
Mercanti 20/20
80 | Villaggio: 81 | 82 |
oppure
89 | X: 90 | Y: 91 |
94 |
95 |

96 |

97 |
98 | 99 |
100 | 101 |
102 | 103 |
104 | 105 | 106 |
107 | 108 |
109 | 110 | 115 |
116 | 117 | 118 | 119 | -------------------------------------------------------------------------------- /t/50-form2.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Test::More; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 13; 17 | }; 18 | 19 | $mech->get_local('50-form2.html'); 20 | is $mech->current_form, undef, "At start, we have no current form"; 21 | $mech->form_number(2); 22 | my $button = $mech->selector('#btn_ok', single => 1); 23 | isa_ok $button, 'MozRepl::RemoteObject::Instance', "The button image"; 24 | ok $mech->submit, 'Sent the page'; 25 | is $mech->current_form, undef, "After a submit, we have no current form"; 26 | 27 | $mech->get_local('50-form2.html'); 28 | $mech->form_id('snd2'); 29 | ok $mech->current_form, "We can find a form by its id"; 30 | is $mech->current_form->{id}, 'snd2', "We can find a form by its id"; 31 | $mech->field('id', 99); 32 | is $mech->xpath('.//*[@name="id"]', 33 | node => $mech->current_form, 34 | single => 1)->{value}, 99, 35 | "We set values in the correct form"; 36 | 37 | $mech->get_local('50-form2.html'); 38 | $mech->form_with_fields('r1','r2'); 39 | ok $mech->current_form, "We can find a form by its contained input fields"; 40 | 41 | $mech->get_local('50-form2.html'); 42 | $mech->form_name('snd'); 43 | ok $mech->current_form, "We can find a form by its name"; 44 | is $mech->current_form->{name}, 'snd', "We can find a form by its name"; 45 | 46 | $mech->get_local('50-form2.html'); 47 | is $mech->current_form, undef, "On a new ->get, we have no current form"; 48 | 49 | $mech->get_local('50-form2.html'); 50 | $mech->form_with_fields('comment'); 51 | ok $mech->current_form, "We can find a form by its contained textarea fields"; 52 | 53 | $mech->get_local('50-form2.html'); 54 | $mech->form_with_fields('quickcomment'); 55 | ok $mech->current_form, "We can find a form by its contained select fields"; 56 | -------------------------------------------------------------------------------- /t/50-form3.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | untitled 5 | 6 | 7 | 8 |
9 | 10 | 11 | 14 | 18 | 21 | 24 | 25 | 26 | 29 | 32 | 35 | 36 | 39 | 40 | 43 | 47 | 50 | 53 | 54 | 55 | 58 | 61 | 64 | 65 | 68 |
12 | Legno 13 | 15 | 16 | Legno: 17 | 19 | 20 | 22 | (1800) 23 |
27 | Argilla 28 | 30 | Argilla: 31 | 33 | 34 | 37 | (1800) 38 |
41 | Ferro 42 | 44 | 45 | Ferro: 46 | 48 | 49 | 51 | (1800) 52 |
56 | Grano 57 | 59 | Grano: 60 | 62 | 63 | 66 | (1800) 67 |
69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 80 | 81 | 82 | 83 | 84 | 85 | 89 | 90 |
Mercanti 20/20
77 | Villaggio: 78 | 79 |
oppure
86 | X: 87 | Y: 88 |
91 |
92 |

93 | 94 |

95 | 96 | 97 | 98 | 99 | -------------------------------------------------------------------------------- /t/50-load-and-load.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use WWW::Mechanize::Firefox; 4 | use Test::More; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 2; 17 | }; 18 | 19 | $mech->get_local('50-form2.html'); 20 | ok 1, "We loaded the page"; 21 | 22 | #sleep 10; 23 | 24 | $mech->get_local('50-form2.html'); 25 | ok 1, "We loaded the page, again, and don't hang"; 26 | 27 | #sleep 100; -------------------------------------------------------------------------------- /t/50-mech-activateTab.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use Firefox::Application; 7 | use WWW::Mechanize::Firefox; 8 | use lib '.'; 9 | 10 | use t::helper; 11 | 12 | if (my $err = t::helper::default_unavailable) { 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 4; 17 | }; 18 | 19 | my $mech= 20 | WWW::Mechanize::Firefox->new( 21 | autodie => 0, 22 | #log => [qw[debug]], 23 | ); 24 | 25 | my $repl = $mech->repl; 26 | 27 | my $magic = sprintf "%s - %s", basename($0), $$; 28 | 29 | # Now check that we can close an arbitrary tab: 30 | $mech->update_html(<$magicTest 32 | HTML 33 | 34 | my $ff = Firefox::Application->new( 35 | repl => $repl, 36 | ); 37 | my @tabs = $ff->openTabs($repl); 38 | 39 | $mech->tab->{title} = $magic; # mark our main tab 40 | 41 | my $tab2 = $ff->addTab(); 42 | my $magic2 = "Another tab ($magic)"; 43 | $tab2->{title} = $magic2; 44 | 45 | $ff->set_tab_content($tab2, <$magic2Secondary tab 47 | HTML 48 | 49 | my $tab = $mech->tab; 50 | 51 | my $old_tab = $ff->selectedTab( repl => $repl ); 52 | 53 | $ff->activateTab( $tab2 ); 54 | my $current = $ff->selectedTab( repl => $repl ); 55 | ok $current, "We got a currently selected tab"; 56 | 57 | is $current->{title}, $magic2, "We selected tab 2"; 58 | 59 | $ff->activateTab( $tab ); 60 | $current = $ff->selectedTab; 61 | ok $current, "We got a currently selected tab"; 62 | is $current->{title}, $magic, "We selected tab 1"; 63 | 64 | # Restore what the user saw: 65 | $ff->activateTab( $old_tab ); 66 | 67 | undef $mech; # and close that tab 68 | -------------------------------------------------------------------------------- /t/50-mech-bufsize.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | bufsize => 10_000_000, 9 | #log => ['debug'], 10 | )}; 11 | 12 | if (! $mech) { 13 | my $err = $@; 14 | plan skip_all => "Couldn't connect to MozRepl: $@"; 15 | exit 16 | } else { 17 | plan tests => 8; 18 | }; 19 | 20 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 21 | my $response; 22 | my $result = eval { 23 | $response = $mech->get('https://cmcc.deviantart.com/', no_cache => 1); # a large website 24 | 1 25 | }; 26 | ok $result, "We lived through the call"; 27 | is $@, '', "... and we got no error"; 28 | ok $mech->success(), "... and we consider the response a success"; 29 | isa_ok $response, 'HTTP::Response', '... and we got a good respone'; 30 | 31 | my $png; 32 | $result = eval { 33 | $png = $mech->content_as_png; 34 | 1; 35 | }; 36 | ok $result, "We lived through the call"; 37 | is $@, '', "... and we got no error"; 38 | like $png, qr/^.PNG/, "... and the result looks like a PNG image"; 39 | 40 | -------------------------------------------------------------------------------- /t/50-mech-closeTab.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use Firefox::Application; 7 | use WWW::Mechanize::Firefox; 8 | 9 | use lib '.'; 10 | use t::helper; 11 | 12 | if (my $err = t::helper::default_unavailable) { 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 4; 17 | }; 18 | 19 | my $mech= 20 | WWW::Mechanize::Firefox->new( 21 | autodie => 0, 22 | #log => [qw[debug]], 23 | ); 24 | my $repl = $mech->repl; 25 | 26 | my $magic = sprintf "%s - %s", basename($0), $$; 27 | 28 | # Now check that we can close an arbitrary tab: 29 | $mech->update_html(<$magicTest 31 | HTML 32 | sleep 1; 33 | 34 | my $ff = Firefox::Application->new( 35 | repl => $repl, 36 | ); 37 | my @tabs = $ff->openTabs($repl); 38 | 39 | $mech->tab->{title} = $magic; # mark our main tab 40 | 41 | my $tab2 = $ff->addTab(); 42 | my $magic2 = "Another tab ($magic)"; 43 | $tab2->{title} = $magic2; 44 | 45 | $ff->set_tab_content($tab2, <$magic2Secondary tab 47 | HTML 48 | sleep 1; 49 | 50 | my @new_tabs = $ff->openTabs($repl); 51 | is 1+@tabs, 0+@new_tabs, "We added a tab"; 52 | if (! is 0+(grep { $_->{title} eq $magic2 } @new_tabs), 1, "We added our tab" ) { 53 | for (@new_tabs) { 54 | diag "<$_->{title}>"; 55 | }; 56 | }; 57 | 58 | $ff->closeTab($tab2); 59 | @new_tabs = $ff->openTabs($repl); 60 | if (! is 0+@tabs, 0+@new_tabs, "We closed a tab") { 61 | for (@new_tabs) { 62 | diag $_->{title}; 63 | }; 64 | }; 65 | if (!is 0+(grep { $_->{title} eq $magic2 } @new_tabs), 0, "We removed our tab"){ 66 | for (@new_tabs) { 67 | diag $_->{title}; 68 | }; 69 | }; 70 | 71 | undef $ff; 72 | diag "App released"; 73 | undef $mech; # and close that tab 74 | diag "Mech released"; 75 | -------------------------------------------------------------------------------- /t/50-mech-content.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 5; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | my $html = $mech->content; 22 | like $html, qr!()?WWW::Mechanize::Firefox!, "We can get the plain HTML"; 23 | 24 | my $html2 = $mech->content( format => 'html' ); 25 | is $html2, $html, "When asking for HTML explicitly, we get the same text"; 26 | 27 | my $text = $mech->content( format => 'text' ); 28 | is $text, 'WWW::Mechanize::Firefox', "We can get the plain text"; 29 | 30 | my $text2; 31 | my $lives = eval { $mech->content( format => 'bogus' ); 1 }; 32 | ok !$lives, "A bogus content format raises an error"; 33 | -------------------------------------------------------------------------------- /t/50-mech-ct.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 2; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | is $mech->ct, 'text/html', "Content-type"; 22 | 23 | -------------------------------------------------------------------------------- /t/50-mech-encoding.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | use lib '.'; 6 | 7 | use t::helper; 8 | 9 | my @tests = ( 10 | [ 'mixi_jp_index.html', 'EUC-JP', qr/\x{30DF}\x{30AF}\x{30B7}\x{30A3}/ ], 11 | [ 'sophos_co_jp_index.html', 'Shift_JIS', qr/\x{30B0}\x{30ED}\x{30FC}\x{30D0}\x{30EB}/ ], 12 | ); 13 | 14 | 15 | if (my $err = t::helper::default_unavailable) { 16 | plan skip_all => "Couldn't connect to MozRepl: $@"; 17 | exit 18 | } else { 19 | plan tests => 2*@tests; 20 | }; 21 | 22 | my $mech= 23 | WWW::Mechanize::Firefox->new( 24 | autodie => 0, 25 | #log => [qw[debug]], 26 | ); 27 | 28 | for (@tests) { 29 | my ($file,$encoding,$content_re) = @$_; 30 | $mech->get_local($file); 31 | is $mech->content_encoding, $encoding, "$file has encoding $encoding"; 32 | diag length $mech->content; 33 | like $mech->content, $content_re, "Partial expression gets found in UTF-8 content"; 34 | }; 35 | -------------------------------------------------------------------------------- /t/50-mech-error.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use WWW::Mechanize::Firefox; 7 | 8 | my $mech = eval { WWW::Mechanize::Firefox->new( 9 | autodie => 0, 10 | #log => [qw[debug]] 11 | )}; 12 | 13 | if (! $mech) { 14 | my $err = $@; 15 | plan skip_all => "Couldn't connect to MozRepl: $@"; 16 | exit 17 | } else { 18 | plan tests => 2; 19 | }; 20 | 21 | #line 2 "foo" 22 | is eval { $mech->eval_in_page('bar'); 1 }, undef, "Invalid JS gives an error"; 23 | my $err = $@; 24 | like $err, qr/\bat foo line 2\b/, "the correct location gets flagged as error"; 25 | 26 | undef $mech; # and close that tab 27 | -------------------------------------------------------------------------------- /t/50-mech-event.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | )}; 9 | 10 | if (! $mech) { 11 | my $err = $@; 12 | plan skip_all => "Couldn't connect to MozRepl: $@"; 13 | exit 14 | } else { 15 | plan tests => 21; 16 | }; 17 | 18 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 19 | 20 | my $browser = $mech->tab->{linkedBrowser}; 21 | my $name = 'click'; 22 | my $listener = $mech->_addEventListener($browser,$name); 23 | 24 | my $rn = $mech->repl->name; 25 | my $browser_id = $browser->__id; 26 | 27 | # Now fire the event 28 | my $event = $mech->repl->expr(<{busy}, 1, 'Event was fired'; 36 | is $listener->{event}, $name, '... and it was our event'; 37 | 38 | sub is_object($$$) { 39 | my ($l,$r,$name) = @_; 40 | my $is_id = $mech->repl->declare(<<'JS'); 41 | function (l,r) { 42 | return l === r 43 | }; 44 | JS 45 | ok $is_id->($l,$r), $name 46 | or diag "Got $l->{tagName}, expected $r->{tagName}"; 47 | }; 48 | 49 | # Now check that we can create a lock/listener 50 | # that listens on several objects for more than one event 51 | # and check that it triggers for every object/event combination 52 | my @events = (qw(load DOMContentLoaded error)); 53 | my $tab = $mech->tab; 54 | my $tab_id = $tab->__id; 55 | 56 | for my $name (@events) { 57 | $listener = $mech->_addEventListener([$browser,\@events], [$tab, \@events]); 58 | 59 | # Now fire the event 60 | my $event = $mech->repl->expr(<{busy}, 1, 'Event was fired'; 68 | is $listener->{event}, $name, "... and it was $name"; 69 | is_object $listener->{js_event}->{target}, $browser, "... on the browser"; 70 | 71 | $listener = $mech->_addEventListener([$browser,\@events], [$tab, \@events]); 72 | $event = $mech->repl->expr(<{busy}, 1, 'Event was fired'; 80 | is $listener->{event}, $name, "... and it was $name"; 81 | is_object $listener->{js_event}->{target}, $tab, "... on the tab"; 82 | }; 83 | 84 | $MozRepl::RemoteObject::WARN_ON_LEAKS++; 85 | undef $mech; -------------------------------------------------------------------------------- /t/50-mech-forms.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 14; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | $mech->get_local('50-click.html'); 22 | 23 | my $f = $mech->forms; 24 | is ref $f, 'ARRAY', "We got an arrayref of forms"; 25 | 26 | is 0+@$f, 1, "We found one form"; 27 | 28 | is $f->[0]->{id}, 'foo', "We found the one form"; 29 | 30 | my @f = $mech->forms; 31 | 32 | is 0+@f, 1, "We found one form"; 33 | 34 | is $f[0]->{id}, 'foo', "We found the one form"; 35 | 36 | $mech->get_local('50-form2.html'); 37 | 38 | $f = $mech->forms; 39 | is ref $f, 'ARRAY', "We got an arrayref of forms"; 40 | 41 | is 0+@$f, 5, "We found five forms"; 42 | 43 | is $f->[0]->{id}, 'snd0', "We found the first form"; 44 | is $f->[1]->{id}, 'snd', "We found the second form"; 45 | is $f->[2]->{id}, 'snd2', "We found the third form"; 46 | is $f->[3]->{id}, 'snd3', "We found the fourth form"; 47 | is $f->[4]->{id}, 'snd4', "We found the fifth form"; 48 | 49 | $mech->get_local('51-empty-page.html'); 50 | @f = $mech->forms; 51 | 52 | is_deeply \@f, [], "We found no forms"; 53 | 54 | undef $mech; -------------------------------------------------------------------------------- /t/50-mech-get-nocache.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | use lib './inc', '../inc', '.'; 6 | use Test::HTTP::LocalServer; 7 | 8 | my $mech = eval { WWW::Mechanize::Firefox->new( 9 | autodie => 0, 10 | #log => [qw[debug]], 11 | #on_event => 1, 12 | )}; 13 | 14 | if (! $mech) { 15 | my $err = $@; 16 | plan skip_all => "Couldn't connect to MozRepl: $@"; 17 | exit 18 | } else { 19 | plan tests => 6; 20 | }; 21 | 22 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 23 | 24 | my $server = Test::HTTP::LocalServer->spawn( 25 | #debug => 1 26 | ); 27 | 28 | my ($site,$estatus) = ($server->url,200); 29 | my $res = $mech->get($site, no_cache => 1); 30 | isa_ok $res, 'HTTP::Response', "Response"; 31 | 32 | is $mech->uri, $site, "Navigated to $site"; 33 | 34 | is $res->code, $estatus, "GETting $site returns HTTP code $estatus from response" 35 | or diag $mech->content; 36 | 37 | is $mech->status, $estatus, "GETting $site returns HTTP status $estatus from mech" 38 | or diag $mech->content; 39 | 40 | ok $mech->success, 'We consider this response successful'; -------------------------------------------------------------------------------- /t/50-mech-get.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | use lib './inc', '../inc', '.'; 6 | use Test::HTTP::LocalServer; 7 | 8 | use t::helper; 9 | 10 | if (my $err = t::helper::default_unavailable) { 11 | plan skip_all => "Couldn't connect to MozRepl: $@"; 12 | exit 13 | } else { 14 | plan tests => 6; 15 | }; 16 | 17 | my $mech= 18 | WWW::Mechanize::Firefox->new( 19 | autodie => 0, 20 | #log => [qw[debug]], 21 | ); 22 | 23 | my $server = Test::HTTP::LocalServer->spawn( 24 | #debug => 1 25 | ); 26 | 27 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 28 | 29 | my ($site,$estatus) = ($server->url,200); 30 | my $res = $mech->get($site); 31 | isa_ok $res, 'HTTP::Response', "Response"; 32 | 33 | is $mech->uri, $site, "Navigated to $site"; 34 | 35 | is $res->code, $estatus, "GETting $site returns HTTP code $estatus from response" 36 | or diag $mech->content; 37 | 38 | is $mech->status, $estatus, "GETting $site returns HTTP status $estatus from mech" 39 | or diag $mech->content; 40 | 41 | ok $mech->success, 'We consider this response successful'; 42 | -------------------------------------------------------------------------------- /t/50-mech-multi-event.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 5; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | my $browser = $mech->tab->{linkedBrowser}; 22 | my $name = 'myOwn'; 23 | my $listener = $mech->_addEventListener($browser,['click',$name]); 24 | 25 | my $rn = $mech->repl->name; 26 | my $browser_id = $browser->__id; 27 | 28 | # Now fire the event 29 | $mech->repl->expr(<{busy}, 1, 'Event was fired'; 36 | is $listener->{event}, $name, '... and it was our event'; 37 | 38 | $mech->repl->expr(<{busy}, 1, 'Only one event was received'; 47 | is $listener->{event}, $name, '... and the event name is the first event'; 48 | -------------------------------------------------------------------------------- /t/50-mech-new-dsl.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | #use WWW::Mechanize::Firefox::DSL; 7 | BEGIN { 8 | my $err; 9 | require WWW::Mechanize::Firefox::DSL; 10 | my $ok = eval { 11 | WWW::Mechanize::Firefox::DSL->import( 12 | autodie => 0, 13 | #log => [qw[debug]] 14 | ); 15 | 1 16 | }; 17 | $err ||= $@; 18 | 19 | if (!$ok || $err) { 20 | plan skip_all => "Couldn't connect to MozRepl: $@"; 21 | exit 22 | } else { 23 | plan tests => 2; 24 | }; 25 | }; 26 | 27 | 28 | get_local '49-mech-get-file.html'; 29 | is title, '49-mech-get-file.html', 'We opened the right page'; 30 | is ct, 'text/html', "Content-Type is text/html"; 31 | diag uri; 32 | 33 | undef $mech; -------------------------------------------------------------------------------- /t/50-mech-new-with-tab.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use WWW::Mechanize::Firefox; 7 | 8 | my $mech = eval { WWW::Mechanize::Firefox->new( 9 | autodie => 0, 10 | #autoclose => 0, 11 | #log => [qw[debug]] 12 | )}; 13 | 14 | if (! $mech) { 15 | my $err = $@; 16 | plan skip_all => "Couldn't connect to MozRepl: $@"; 17 | exit 18 | } else { 19 | plan tests => 3; 20 | }; 21 | # Mark this tab 22 | my $magic = sprintf "%s - %s", basename($0), $$; 23 | $mech->update_html(<$magicTest 25 | HTML 26 | 27 | my $repl = $mech->repl; 28 | my $app = $mech->application; 29 | my @tabs = map { $_->{tab} } 30 | grep { $magic eq $_->{title} } 31 | $app->openTabs($repl); 32 | 33 | is 0+@tabs, 1, 'We find our tab'; 34 | 35 | my $synth_mech = WWW::Mechanize::Firefox->new( 36 | tab => $tabs[0], 37 | app => $app, 38 | ); 39 | is $synth_mech->content, $mech->content, 'Both instances use the same tab'; 40 | 41 | $synth_mech->update_html(<$magic$magic 43 | HTML 44 | 45 | is $synth_mech->content, $mech->content, 'Both instances use the same tab'; 46 | 47 | @tabs = (); 48 | undef $mech; 49 | undef $synth_mech; -------------------------------------------------------------------------------- /t/50-mech-new.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use File::Basename; 5 | 6 | use WWW::Mechanize::Firefox; 7 | 8 | my $mech = eval { WWW::Mechanize::Firefox->new( 9 | autodie => 0, 10 | #log => [qw[debug]] 11 | )}; 12 | 13 | if (! $mech) { 14 | my $err = $@; 15 | plan skip_all => "Couldn't connect to MozRepl: $@"; 16 | exit 17 | } else { 18 | plan tests => 5; 19 | }; 20 | 21 | my $repl = $mech->repl; 22 | my $app = $mech->application; 23 | 24 | my @tabs = $app->openTabs($repl); 25 | 26 | sleep 1; 27 | 28 | undef $mech; # our own tab should now close automatically 29 | 30 | my @new_tabs = $app->openTabs($repl); 31 | 32 | if (! is scalar @new_tabs, @tabs-1, "Our tab was presumably closed") { 33 | for (@new_tabs) { 34 | diag $_->{title}; 35 | }; 36 | }; 37 | 38 | my $magic = sprintf "%s - %s", basename($0), $$; 39 | #diag "Tab title is $magic"; 40 | # Now check that we don't open a new tab if we try to find an existing tab: 41 | $mech = WWW::Mechanize::Firefox->new( 42 | autodie => 0, 43 | autoclose => 0, 44 | ); 45 | $mech->update_html(<$magicTest 47 | HTML 48 | 49 | undef $mech; 50 | 51 | # Now check that we don't open a new tab if we try to find an existing tab: 52 | $mech = WWW::Mechanize::Firefox->new( 53 | autodie => 0, 54 | autoclose => 0, 55 | tab => qr/^\Q$magic/, 56 | ); 57 | my $c = $mech->content; 58 | like $mech->content, qr/\Q$magic/, "We selected the existing tab" 59 | or do { diag $_->{title} for $mech->application->openTabs() }; 60 | 61 | # Now activate the tab and connect to the "current" tab 62 | # This is ugly for a user currently using Firefox, but hey, they 63 | # should be watching in amazement instead of surfing while we test 64 | $app->activateTab($mech->tab); 65 | $mech = WWW::Mechanize::Firefox->new( 66 | autodie => 0, 67 | autoclose => 0, 68 | tab => 'current', 69 | ); 70 | $c = $mech->content; 71 | like $mech->content, qr/\Q$magic/, "We connected to the current tab" 72 | or do { diag $_->{title} for $mech->application->openTabs() }; 73 | $mech->autoclose_tab($mech->tab); 74 | 75 | undef $mech; # and close that tab 76 | 77 | # Now try to connect to "our" now closed tab 78 | my $lived = eval { 79 | $mech = WWW::Mechanize::Firefox->new( 80 | autodie => 1, 81 | tab => qr/\Q$magic/, 82 | ); 83 | 1; 84 | }; 85 | my $err = $@; 86 | is $lived, undef, 'We died trying to connect to a non-existing tab'; 87 | # Something within the eval {} block above kills $@. Likely, some destructor 88 | # somewhere, maybe in MozRepl::RemoteObject. 89 | like $err, q{/Couldn't find a tab matching/}, 'We got the correct error message'; 90 | -------------------------------------------------------------------------------- /t/50-mech-post.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | use lib 'inc', '../inc'; 6 | use Test::HTTP::LocalServer; 7 | 8 | use t::helper; 9 | 10 | if (my $err = t::helper::default_unavailable) { 11 | plan skip_all => "Couldn't connect to MozRepl: $@"; 12 | exit 13 | } else { 14 | plan tests => 8; 15 | }; 16 | 17 | my $mech= 18 | WWW::Mechanize::Firefox->new( 19 | autodie => 0, 20 | #log => [qw[debug]], 21 | ); 22 | 23 | my $server = Test::HTTP::LocalServer->spawn( 24 | #debug => 1 25 | ); 26 | 27 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 28 | 29 | my ($site,$estatus) = ($server->url,200); 30 | my $res = $mech->post($site, params => { query => 'queryValue1', query2 => 'queryValue2' }); 31 | isa_ok $res, 'HTTP::Response', "Response"; 32 | 33 | is $mech->uri, $site, "Navigated to $site"; 34 | 35 | is $res->code, $estatus, "POSTting $site returns HTTP code $estatus from response" 36 | or diag $mech->content; 37 | 38 | is $mech->status, $estatus, "POSTting $site returns HTTP status $estatus from mech" 39 | or diag $mech->content; 40 | 41 | ok $mech->success, 'We consider this response successful'; 42 | 43 | like $mech->content, qr/queryValue1/, "We find our parameter 'query'"; 44 | like $mech->content, qr/queryValue2/, "We find our parameter 'query2'"; -------------------------------------------------------------------------------- /t/50-mech-save-dialog.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan skip_all => 'Not yet implemented'; 17 | exit 0; 18 | 19 | plan tests => 1; 20 | }; 21 | 22 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 23 | 24 | # This is if we implement our own "overlay" for the SaveAs dialog 25 | # // Now, "close" the dialog 26 | # document.documentElement.removeAttribute('ondialogaccept'); 27 | # document.documentElement.cancelDialog(); 28 | 29 | 30 | $mech->repl->expr(<<'JS'); 31 | var observer = { 32 | observe: function(subject,topic,data){ 33 | if (topic != "http-on-examine-response") { 34 | return 35 | }; 36 | 37 | var httpChannel = 38 | subject.QueryInterface(Components.interfaces.nsIHttpChannel); 39 | var contentType = httpChannel.getResponseHeader("Content-Type"); 40 | 41 | var channel = subject.QueryInterface(Components.interfaces.nsIChannel); 42 | var url = channel.URI.spec; 43 | url = url.toString(); 44 | 45 | // alert(topic + " | " + url); 46 | 47 | if ( contentType.indexOf("html") == -1 ){ 48 | 49 | channel.cancel(); 50 | alert("Wait a moment!\n"+ url ); 51 | } 52 | 53 | } 54 | }; 55 | 56 | var observerService = 57 | Components.classes["@mozilla.org/observer-service;1"] 58 | .getService(Components.interfaces.nsIObserverService); 59 | observerService.addObserver(observer,"http-on-examine-response",false); 60 | 61 | JS 62 | 63 | 64 | my ($site,$estatus) = ('http://www.firefox-start.com/download/Firefox%20Setup%203.0.3.exe',200); 65 | my $res = $mech->get($site); 66 | sleep 10; 67 | 68 | #$mech->repl->expr(<<'JS'); 69 | # unregisterMockFilePickerFactory(); 70 | #//window.getTargetFile = this.oldGetTargetFile; 71 | #JS 72 | -------------------------------------------------------------------------------- /t/50-mech-set-fields-875912.htm: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Antibody epitope prediction 5 | 6 | 7 | 10 | 21 |
22 |
23 | 24 | 25 |

Antibody Epitope Prediction

26 |
27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 46 | 47 | 48 | 51 | 52 | 53 | 56 | 57 | 58 | 61 | 62 | 63 | 66 | 67 | 68 | 70 | 71 | 72 | 76 | 77 |
Enter a Swiss-Prot Id:
(example: P02185)
Or enter a protein sequence in plain format (50000 residues maximum):
Choose a method:
73 | 74 | 75 |
78 |
79 | 80 |
81 |
82 | 83 | 84 | -------------------------------------------------------------------------------- /t/50-mech-set-fields-875912.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | use WWW::Mechanize::Firefox; 4 | 5 | my $mech = eval { WWW::Mechanize::Firefox->new( 6 | autodie => 0, 7 | #log => [qw[debug]] 8 | )}; 9 | 10 | if (! $mech) { 11 | my $err = $@; 12 | plan skip_all => "Couldn't connect to MozRepl: $@"; 13 | exit 14 | } else { 15 | plan tests => 4; 16 | }; 17 | 18 | my $method = 49; 19 | my $seq = "ARRRSFASDATRASDFSDARASDAGADFGASDRFREWFASCDSAGAREW"; 20 | 21 | $mech->get_local("50-mech-set-fields-875912.htm"); 22 | 23 | $mech->form_name('form1'); 24 | $mech->set_fields( 'sequence' => $seq ); 25 | is $mech->value('sequence'), $seq, "->set_fields sets a single value"; 26 | 27 | $mech->field( 'sequence' => "xx$seq" ); 28 | is $mech->value('sequence'), "xx$seq", "->field also sets a single value"; 29 | 30 | 31 | $mech->set_fields( 'sequence' => "1-$seq", sequence2 => "2-$seq" ); 32 | is $mech->value('sequence'), "1-$seq", "->set_fields sets two values"; 33 | is $mech->value('sequence2'), "2-$seq", "->set_fields sets two values"; 34 | -------------------------------------------------------------------------------- /t/50-mech-status.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]] 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 6; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | 21 | my ($site,$estatus) = ('http://'.rand(1000).'.www.doesnotexist.example/',500); 22 | my $res = $mech->get($site); 23 | 24 | is $mech->uri, $site, "Navigating to (nonexisting) $site"; 25 | 26 | if( ! isa_ok $res, 'HTTP::Response', 'The response') { 27 | SKIP: { skip "No response returned", 1 }; 28 | } else { 29 | my $c = $res->code; 30 | like $res->code, qr/^(404|5\d\d)$/, "GETting $site gives a 5xx (no proxy) or 404 (proxy)" 31 | or diag $mech->content; 32 | 33 | like $mech->status, qr/^(404|5\d\d)$/, "GETting $site returns a 5xx (no proxy) or 404 (proxy) HTTP status" 34 | or diag $mech->content; 35 | }; 36 | 37 | ok !$mech->success, 'We consider this response not successful'; -------------------------------------------------------------------------------- /t/50-popup.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | plan skip_all => "Opening windows are not yet tracked"; 7 | exit; 8 | 9 | my $mech = eval { WWW::Mechanize::Firefox->new( 10 | autodie => 0, 11 | #events => [ 'DOMWindowOpened', 'DOMContentLoaded', 'load'], # domwindowclosed 12 | # then add a window.onload handler to check whether it's a new browser 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 16; 21 | }; 22 | 23 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 24 | $mech->autodie(1); 25 | 26 | $mech->get_local('50-click.html'); 27 | $mech->allow('javascript' => 1); 28 | 29 | my ($win,$type,$ok); 30 | 31 | eval { 32 | ($win, $type) = $mech->eval_in_page('open_window'); 33 | $ok = 1; 34 | }; 35 | 36 | if (! $win) { 37 | SKIP: { skip "Couldn't get at 'open_window'. Do you have a Javascript blocker?", 15; }; 38 | exit; 39 | }; 40 | 41 | ok $win, "We found 'open_window'"; 42 | $mech->click($win, synchronize => 0); 43 | ok 1, "We get here"; 44 | diag "But we don't know what window was opened"; 45 | # or how to close it 46 | -------------------------------------------------------------------------------- /t/50-rt65615.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | $ENV{ MOZREPL_CLASS } = 'MozRepl'; # we want the Net::Telnet-based implementation 7 | 8 | my $mech = eval { WWW::Mechanize::Firefox->new( 9 | autodie => 0, 10 | bufsize => 1025, # a too small size, but still larger than the Net::Telnet default 11 | #log => ['debug'], 12 | )}; 13 | 14 | if (! $mech) { 15 | my $err = $@; 16 | plan skip_all => "Couldn't connect to MozRepl: $@"; 17 | exit 18 | } else { 19 | plan tests => 3; 20 | }; 21 | diag "Using ", ref $mech->repl->repl; 22 | 23 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 24 | my $response; 25 | my $result = eval { 26 | $response = $mech->get_local('rt65615.html', no_cache => 1); # a large website 27 | $mech->content; 28 | 1 29 | }; 30 | ok !$result, "We died on the call"; 31 | like $@, qr/\b1025\b/, "... and we got the correct bufsize error"; 32 | 33 | # Now go in and clean up the tab the previous instance left orphaned 34 | $mech = WWW::Mechanize::Firefox->new( 35 | attach => 1, 36 | tab => qr/^rt65615.html$/, 37 | autoclose => 1, 38 | ); 39 | undef $mech; 40 | 41 | -------------------------------------------------------------------------------- /t/50-tick.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 50-click.html 5 | 6 | 7 |
8 | 10 | Checked 1 :
11 | Checked (no value):
12 | Checked 3 :
13 | Unchecked 1:
14 | Unchecked (no value):
15 | Unchecked 3:
16 |
17 | 18 | -------------------------------------------------------------------------------- /t/50-tick.t: -------------------------------------------------------------------------------- 1 | #!perl -w 2 | use strict; 3 | use Test::More; 4 | use WWW::Mechanize::Firefox; 5 | 6 | my $mech = eval { WWW::Mechanize::Firefox->new( 7 | autodie => 0, 8 | #log => [qw[debug]], 9 | )}; 10 | 11 | if (! $mech) { 12 | my $err = $@; 13 | plan skip_all => "Couldn't connect to MozRepl: $@"; 14 | exit 15 | } else { 16 | plan tests => 19; 17 | }; 18 | 19 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 20 | $mech->autodie(1); 21 | 22 | $mech->get_local('50-tick.html'); 23 | 24 | my ($clicked,$type,$ok); 25 | 26 | sub to_string($) { 27 | $_[0] eq 'true' ? 1 28 | : $_[0] eq 'false' ? 0 29 | : $_[0] eq '0' ? 0 30 | : $_[0] eq '1' ? 1 31 | : "unknown truth value $_[0]" 32 | ; 33 | }; 34 | 35 | # Xpath 36 | $mech->get_local('50-tick.html'); 37 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked"; 38 | $mech->tick('#unchecked_1'); 39 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},1, "#unchecked_1 is now checked"; 40 | 41 | $mech->get_local('50-tick.html'); 42 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked"; 43 | $mech->tick('unchecked',3); 44 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked" 45 | or diag $mech->selector('#unchecked_1',single => 1)->{checked}; 46 | is to_string $mech->selector('#unchecked_3',single => 1)->{checked},1, "#unchecked_3 is now checked" 47 | or diag $mech->selector('#unchecked_3',single => 1)->{checked}; 48 | 49 | $mech->get_local('50-tick.html'); 50 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked"; 51 | $mech->tick('unchecked',1); 52 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},1, "#unchecked_1 is now checked"; 53 | is to_string $mech->selector('#unchecked_3',single => 1)->{checked},0, "#unchecked_3 is not checked"; 54 | 55 | # Now check not setting things 56 | $mech->get_local('50-tick.html'); 57 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked"; 58 | $mech->tick('unchecked',1,0); 59 | is to_string $mech->selector('#unchecked_1',single => 1)->{checked},0, "#unchecked_1 is not checked"; 60 | is to_string $mech->selector('#unchecked_3',single => 1)->{checked},0, "#unchecked_3 is not checked"; 61 | 62 | # Now check removing checkmarks 63 | $mech->get_local('50-tick.html'); 64 | is to_string $mech->selector('#prechecked_1',single => 1)->{checked},1, "#prechecked_1 is checked"; 65 | $mech->tick('prechecked',1,0); 66 | is to_string $mech->selector('#prechecked_1',single => 1)->{checked},0, "#prechecked_1 is not checked"; 67 | is to_string $mech->selector('#prechecked_3',single => 1)->{checked},1, "#prechecked_3 is still checked"; 68 | 69 | # Now check removing checkmarks 70 | $mech->get_local('50-tick.html'); 71 | is to_string $mech->selector('#prechecked_1',single => 1)->{checked},1, "#prechecked_1 is checked"; 72 | is to_string $mech->selector('#prechecked_3',single => 1)->{checked},1, "#prechecked_3 is checked"; 73 | $mech->untick('prechecked',3); 74 | is to_string $mech->selector('#prechecked_1',single => 1)->{checked},1, "#prechecked_1 is still checked"; 75 | is to_string $mech->selector('#prechecked_3',single => 1)->{checked},0, "#prechecked_3 is not checked"; 76 | -------------------------------------------------------------------------------- /t/51-click_js.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 51-empty-page.html 6 | 13 | 14 |
15 | Clicky1 16 |
17 | 18 |
19 | Clicky2 20 |
21 | 22 | 23 | -------------------------------------------------------------------------------- /t/51-click_js.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use warnings; 3 | use strict; 4 | use Test::More; 5 | 6 | use WWW::Mechanize::Firefox; 7 | use lib './inc', '../inc', '.'; 8 | 9 | my $mech = eval { WWW::Mechanize::Firefox->new( 10 | autodie => 1, 11 | #log => [qw[debug]], 12 | #on_event => 1, 13 | )}; 14 | 15 | if (! $mech) { 16 | my $err = $@; 17 | plan skip_all => "Couldn't connect to MozRepl: $@"; 18 | exit 19 | } else { 20 | plan tests => 4; 21 | }; 22 | 23 | isa_ok $mech, 'WWW::Mechanize::Firefox'; 24 | 25 | $mech->get_local('51-click_js.html'); 26 | 27 | my ($triggered,$type,$ok); 28 | eval { 29 | ($triggered, $type) = $mech->eval_in_page('lastclick'); 30 | $ok = 1; 31 | }; 32 | if (! $triggered) { 33 | SKIP: { skip "Couldn't get at 'lastclick'. Do you have a Javascript blocker?", 3; }; 34 | exit; 35 | }; 36 | ok $triggered, "We have JS enabled"; 37 | CLICK_BUBBLE: { 38 | $mech->click({selector => '#a1', synchronize => 0}); 39 | ($triggered, $type) = $mech->eval_in_page('lastclick'); 40 | is_deeply [@$triggered], ['mydiv1'], 'Click events bubble'; 41 | } 42 | 43 | @$triggered = (); 44 | 45 | CLICK: { 46 | $mech->click({selector => '#a2', synchronize => 0}); 47 | ($triggered, $type) = $mech->eval_in_page('lastclick'); 48 | is_deeply [@$triggered], ['a2','mydiv2'], "Click events bubble beyond first handler"; 49 | } 50 | @$triggered = (); 51 | -------------------------------------------------------------------------------- /t/51-empty-page.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 51-empty-page.html 4 | 5 | 6 |

A plain, very, very, simple, page

7 | 8 | -------------------------------------------------------------------------------- /t/51-form-number-blakew.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |