WWW-Mechanize-2.20000755001750001750 015076225326 13057 5ustar00olafolaf000000000000LICENSE100644001750001750 4627615076225326 14204 0ustar00olafolaf000000000000WWW-Mechanize-2.20This software is copyright (c) 2004 by Andy Lester. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2004 by Andy Lester. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, see . Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Moe Ghoul, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2004 by Andy Lester. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End INSTALL100644001750001750 456215076225326 14200 0ustar00olafolaf000000000000WWW-Mechanize-2.20This is the Perl distribution WWW-Mechanize. Installing WWW-Mechanize is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm WWW::Mechanize If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan WWW::Mechanize ## Manual installation As a last resort, you can manually install it. If you have not already downloaded the release tarball, you can find the download link on the module's MetaCPAN page: https://metacpan.org/pod/WWW::Mechanize Untar the tarball, install configure prerequisites (see below), then build it: % perl Makefile.PL % make && make test Then install it: % make install On Windows platforms, you should use `dmake` or `nmake`, instead of `make`. If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib The prerequisites of this distribution will also have to be installed manually. The prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated by running the manual build process described above. ## Configure Prerequisites This distribution requires other modules to be installed before this distribution's installer can be run. They can be found under the "configure_requires" key of META.yml or the "{prereqs}{configure}{requires}" key of META.json. ## Other Prerequisites This distribution may require additional modules to be installed after running Makefile.PL. Look for prerequisites in the following phases: * to run make, PHASE = build * to use the module code itself, PHASE = runtime * to run tests, PHASE = test They can all be found in the "PHASE_requires" key of MYMETA.yml or the "{prereqs}{PHASE}{requires}" key of MYMETA.json. ## Documentation WWW-Mechanize documentation is available as POD. You can run `perldoc` from a shell to read the documentation: % perldoc WWW::Mechanize For more information on installing Perl modules via CPAN, please see: https://www.cpan.org/modules/INSTALL.html Changes100644001750001750 17547215076225326 14513 0ustar00olafolaf000000000000WWW-Mechanize-2.20Revision history for WWW::Mechanize 2.20 2025-10-22 19:04:44Z [ENHANCEMENTS] - WWW::Mechanize no longer taints the responses it receives. This also removes Test::Taint as a prerequisite. (GH#383) (Andy Lester) - select() now accepts a number argument to specify which instance of an element with multiple occurrences to use (GH#189) (Julien Fiegehenn) - Add Bash completion (GH#396) (Mikko Koivunalho) [DOCUMENTATION] - Improve FAQ (GH#76) (Julien Fiegehenn) - Add installation instructions and badge for Repology (GH#399) (Mikko Koivunalho) - Add License, CPAN and kwalitee badges to README (GH#400) (Mikko Koivunalho) [FIXED] - Fix test failure after release of HTTP::Message 7.01 (GH#403) (Olaf Alders) 2.19 2024-09-16 15:25:45Z [DOCUMENTATION] - Fix minor typo in SYNOPSIS example code comment (GH#379) (Paul Cochrane) [ENHANCEMENTS] - Replace "base" with "parent" (GH#381) (James Raspass) 2.18 2024-01-30 14:29:44Z [FIXED] - Fix click_button non exclusive attributes (GH#371) (Andreas Huber) [TESTS] - Remove t/untaint.t (GH#377) (Olaf Alders) 2.17 2023-04-27 15:45:01Z [ENHANCEMENTS] - Perltidied the entire dist, and enabled tests for it (Julien Fiegehenn) 2.16 2023-02-11 12:09:16Z [FIXED] - Raise minimum Perl to 5.8 to match what we test, what dependencies depend on, etc. (GH#352) (James Raspass) [ENHANCEMENTS] - New method delete() that allows DELETE requests with Mechanize::Link objects (GH#361) (Stuart A Johnston) [DOCUMENTATION] - Clarify documentation for select() (GH#77) (Julien Fiegehenn) - Various POD fixes (Julien Fiegehenn) - Explain that :content-file does not decode content (GH#363) (bscan) [TESTS] - Test that follow_link(n=> 'all') warns (Kueppo Tcheukam) - Drop Test::Warn prerequisite and only use Test::Warnings (GH#360) (Graham Knop) 2.15 2022-08-21 07:47:35Z [FIXED] - There was a test suite failure on some Windows machines introduced in 2.14 that is now fixed. (GH#350) (Julien Fiegehenn) [ENHANCEMENTS] - form_with and all_forms_with() now support the "action" attribute to find forms (GH#349) (Julien Fiegehenn) 2.14 2022-08-15 19:19:24Z [FIXED] - File upload fields now correctly handle overwriting the file name and passing in content without a real file (GH#249) (Gil Magno and Julien Fiegehenn) - HTML::Form bumped to 6.08 (GH#347) (Julien Fiegehenn) [ENHANCEMENTS] - Add autocheck() to enable or disable autochecking at run time in addition to setting it at object creation (GH#232) (Julien Fiegehenn) - mech_dump now errors appropriately when it cannot open a URL or file instead of claiming it has the wrong MIME type (GH#292) (Julien Fiegehenn) 2.13 2022-07-29 09:44:46Z [ENHANCEMENTS] - mech_dump now treats all local files like HTML regardless of what it thinks their content types are (GH#63) (Julien Fiegehenn) - We now consistently use our own die() method and therefore the onerror handler wherever possible (GH#80) (Julien Fiegehenn) [TESTS] - Add tests for field() when working on a warnings.t100644001750001750 54515076225326 15404 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More; use Test::Warnings qw( :all ); use WWW::Mechanize (); UNKNOWN_ALIAS: { my $m = WWW::Mechanize->new; isa_ok( $m, 'WWW::Mechanize' ); like warning { $m->agent_alias('Blongo'); }, qr/\AUnknown agent alias "Blongo"/, 'Unknown aliases squawk appropriately'; } done_testing(); precious.toml100644001750001750 311715076225326 15670 0ustar00olafolaf000000000000WWW-Mechanize-2.20exclude = [ ".build/**", "blib/**", ] [commands.perlimports] type = "both" include = ["**/*.{pl,pm,t,psgi}"] cmd = ["perlimports"] lint-flags = ["--lint"] tidy-flags = ["-i"] ok-exit-codes = 0 expect-stderr = true # [commands.perlcritic] # type = "lint" # include = ["**/*.{pl,pm,t,psgi}"] # cmd = ["perlcritic", "--profile=$PRECIOUS_ROOT/perlcriticrc"] # ok-exit-codes = 0 # lint-failure-exit-codes = 2 [commands.perlvars] type = "lint" include = ["**/*.{pl,pm,psgi}"] cmd = ["perlvars"] ok-exit-codes = 0 [commands.perltidy] type = "both" include = ["**/*.{pl,pm,t,psgi}"] cmd = ["perltidy", "--profile=$PRECIOUS_ROOT/perltidyrc"] lint-flags = ["--assert-tidy", "--no-standard-output", "--outfile=/dev/null"] tidy-flags = ["--backup-and-modify-in-place", "--backup-file-extension=/"] ok-exit-codes = 0 lint-failure-exit-codes = 2 ignore-stderr = "Begin Error Output Stream" # [commands.podchecker] # type = "lint" # include = ["**/*.{pl,pm,pod}"] # cmd = ["podchecker", "--warnings", "--warnings"] # ok-exit-codes = [0, 2] # lint-failure-exit-codes = 1 # ignore-stderr = [".+ pod syntax OK", ".+ does not contain any pod commands"] [commands.podtidy] type = "tidy" include = ["**/*.{pl,pm,pod}"] cmd = ["podtidy", "--columns", "100", "--inplace", "--nobackup"] ok-exit-codes = 0 lint-failure-exit-codes = 1 [commands.omegasort-gitignore] type = "both" include = "**/.gitignore" cmd = ["omegasort", "--sort", "path", "--unique"] lint-flags = "--check" tidy-flags = "--in-place" ok-exit-codes = 0 lint-failure-exit-codes = 1 ignore-stderr = ["The .+ file is not sorted", "The .+ file is not unique"] area_link.t100644001750001750 404115076225326 15514 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl # WWW::Mechanize tests for tags use warnings; use strict; use Test::More tests => 9; use Test::Memory::Cycle; BEGIN { use_ok('WWW::Mechanize'); } use URI::file (); my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/area_link.html'); $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; AREA_CHECKS: { my @wanted_links = ( [ 'http://www.msnbc.com/area', undef, undef, 'area', { coords => '1,2,3,4', href => 'http://www.msnbc.com/area' } ], [ 'http://www.cnn.com/area', undef, undef, 'area', { coords => '5,6,7,8', href => 'http://www.cnn.com/area' } ], [ 'http://www.cpan.org/area', undef, undef, 'area', { '/' => '/', coords => '10,11,12,13', href => 'http://www.cpan.org/area' } ], [ 'http://www.slashdot.org', undef, undef, 'area', { href => 'http://www.slashdot.org' } ], [ 'http://mark.stosberg.com', undef, undef, 'area', { alt => q{Mark Stosberg's homepage}, href => 'http://mark.stosberg.com' } ], ); my @links = $mech->find_all_links(); # Skip the 'base' field for now for (@links) { my $attrs = $_->[5]; @{$_} = @{$_}[ 0 .. 3 ]; push @{$_}, $attrs; } is_deeply( \@links, \@wanted_links, 'Correct links came back' ); my $linkref = $mech->find_all_links(); is_deeply( $linkref, \@wanted_links, 'Correct links came back' ); memory_cycle_ok( \@links, 'Link list: no cycles' ); memory_cycle_ok( $linkref, 'Single link: no cycles' ); } memory_cycle_ok( $uri, 'URI: no cycles' ); memory_cycle_ok( $mech, 'Mech: no cycles' ); autocheck.t100644001750001750 213615076225326 15540 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::Fatal qw( exception ); use Test::More; use WWW::Mechanize (); my $bad_url = "file:///foo.foo.xx.random"; AUTOCHECK_OFF: { my $mech = WWW::Mechanize->new( autocheck => 0 ); ok( !$mech->autocheck, q{Autocheck is set to off via new()} ); $mech->get($bad_url); ok( !$mech->success, qq{Didn't fetch $bad_url, but didn't die, either} ); $mech->autocheck(1); ok( $mech->autocheck, q{Autocheck is now on} ); like( exception { $mech->get($bad_url) }, qr/Error GETing/, qq{... and couldn't fetch $bad_url, and died as a result} ); } AUTOCHECK_ON: { my $mech = WWW::Mechanize->new; ok( $mech->autocheck, q{Autocheck is on by default} ); like( exception { $mech->get($bad_url) }, qr/Error GETing/, qq{Couldn't fetch $bad_url, and died as a result} ); $mech->autocheck(0); ok( !$mech->autocheck, q{Autocheck is now off} ); $mech->get($bad_url); ok( !$mech->success, qq{... and didn't fetch $bad_url, but didn't die, either} ); } done_testing(); find_link.t100644001750001750 1455315076225326 15555 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef, max_redirect => 0 ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_link.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; my $x; $x = $mech->find_link(); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://www.drphil.com/', 'First link on the page' ); is( $x->url, 'http://www.drphil.com/', 'First link on the page' ); $x = $mech->find_link( n => 3 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'styles.css', 'Third link should be the CSS' ); is( $x->url, 'styles.css', 'Third link should be the CSS' ); $x = $mech->find_link( url_regex => qr/upcase/i ); isa_ok( $x, 'WWW::Mechanize::Link' ); like( $x->url, qr/\Qupcase.com/i, 'found link in uppercase meta tag' ); $x = $mech->find_link( text => 'CPAN A' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://a.cpan.org/', 'First CPAN link' ); is( $x->url, 'http://a.cpan.org/', 'First CPAN link' ); $x = $mech->find_link( url => 'CPAN' ); ok( !defined $x, 'No url matching CPAN' ); $x = $mech->find_link( text_regex => qr/CPAN/, n => 3 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://c.cpan.org/', '3rd CPAN text' ); is( $x->url, 'http://c.cpan.org/', '3rd CPAN text' ); $x = $mech->find_link( text => 'CPAN', n => 34 ); ok( !defined $x, 'No 34th CPAN text' ); $x = $mech->find_link( text_regex => qr/(?i:cpan)/ ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://a.cpan.org/', 'Got 1st cpan via regex' ); is( $x->url, 'http://a.cpan.org/', 'Got 1st cpan via regex' ); $x = $mech->find_link( text_regex => qr/cpan/i ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://a.cpan.org/', 'Got 1st cpan via regex' ); is( $x->url, 'http://a.cpan.org/', 'Got 1st cpan via regex' ); $x = $mech->find_link( text_regex => qr/cpan/i, n => 153 ); ok( !defined $x, 'No 153rd cpan link' ); $x = $mech->find_link( url => 'http://b.cpan.org/' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://b.cpan.org/', 'Got b.cpan.org' ); is( $x->url, 'http://b.cpan.org/', 'Got b.cpan.org' ); $x = $mech->find_link( url => 'http://b.cpan.org', n => 2 ); ok( !defined $x, 'Not a second b.cpan.org' ); $x = $mech->find_link( url_regex => qr/[b-d]\.cpan\.org/, n => 2 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://c.cpan.org/', 'Got c.cpan.org' ); is( $x->url, 'http://c.cpan.org/', 'Got c.cpan.org' ); my @wanted_links = ( [ 'http://a.cpan.org/', 'CPAN A', undef, 'a' ], [ 'http://b.cpan.org/', 'CPAN B', undef, 'a' ], [ 'http://c.cpan.org/', 'CPAN C', 'bongo', 'a' ], [ 'http://d.cpan.org/', 'CPAN D', undef, 'a' ], ); my @links = $mech->find_all_links( text_regex => qr/CPAN/ ); @{$_} = @{$_}[ 0 .. 3 ] for @links; is_deeply( \@links, \@wanted_links, 'Correct links came back' ); my $linkref = $mech->find_all_links( text_regex => qr/CPAN/ ); is_deeply( $linkref, \@wanted_links, 'Correct links came back' ); # Check combinations of links $x = $mech->find_link( text => 'News' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://www.msnbc.com/', 'First News is MSNBC' ); is( $x->url, 'http://www.msnbc.com/', 'First News is MSNBC' ); $x = $mech->find_link( text => 'News', url_regex => qr/bbc/ ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://www.bbc.co.uk/', 'First BBC news link' ); is( $x->url, 'http://www.bbc.co.uk/', 'First BBC news link' ); is( $x->[1], 'News', 'First BBC news text' ); is( $x->text, 'News', 'First BBC news text' ); $x = $mech->find_link( text => 'News', url_regex => qr/cnn/ ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://www.cnn.com/', 'First CNN news link' ); is( $x->url, 'http://www.cnn.com/', 'First CNN news link' ); is( $x->[1], 'News', 'First CNN news text' ); is( $x->text, 'News', 'First CNN news text' ); AREA_CHECKS: { my @wanted_links = ( [ 'http://www.cnn.com/', 'CNN', undef, 'a' ], [ 'http://www.cnn.com/', 'News', 'Fred', 'a' ], # Can someone confirm that I just fixed a bug here, and # area tags /should/ have names? -mls [ 'http://www.cnn.com/area', undef, 'Marty', 'area' ], ); my @links = $mech->find_all_links( url_regex => qr/cnn\.com/ ); @{$_} = @{$_}[ 0 .. 3 ] for @links; is_deeply( \@links, \@wanted_links, 'Correct links came back' ); } $x = $mech->find_link( name => 'bongo' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is_deeply( $x, [ 'http://c.cpan.org/', 'CPAN C', 'bongo', 'a' ], 'Got the CPAN C link' ); $x = $mech->find_link( name_regex => qr/^[A-Z]/, n => 2 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is_deeply( $x, [ 'http://www.cnn.com/', 'News', 'Fred', 'a' ], 'Got 2nd link that begins with a capital' ); $x = $mech->find_link( tag => 'a', n => 3 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is_deeply( $x, [ 'http://b.cpan.org/', 'CPAN B', undef, 'a' ], 'Got 3rd tag' ); $x = $mech->find_link( tag_regex => qr/^(a|frame)$/, n => 7 ); isa_ok( $x, 'WWW::Mechanize::Link' ); is_deeply( $x, [ 'http://d.cpan.org/', 'CPAN D', undef, 'a' ], 'Got 7th or tag' ); $x = $mech->find_link( text => 'Rebuild Index' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is_deeply( [ @{$x}[ 0 .. 3 ] ], [ '/cgi-bin/MT/mt.cgi', 'Rebuild Index', undef, 'a' ], 'Got the JavaScript link' ); $x = $mech->find_link( url => 'blongo.html' ); isa_ok( $x, 'WWW::Mechanize::Link' ); $x = $mech->find_link( url_abs => 'blongo.html' ); ok( !defined $x, 'No match' ); $x = $mech->find_link( url_abs_regex => qr[t/blongo\.html$] ); isa_ok( $x, 'WWW::Mechanize::Link' ); $x = $mech->find_link( text_regex => qr/click/i ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'http://www.yahoo.com/', 'Got js url link' ); is( $x->url, 'http://www.yahoo.com/', 'Got js url link' ); $x = $mech->find_link( rel => 'icon' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'foo.png', 'Got icon url link' ); $x = $mech->find_link( rel_regex => qr/sheet/i ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->[0], 'styles.css', 'Got stylesheet url link' ); $mech->get( URI::file->new_abs('t/refresh.html') ); my $link = $mech->find_link( tag => 'meta' ); is( $link->url, 'http://www.mysite.com/', 'got link from meta tag via tag search' ); done_testing(); frames.html100644001750001750 57015076225326 15530 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t google.html100644001750001750 547015076225326 15553 0ustar00olafolaf000000000000WWW-Mechanize-2.20/tGoogle
Google

 Web Images Groups Directory News 

 
 • Advanced Search
 • Preferences
 • Language Tools

Want more from Google? Try these expert search tips


Advertise with Us - Business Solutions - Services & Tools - Jobs, Press, & Help

©2003 Google - Searching 3,083,324,652 web pages

image-new.t100644001750001750 310115076225326 15434 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 15; BEGIN { use_ok('WWW::Mechanize::Image'); } # test new style API my $img = WWW::Mechanize::Image->new( { url => 'url.html', base => 'http://base.example.com/', name => 'name', alt => 'alt', tag => 'a', height => 2112, width => 5150, attrs => { id => 'id', class => 'foo bar' }, } ); is( $img->url, 'url.html', 'url() works' ); is( $img->base, 'http://base.example.com/', 'base() works' ); is( $img->name, 'name', 'name() works' ); is( $img->alt, 'alt', 'alt() works' ); is( $img->tag, 'a', 'tag() works' ); is( $img->height, 2112, 'height works' ); is( $img->width, 5150, 'width works' ); is( $img->attrs->{id}, 'id', 'attrs/id works' ); is( $img->attrs->{class}, 'foo bar', 'attrs/class works' ); is( $img->url_abs, 'http://base.example.com/url.html', 'url_abs works' ); isa_ok( $img->URI, 'URI::URL', 'Returns an object' ); my $img_no_src = WWW::Mechanize::Image->new( { url => undef, base => 'http://base.example.com/', tag => 'img', height => 123, width => 321, } ); isa_ok( $img_no_src, 'WWW::Mechanize::Image' ); is( $img_no_src->url, undef, 'url() without url is undef' ); isa_ok( $img_no_src->URI, 'URI::URL', 'Returns an object' ); link-base.t100644001750001750 73515076225326 15422 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 5; BEGIN { use_ok('WWW::Mechanize::Link'); } NO_BASE: { my $link = WWW::Mechanize::Link->new( 'url.html', 'Click here', undef, undef ); isa_ok( $link, 'WWW::Mechanize::Link', 'constructor OK' ); my $URI = $link->URI; isa_ok( $URI, 'URI::URL', 'URI is proper type' ); is( $URI->rel, 'url.html', 'Short form of the url' ); is( $link->url_abs, 'url.html', 'url_abs works' ); } local000755001750001750 015076225326 14335 5ustar00olafolaf000000000000WWW-Mechanize-2.20/tget.t100644001750001750 502215076225326 15440 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More tests => 34; use lib qw( t/local ); use LocalServer (); use Test::Memory::Cycle; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $agent = WWW::Mechanize->new; isa_ok( $agent, 'WWW::Mechanize', 'Created object' ); my $response = $agent->get( $server->url ); isa_ok( $response, 'HTTP::Response' ); isa_ok( $agent->response, 'HTTP::Response' ); ok( $response->is_success, 'Page read OK' ); ok( $agent->success, "Get webpage" ); is( $agent->ct, "text/html", "Got the content-type..." ); ok( $agent->is_html, "... and the is_html wrapper" ); is( $agent->title, 'WWW::Mechanize test page', 'Titles match' ); $agent->get('/foo/'); ok( $agent->success, 'Got the /foo' ); is( $agent->uri, sprintf( '%sfoo/', $server->url ), 'Got relative OK' ); ok( $agent->is_html, 'Got HTML back' ); is( $agent->title, 'WWW::Mechanize test page', 'Got the right page' ); $agent->get('../bar/'); ok( $agent->success, 'Got the /bar page' ); is( $agent->uri, sprintf( '%sbar/', $server->url ), 'Got relative OK' ); ok( $agent->is_html, 'is HTML' ); is( $agent->title, 'WWW::Mechanize test page', 'Got the right page' ); $agent->get('basics.html'); ok( $agent->success, 'Got the basics page' ); is( $agent->uri, sprintf( '%sbar/basics.html', $server->url ), 'Got relative OK' ); ok( $agent->is_html, 'is HTML' ); is( $agent->title, 'WWW::Mechanize test page', 'Title matches' ); like( $agent->content, qr/WWW::Mechanize test page/, 'Got the right page' ); $agent->get('./refinesearch.html'); ok( $agent->success, 'Got the "refine search" page' ); is( $agent->uri, sprintf( '%sbar/refinesearch.html', $server->url ), 'Got relative OK' ); ok( $agent->is_html, 'is HTML' ); is( $agent->title, 'WWW::Mechanize test page', 'Title matches' ); like( $agent->content, qr/WWW::Mechanize test page/, 'Got the right page' ); my $rslength = do { use bytes; length $agent->content }; my $tempfile = './temp'; unlink $tempfile; ok( !-e $tempfile, 'tempfile not there right now' ); $agent->get( './refinesearch.html', ':content_file' => $tempfile ); ok( -e $tempfile, 'File exists' ); is( -s $tempfile, $rslength, 'Did all the bytes get saved?' ); unlink $tempfile; memory_cycle_ok( $agent, 'Mech: no cycles' ); $agent->get('/foo/'); ok( !$agent->redirects, 'redirects is false before we have a redirect' ); $agent->get( $server->redirect('/foo/') ); is( scalar $agent->redirects, 1, 'redirects picks up a redirect' ); select.html100644001750001750 123515076225326 15551 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Like a hole
upload.html100644001750001750 35015076225326 15533 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t
add_header.t100644001750001750 104415076225326 15627 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 4; use HTTP::Request::Common qw( GET ); BEGIN { use_ok('WWW::Mechanize'); } my $agent = WWW::Mechanize->new; isa_ok( $agent, 'WWW::Mechanize', 'Created agent' ); $agent->add_header( Referer => 'x' ); my $req = GET('http://www.google.com/'); $req = $agent->_modify_request($req); like( $req->as_string, qr/Referer/, q{Referer's in there} ); $agent->add_header( Referer => undef ); $req = $agent->_modify_request($req); unlike( $req->as_string, qr/Referer/, q{Referer's not there} ); find_frame.t100644001750001750 75115076225326 15645 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 5; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_frame.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; my $x; $x = $mech->find_link(); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->url, 'bastro.html', 'First link sequentially' ); find_image.t100644001750001750 2413015076225326 15672 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More; use Test::Fatal qw( exception ); use Test::Warnings ':all'; use Test::Deep qw( all cmp_deeply isa methods re superhashof ); use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/image-parse.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; { my @images; is( exception { @images = $mech->find_all_images }, undef, 'find_all_images in the page' ); cmp_deeply( [ map { $_->url } @images ], [ qw( /Images/bg-gradient.png wango.jpg bongo.gif linked.gif hacktober.jpg hacktober.jpg hacktober.jpg http://example.org/abs.tif ), undef, qw( images/logo.png inner.jpg outer.jpg ), ], '... and all ten are in the right order' ); cmp_deeply( \@images, [ $mech->images ], 'images() and find_all_images() return the same thing in list context' ); my $images = $mech->images; my $all_images = $mech->find_all_images; cmp_deeply( $images, $all_images, 'images() and find_all_images() return the same thing in scalar context' ); } # The following data structure describes sets of tests for find_image # and find_all_images. Each test-case is as follows: # # { # name => 'Name of the test case', # args => [ # arg_name => 'value', # another_arg_name => 'value, # ], # expected_single => [ 'WWW::Mechanize::Image method' => 'expected value' ], # expected_all => [ # # first image # [ # 'WWW::Mechanize::Image method' => 'expected value', # 'another WWW::Mechanize::Image method' => 'expected value', # ], # # second image # [ 'WWW::Mechanize::Image method' => 'expected value' ] # ], # }, # # We use Test::Deep to run these tests. The args are key/value pairs # that will be passed to both find_image() and find_all_images(). This # allows us to add more complex tests with a combination of different # arguments easily. # # The expected_single and expected_all keys each contain # a list of methods being called on the resulting WWW::Mechanize::Image # objects, and the value expected to be returned. For expected_all, # there is one dedicated list for every image found. # # It's possible to use Test::Deep's special functions like re() in the # value side of the expected data. # # This data structure does not cover cases that return no match. See # further below for those. # # To make things easier, these numbered $image variables provide # shortcuts for all six images in the website. They can be used instead # of each array reference. my $image0 = [ url => '/Images/bg-gradient.png', tag => 'css' ] ; # this is the body background from the style tag my $image1 = [ url => 'wango.jpg', alt => re('world of') ]; my $image2 = [ url => 'bongo.gif', tag => 'input', height => 142 ]; my $image3 = [ url => 'linked.gif', tag => 'img' ]; my $image4 = [ url => 'hacktober.jpg', attrs => superhashof( { id => 'first-hacktober-image' } ) ]; my $image5 = [ url => 'hacktober.jpg', attrs => superhashof( { class => re('my-class-2') } ) ]; my $image6 = [ url => 'hacktober.jpg', attrs => superhashof( { class => re('my-class-3') } ) ]; my $image7 = [ url => 'http://example.org/abs.tif', attrs => superhashof( { id => 'absolute' } ) ]; my $image8 = [ url => undef, tag => 'img', attrs => superhashof( { 'data-image' => "hacktober.jpg", id => "no-src-regression-269" } ) ]; my $image9 = [ url => 'images/logo.png', tag => 'css' ]; my $image10 = [ url => 'inner.jpg', tag => 'img' ]; my $image11 = [ url => 'outer.jpg', tag => 'css' ]; my $tests = [ { name => 'CSS', args => [ tag => 'css', ], expected_single => $image0, expected_all => [ $image0, $image9, $image11, ], }, { name => 'alt', args => [ alt => 'The world of the wango', ], expected_single => $image1, expected_all => [ $image1, ], }, { name => 'alt_regex', args => [ alt_regex => qr/world/, ], expected_single => $image1, expected_all => [ $image1, ], }, { name => 'url', args => [ url => 'hacktober.jpg', ], expected_single => $image4, expected_all => [ $image4, $image5, $image6, ], }, { name => 'url_regex', args => [ url_regex => qr/gif$/, ], expected_single => $image2, expected_all => [ $image2, $image3, ], }, { name => 'url_abs', args => [ url_abs => 'http://example.org/abs.tif', ], expected_single => $image7, expected_all => [ $image7, ], }, { name => 'url_abs_regex', args => [ url_abs_regex => qr/hacktober/, ], expected_single => $image4, expected_all => [ $image4, $image5, $image6, ], }, { name => 'tag (img)', args => [ tag => 'img', ], expected_single => $image1, expected_all => [ $image1, $image3, $image4, $image5, $image6, $image7, $image8, $image10, ], }, { name => 'tag (input)', args => [ tag => 'input', ], expected_single => $image2, expected_all => [ $image2, ], }, { name => 'tag_regex', args => [ tag_regex => qr/img|input/, ], expected_single => $image1, expected_all => [ $image1, $image2, $image3, $image4, $image5, $image6, $image7, $image8, $image10, ], }, { name => 'id', args => [ id => 'first-hacktober-image', ], expected_single => $image4, expected_all => [ $image4, ], }, { name => 'id_regex', args => [ id_regex => qr/-/, ], expected_single => $image4, expected_all => [ $image4, $image8, ], }, { name => 'class', args => [ class => 'my-class-1', ], expected_single => $image4, expected_all => [ $image4, ], }, { name => 'class_regex', args => [ class_regex => qr/foo/, ], expected_single => $image5, expected_all => [ $image5, $image6, ], }, { name => 'class_regex and url', args => [ class_regex => qr/foo/, url => 'hacktober.jpg' ], expected_single => $image5, expected_all => [ $image5, $image6, ], }, { name => '2nd instance of an image', args => [ url => 'hacktober.jpg', n => 2, ], expected_single => $image5, }, { name => 'inline style background image', args => [ url_regex => qr/logo/, ], expected_single => $image9, }, ]; foreach my $test ( @{$tests} ) { # verify we find the correct first image with a given set of criteria cmp_deeply( $mech->find_image( @{ $test->{args} } ), all( isa('WWW::Mechanize::Image'), methods( @{ $test->{expected_single} } ), ), 'find_image: ' . $test->{name} ); if ( exists $test->{expected_all} ) { # verify we find all the correct images with a given set of criteria cmp_deeply( [ $mech->find_all_images( @{ $test->{args} } ) ], [ map { all( isa('WWW::Mechanize::Image'), methods( @{$_} ), ) } @{ $test->{expected_all} } ], 'find_all_images: ' . $test->{name} ); } } foreach my $arg (qw/alt url url_abs tag id class/) { cmp_deeply( [ $mech->find_image( $arg => 'does not exist' ) ], [], "find_image with $arg that does not exist returns an empty list" ); cmp_deeply( [ $mech->find_image( $arg . '_regex' => qr/does not exist/ ) ], [], "find_image with ${arg}_regex that does not exist returns an empty list" ); } # all of these will find the "wrong" image { my $image; like( warning { $image = $mech->find_image( url => qr/tif$/ ) }, qr/is a regex/, 'find_image warns when it sees an unexpected regex' ); unlike $image->url, qr/tif$/, '... and ignores this argument'; } { my $image; like( warning { $image = $mech->find_image( url_regex => 'tif' ) }, qr/is not a regex/, 'find_image warns when it expects a regex and sees a string' ); unlike $image->url, qr/tif$/, '... and ignores this argument'; } { my $image; like( warning { $image = $mech->find_image( id => q{ absolute } ) }, qr/space-padded and cannot succeed/, 'find_image warns about space-padding' ); is $image->attrs, undef, '... and ignores this argument'; } done_testing; back.t100644001750001750 1003715076225326 15603 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More tests => 47; use lib qw( t/local ); use LocalServer (); =head1 NAME =head1 SYNOPSIS This tests Mech's Back "button". Tests were converted from t/live/back.t, and subsequently enriched to deal with RT ticket #8109. =cut use Test::Memory::Cycle; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => {} ); isa_ok( $mech, 'WWW::Mechanize' ); isa_ok( $mech->cookie_jar(), 'HTTP::Cookies', 'this $mech starts with a cookie jar' ); my $html = <<'HTML'; %s Whatever. Images Scripts Ports Modules
HTML my $server = LocalServer->spawn( html => $html ); isa_ok( $server, 'LocalServer' ); ok( !$mech->back(), 'With no stack, no going back' ); $mech->get( $server->url ); ok( $mech->success, 'Fetched OK' ); my $first_base = $mech->base; my $title = $mech->title; $mech->follow_link( n => 2 ); ok( $mech->success, 'Followed OK' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); $mech->follow_link( text => 'Images' ); ok( $mech->success, 'Followed OK' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); is( scalar @{ $mech->{page_stack} }, 0, 'Pre-search check' ); $mech->submit_form( fields => { 'q' => 'perl' }, ); ok( $mech->success, 'Searched for Perl' ); like( $mech->title, qr/search.cgi/, 'Right page title' ); is( scalar @{ $mech->{page_stack} }, 1, 'POST is in the stack' ); $mech->head( $server->url ); ok( $mech->success, 'HEAD succeeded' ); is( scalar @{ $mech->{page_stack} }, 1, 'HEAD is not in the stack' ); ok( $mech->back(), 'Back should succeed' ); ok( $mech->success, 'Back' ); is( $mech->base, $first_base, 'Did the base get set back?' ); is( $mech->title, $title, 'Title set back?' ); is( scalar @{ $mech->{page_stack} }, 0, 'Post-search check' ); =head2 Back and misc. internal fields RT ticket #8109 reported that back() is broken after reload(), and that the cookie_jar was also damaged by back(). We test for that: reload() should not alter the back() stack, and the cookie jar should not be versioned (once a cookie is set, hitting the back button in a browser does not cause it to go away). =cut $mech->follow_link( text => 'Images' ); $mech->reload(); ok( $mech->back(), 'Back should succeed' ); is( $mech->title, $title, 'reload() does not push page to stack' ); ok( defined( $mech->cookie_jar() ), '$mech still has a cookie jar after a number of back()' ); # Now some other weird stuff. Start with a fresh history by recreating # $mech. memory_cycle_ok( $mech, 'No memory cycles found' ); $mech = WWW::Mechanize->new( autocheck => 0 ); isa_ok( $mech, 'WWW::Mechanize' ); $mech->get( $server->url ); ok( $mech->success, 'Got root URL' ); my @links = qw( /scripts /ports/ modules/ ); is( scalar @{ $mech->{page_stack} }, 0, 'Pre-404 check' ); my $server404url = $server->error_notfound('404check'); $mech->get($server404url); is( $mech->status, 404, '404 check' ) or diag( qq{\$server404url=$server404url\n\$mech->content="}, $mech->content, qq{"\n} ); is( scalar @{ $mech->{page_stack} }, 1, 'Even 404s get on the stack' ); ok( $mech->back(), 'Back should succeed' ); is( $mech->uri, $server->url, 'Back from the 404' ); is( scalar @{ $mech->{page_stack} }, 0, 'Post-404 check' ); for my $link (@links) { $mech->get($link); warn $mech->status() if ( !$mech->success() ); is( $mech->status, 200, "Get $link" ); ok( $mech->back(), 'Back should succeed' ); is( $mech->uri, $server->url, "Back from $link" ); } memory_cycle_ok( $mech, 'No memory cycles found' ); form.t100644001750001750 1164115076225326 15650 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More; use lib 't/local'; use LocalServer (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my @warnings; my $mech = WWW::Mechanize->new( onwarn => sub { push @warnings, @_ } ); isa_ok( $mech, 'WWW::Mechanize' ) or die; $mech->quiet(1); $mech->get( $server->url ); ok( $mech->success, 'got a page' ) or die; is( $mech->uri, $server->url, 'got correct page' ); my ( $form, $number ) = $mech->form_number(1); isa_ok( $form, 'HTML::Form', 'form_number - can select the first form in list context call' ); is( $number, 1, 'form_number - form number is correct' ); my $form_number_1 = $mech->form_number(1); isa_ok( $form_number_1, 'HTML::Form', 'form_number - can select the first form' ); is( $mech->current_form(), $mech->{forms}->[0], 'form_number - set the form attribute' ); ok( !$mech->form_number(99), 'form_number - cannot select the 99th form' ); is( $mech->current_form(), $mech->{forms}->[0], 'form_number - form is still set to 1' ); my $form_name_f = $mech->form_name('f'); isa_ok( $form_name_f, 'HTML::Form', 'form_name - can select the form' ); ok( !$mech->form_name('bargle-snark'), 'form_name - cannot select non-existent form' ); $form_name_f = $mech->form_name('mf'); isa_ok( $form_name_f, 'HTML::Form', 'form_name - can select the form' ); $form_name_f = $mech->form_name( 'mf', { n => 1 } ); isa_ok( $form_name_f, 'HTML::Form', 'form_name - can select the 1st multiform' ); $form_name_f = $mech->form_name( 'mf', { n => 2 } ); isa_ok( $form_name_f, 'HTML::Form', 'form_name - can select the 2nd multiform' ); ok( !$mech->form_name( 'mf', { n => 3 } ), 'form_name - cannot select non-existent multiform' ); my $form_id_pounder = $mech->form_id('pounder'); isa_ok( $form_id_pounder, 'HTML::Form', 'form_id - can select the form' ); ok( !$mech->form_id('bargle-snark'), 'form_id - cannot select non-existent multiform' ); $form_id_pounder = $mech->form_id('multiform'); isa_ok( $form_id_pounder, 'HTML::Form', 'form_id - can select the multiform' ); $form_id_pounder = $mech->form_id( 'multiform', { n => 1 } ); isa_ok( $form_id_pounder, 'HTML::Form', 'form_id - can select the 1st multiform' ); $form_id_pounder = $mech->form_id( 'multiform', { n => 2 } ); isa_ok( $form_id_pounder, 'HTML::Form', 'form_id - can select the 2nd multiform' ); ok( !$mech->form_id( 'multiform', { n => 3 } ), 'form_id - cannot select non-existent multiform' ); my $form_with = $mech->form_with( class => 'test', id => undef ); isa_ok( $form_with, 'HTML::Form', 'form_with - can select the form without id' ); is( $mech->current_form, $form_number_1, 'form_with - form without id is now the current form' ); my $form_number_2 = $mech->form_number(2); $form_with = $mech->form_with( class => 'test', foo => q{}, bar => undef, { n => 2 } ); is( $form_with, $form_number_2, 'Can select nth form with ambiguous criteria' ); is( scalar @warnings, 0, 'no warnings so far' ); $mech->quiet(0); $form_with = $mech->form_with( class => 'test', foo => q{}, bar => undef ); is( $form_with, $form_number_1, 'form_with - can select form with ambiguous criteria' ); is( scalar @warnings, 1, 'form_with - got one warning' ); is( "@warnings", 'There are 2 forms with no bar and class "test"' . ' and empty foo. The first one was used.', 'Got expected warning' ); $mech->quiet(1); # the server's URL may be in a different form than what the Form actually contains my $cli_form_action = ( grep { $_->action =~ m{/google-cli$} } $mech->forms )[0]->action; my $form_with_action = $mech->form_with( action => $cli_form_action ); is( $form_with_action->attr('id'), 'searchbox', 'form_with - with with action' ); my $formsubmit_form_action = ( grep { $_->action =~ m{/formsubmit$} } $mech->forms )[-1]->action; $form_with_action = $mech->form_with( action => $formsubmit_form_action, class => 'test mf2' ); is( $form_with_action->attr('class'), 'test mf2', 'form_with - with action and class' ); $form_with_action = $mech->form_with( action => '/does_not_exist', class => 'test' ); ok( !$form_with_action, 'form_with - filters forms when action does not exist' ); my $form_id_searchbox = $mech->form_action('google-cli'); isa_ok( $form_id_searchbox, 'HTML::Form', 'form_action - can select the form' ); ok( !$mech->form_action('bargle-snark'), 'form_action - cannot select non-existent form' ); $mech->quiet(0); my $form_action = $mech->form_action('formsubmit'); isa_ok( $form_action, 'HTML::Form', 'form_action - can select the form' ); is( scalar @warnings, 2, 'form_action - got one warning' ); like( $warnings[-1], qr/with action matching/, 'form_action - got correct multiple-matching-forms warning' ); $mech->quiet(1); done_testing; head.t100644001750001750 130515076225326 15562 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More; use lib qw( t/local ); use LocalServer (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $agent = WWW::Mechanize->new; isa_ok( $agent, 'WWW::Mechanize', 'Created object' ); ok !$agent->base, 'Starting out with no ->base'; my $response = $agent->get( $server->url ); isa_ok( $response, 'HTTP::Response' ); ok $agent->base, '... and now there is a ->base'; $agent->head('/foo.html'); ok !$agent->content, 'HEADing returns no content'; is my $filename = $agent->response->filename, 'foo.html', '... but the filename is set'; done_testing; post.t100644001750001750 103615076225326 15647 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More tests => 5; use lib qw( t/local ); use LocalServer (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $agent = WWW::Mechanize->new; isa_ok( $agent, 'WWW::Mechanize', 'Created object' ); # GET with full URL to set the base $agent->get( $server->url ); ok( $agent->success, "Get webpage" ); # POST with relative URL $agent->post('/post'); ok( $agent->success, "Post webpage" ); refresh.html100644001750001750 12715076225326 15707 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t author000755001750001750 015076225326 14735 5ustar00olafolaf000000000000WWW-Mechanize-2.20/xteol.t100644001750001750 515515076225326 16047 0ustar00olafolaf000000000000WWW-Mechanize-2.20/xt/authoruse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 use Test::More 0.88; use Test::EOL; my @files = ( 'lib/WWW/Mechanize.pm', 'lib/WWW/Mechanize/Cookbook.pod', 'lib/WWW/Mechanize/Examples.pod', 'lib/WWW/Mechanize/FAQ.pod', 'lib/WWW/Mechanize/Image.pm', 'lib/WWW/Mechanize/Link.pm', 'script/mech-dump', 't/00-load.t', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/TestServer.pm', 't/add_header.t', 't/aliases.t', 't/area_link.html', 't/area_link.t', 't/autocheck.t', 't/bad-request.t', 't/clone.t', 't/content.t', 't/cookies.t', 't/credentials-api.t', 't/credentials.t', 't/die.t', 't/dump.t', 't/field.html', 't/field.t', 't/file_upload.html', 't/file_upload.t', 't/find_frame.html', 't/find_frame.t', 't/find_image.t', 't/find_inputs.html', 't/find_inputs.t', 't/find_link-warnings.t', 't/find_link.html', 't/find_link.t', 't/find_link_id.html', 't/find_link_id.t', 't/find_link_xhtml.html', 't/find_link_xhtml.t', 't/form-parsing.t', 't/form_133_regression.html', 't/form_with_fields.html', 't/form_with_fields.t', 't/form_with_fields_passthrough_params.t', 't/form_with_fields_verbose.html', 't/frames.html', 't/frames.t', 't/google.html', 't/history.t', 't/history_1.html', 't/history_2.html', 't/history_3.html', 't/html_file.txt', 't/image-new.t', 't/image-parse.css', 't/image-parse.html', 't/image-parse.t', 't/link-base.t', 't/link-relative.t', 't/link.t', 't/local/LocalServer.pm', 't/local/back.t', 't/local/click.t', 't/local/click_button.t', 't/local/content.t', 't/local/encoding.t', 't/local/failure.t', 't/local/follow.t', 't/local/form.t', 't/local/get.t', 't/local/head.t', 't/local/log-server', 't/local/nonascii.html', 't/local/nonascii.t', 't/local/overload.t', 't/local/page_stack.t', 't/local/post.t', 't/local/referer-server', 't/local/referer.t', 't/local/reload.t', 't/local/select_multiple.t', 't/local/submit.t', 't/mech-dump/file_not_found.t', 't/mech-dump/mech-dump.t', 't/new.t', 't/refresh.html', 't/regex-error.t', 't/save_content.html', 't/save_content.t', 't/select.html', 't/select.t', 't/submit_form.t', 't/tick.html', 't/tick.t', 't/upload.html', 't/upload.t', 't/uri.t', 't/warn.t', 't/warnings.t' ); eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; done_testing; TestServer.pm100644001750001750 574215076225326 16057 0ustar00olafolaf000000000000WWW-Mechanize-2.20/tpackage TestServer; use strict; use warnings; use HTTP::Daemon (); use File::Spec (); sub new { my $class = shift; my $port = shift; my $self = bless { port => $port, }, $class; return $self; } sub start { my $self = shift; die "Already started!" if $self->{daemon}; $self->{daemon} = HTTP::Daemon->new( LocalAddr => $self->hostname, ( $self->{port} ? ( port => $self->{port} ) : () ), ); return $self->{daemon}; } sub run { my $self = shift; $self->start if !$self->{daemon}; my $d = $self->{daemon}; while ( my $c = $d->accept ) { while ( my $r = $c->get_request ) { $self->handle_request( $c, $r ); } $c->close; undef($c); } return; } sub handle_request { my $self = shift; my ( $conn, $req ) = @_; my $path = $req->uri->path; my $dispatch_table = $self->{dispatch_table}; if ( my $handler = $dispatch_table->{$path} ) { my $res = $handler->($req); $conn->send_response($res); } else { my $file = $path; if ( $file =~ m{/$} ) { $file .= 'index.html'; } $file =~ s/\s+//g; my $filename = "t/html/$file"; if ( open my $fh, '<', $filename ) { my $content = do { local $/; <$fh> }; print {$conn} "HTTP/1.0 200 OK\r\n"; print {$conn} "Content-Type: text/html\r\nContent-Length: ", length($content), "\r\n\r\n", $content; return; } else { print {$conn} "HTTP/1.0 404 Not found\r\n"; print {$conn} "Content-Type: text/plain\r\n"; print {$conn} "\r\n"; print {$conn} "Not found\r\n"; return; } } } sub set_dispatch { my $self = shift; $self->{dispatch_table} = shift; return $self; } sub background { my $self = shift; my $pid = open my $fh, '-|'; if ( !defined $pid ) { die "Can't start the test server"; } elsif ( !$pid ) { my $daemon = $self->start; print "TestServer started: " . $daemon->url . "\n"; open STDIN, '<', File::Spec->devnull; open STDOUT, '>', File::Spec->devnull; $self->run; # should never return exit 1; } $self->{pid} = $pid; my $status_line = <$fh>; chomp $status_line; if ( $status_line =~ /\ATestServer started: (.*)\z/ ) { $self->{root} = $1; $self->{child_fh} = $fh; } else { die "Error starting test server"; } return $pid; } sub hostname { my $self = shift; return '127.0.0.1'; } sub root { my $self = shift; $self->{root}; } sub stop { my $self = shift; if ( my $pid = delete $self->{pid} ) { kill 9, $pid; waitpid $pid, 0; } if ( my $fh = delete $self->{child_fh} ) { close $fh; } return; } sub DESTROY { my $self = shift; $self->stop; } 1; bad-request.t100644001750001750 105015076225326 16000 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 2; =head1 NAME bad-request.t =head1 SYNOPSIS Tests the detection of bad API usage. ->request() Checks for behaviour of calls to C<< ->request() >> without the required parameter. =cut use WWW::Mechanize (); my $mech = WWW::Mechanize->new(); my $lives = eval { #line 1 $mech->request(); 1; }; my $err = $@; ok !$lives, "->request wants at least one parameter"; like $err, qr/->request was called without a request parameter/, "We carp with a descriptive error message"; credentials.t100644001750001750 365215076225326 16073 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use WWW::Mechanize (); use Test::More; use Test::Fatal qw( exception ); my $mech = WWW::Mechanize->new; isa_ok( $mech, 'WWW::Mechanize' ); my ( $user, $pass ); my $uri = URI->new('http://localhost'); ( $user, $pass ) = $mech->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, undef, 'default username is undefined at first'; is $pass, undef, 'default password is undefined at first'; like( exception { $mech->credentials( "one", "two", "three" ); }, qr/Invalid # of args for overridden credentials/, 'credentials dies with wrong number of args' ); $mech->credentials( "username", "password" ); ( $user, $pass ) = $mech->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, 'username', 'calling credentials sets username for get_basic_credentials'; is $pass, 'password', 'calling credentials sets password for get_basic_credentials'; my $mech2 = $mech->clone; ( $user, $pass ) = $mech2->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, 'username', 'cloned object has username for get_basic_credentials'; is $pass, 'password', 'cloned object has password for get_basic_credentials'; my $mech3 = WWW::Mechanize->new; isa_ok( $mech3, 'WWW::Mechanize' ); ( $user, $pass ) = $mech3->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, undef, 'new object has no username for get_basic_credentials'; is $pass, undef, 'new object has no password for get_basic_credentials'; $mech->clear_credentials; ( $user, $pass ) = $mech->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, undef, 'username is undefined after clear_credentials'; is $pass, undef, 'password is undefined after clear_credentials'; ( $user, $pass ) = $mech2->get_basic_credentials( 'myrealm', $uri, 0 ); is $user, 'username', 'cloned object still has username for get_basic_credentials'; is $pass, 'password', 'cloned object still has password for get_basic_credentials'; done_testing; file_upload.t100644001750001750 732515076225326 16062 0ustar00olafolaf000000000000WWW-Mechanize-2.20/tuse strict; use warnings; use Test::More; use Test::Fatal qw( lives_ok ); use WWW::Mechanize (); use URI::file (); my $file = 't/file_upload.html'; my $filename = 'the_file_upload.html'; my $mc = WWW::Mechanize->new; my $uri = URI::file->new_abs('t/file_upload.html')->as_string; my ( $form, $input, $as_string ); # &field $mc->get($uri); $mc->field( 'document', [$file] ); ($form) = $mc->forms; $as_string = $form->make_request->as_string; like( $as_string, qr! filename="$file" !x, q/$mc->field( 'document', [$file] )/ ); like( $as_string, qr!
get($uri); $mc->field( 'document', [ $file, $filename ] ); ($form) = $mc->forms; like( $form->make_request->as_string, qr! filename="$filename" !x, q/$mc->field( 'document', [$file, $filename] )/ ); $mc->get($uri); $mc->field( 'document', [ $file, $filename, Content => 'changed content' ] ); ($form) = $mc->forms; $as_string = $form->make_request->as_string; like( $as_string, qr! filename="$filename" !x, q/$mc->field( 'document', [$file, $filename, Content => 'changed content'] )/ ); like( $as_string, qr!changed content!, '... and the Content header was sent instead of the file' ); # &set_fields $mc->get($uri); $mc->set_fields( 'document' => [$file] ); ($form) = $mc->forms; $as_string = $form->make_request->as_string; like( $as_string, qr! filename="$file" !x, q/$mc->set_fields( 'document', [$file] )/ ); like( $as_string, qr!get($uri); $mc->set_fields( 'document' => [ $file, $filename ] ); ($form) = $mc->forms; like( $form->make_request->as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'document' => [ $file, $filename ] )/ ); $mc->get($uri); $mc->set_fields( 'document' => [ $file, $filename, Content => 'my content' ] ); ($form) = $mc->forms; $as_string = $form->make_request->as_string; like( $as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'document' => [ $file, $filename, Content => 'my content' ] )/ ); like( $as_string, qr!my content!, '... and the Content header was sent instead of the file' ); $mc->get($uri); $mc->set_fields( 'document' => [ [ $file, $filename ], 1 ] ); ($form) = $mc->forms; like( $form->make_request->as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'document' => [[ $file, $filename ], 1] )/ ); $mc->get($uri); $mc->set_fields( 'document' => [ [ $file, $filename, Content => 'content' ], 1 ] ); ($form) = $mc->forms; like( $form->make_request->as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'document' => [[ $file, $filename, Content => 'content' ], 1] )/ ); $mc->get($uri); $mc->set_fields( 'document' => [ [ undef, $filename, Content => 'content' ], 1 ] ); ($form) = $mc->forms; $as_string = $form->make_request->as_string; like( $as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'document' => [[ undef, $filename, Content => 'content' ], 1] )/ ); # &set_fields with multiple fields $mc->get($uri); $mc->set_fields( 'another_field' => 'foo', 'document' => [ $file, $filename ] ); ($form) = $mc->forms; like( $form->make_request->as_string, qr! filename="$filename" !x, q/$mc->set_fields( 'another_field' => 'foo', 'document' => [ $file, $filename ] )/ ); # field does not exist $mc->get($uri); lives_ok { $mc->set_fields( 'does_not_exist' => [ [$file], 1 ] ) } 'setting a field that does not exist lives'; ($form) = $mc->forms; $as_string = $form->make_request->as_string; unlike( $as_string, qr! filename="$file" !x, q/$mc->set_fields( 'does_not_exist' => [ [$file], 1 ] )/ ); done_testing; find_inputs.t100644001750001750 247415076225326 16121 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 11; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_inputs.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; FIRST_FORM: { my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 3, 'Exactly three inputs' ); my @submits = $mech->find_all_submits(); is( scalar @submits, 2, 'Exactly two submits' ); } SECOND_FORM: { $mech->form_number(2); my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 4, 'Exactly four inputs' ); my @submits = $mech->find_all_submits(); is( scalar @submits, 1, 'Exactly one submit' ); } THIRD_FORM: { $mech->form_number(3); my @inputs = $mech->find_all_inputs(); is( scalar @inputs, 5, 'Exactly five inputs' ); my @relatives = $mech->find_all_inputs( name_regex => qr/^Your/ ); is( scalar @relatives, 4, 'Found four relatives' ); my @sisters = $mech->find_all_inputs( name => 'YourSister' ); is( scalar @sisters, 2, 'Found two sisters' ); my @submit_sisters = $mech->find_all_inputs( name => 'YourSister' ); is( scalar @submit_sisters, 2, 'But no sisters are submits' ); } html_file.txt100644001750001750 23415076225326 16066 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t
image-parse.t100644001750001750 657415076225326 15776 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 47; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/image-parse.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die 'Can\'t get test page'; my @images = $mech->images; is( scalar @images, 12, 'Exactly twelve images' ); my $first = $images[0]; is( $first->url, '/Images/bg-gradient.png', 'Got the background style image' ); is( $first->tag, 'css', 'css tag' ); is( $first->alt, undef, 'alt' ); my $second = $images[1]; is( $second->tag, 'img', 'img tag' ); is( $second->url, 'wango.jpg', 'URL matches' ); is( $second->alt, 'The world of the wango', 'alt matches' ); my $third = $images[2]; is( $third->tag, 'input', 'input tag' ); is( $third->url, 'bongo.gif', 'URL matches' ); is( $third->alt, undef, 'alt matches' ); is( $third->height, 142, 'height' ); is( $third->width, 43, 'width' ); my $fourth = $images[3]; is( $fourth->url, 'linked.gif', 'Got the fourth image' ); is( $fourth->tag, 'img', 'input tag' ); is( $fourth->alt, undef, 'alt' ); my $fifth = $images[4]; is( $fifth->url, 'hacktober.jpg', 'Got the fifth image' ); is( $fifth->tag, 'img', 'input tag' ); is( $fifth->alt, undef, 'alt' ); is( $fifth->attrs->{id}, 'first-hacktober-image', 'id' ); is( $fifth->attrs->{class}, 'my-class-1', 'class' ); my $sixth = $images[5]; is( $sixth->url, 'hacktober.jpg', 'Got the sixth image' ); is( $sixth->tag, 'img', 'input tag' ); is( $sixth->alt, undef, 'alt' ); is( $sixth->attrs->{id}, undef, 'id' ); is( $sixth->attrs->{class}, 'my-class-2 foo', 'class' ); my $seventh = $images[6]; is( $seventh->url, 'hacktober.jpg', 'Got the seventh image' ); is( $seventh->tag, 'img', 'input tag' ); is( $seventh->alt, undef, 'alt' ); is( $seventh->attrs->{id}, undef, 'id' ); is( $seventh->attrs->{class}, 'my-class-3 foo bar', 'class' ); # regression github #269 my $eighth = $images[8]; is( $eighth->attrs->{id}, 'no-src-regression-269', 'Got the eighth image' ); is( $eighth->url, undef, 'it has no URL' ); is( $eighth->attrs->{'data-image'}, 'hacktober.jpg', 'it has an extra attribute' ); my $ninth = $images[9]; is( $ninth->url, 'images/logo.png', 'Got the fifth image' ); is( $ninth->tag, 'css', 'css tag' ); is( $ninth->alt, undef, 'alt' ); # find image in css $uri = URI::file->new_abs('t/image-parse.css')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; eval { @images = $mech->find_all_images(); }; is( $@, q{}, 'survived eval' ); is( scalar @images, 2, 'Exactly two images' ); my $css_first = $images[0]; is( $css_first->url, '/Images/bg-gradient.png', 'Got the first image' ); is( $css_first->tag, 'css', 'css tag' ); is( $css_first->alt, undef, 'alt' ); my $css_second = $images[1]; is( $css_second->url, 'images/logo.png', 'Got the second image' ); is( $css_second->tag, 'css', 'css tag' ); click.t100644001750001750 155015076225326 15750 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use lib 't/local'; use LocalServer (); use Test::More tests => 9; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new(); isa_ok( $mech, 'WWW::Mechanize', 'Created the object' ); my $server = LocalServer->spawn(); isa_ok( $server, 'LocalServer' ); my $response = $mech->get( $server->url ); isa_ok( $response, 'HTTP::Response', 'Got back a response' ); ok( $response->is_success, 'Got URL' ) or die q{Can't even fetch local url}; ok( $mech->is_html, 'Local page is HTML' ); $mech->field( query => 'foo' ); # Filled the 'q' field $response = $mech->click('submit'); isa_ok( $response, 'HTTP::Response', 'Got back a response' ); ok( $response->is_success, q{Can click 'Go' ('Google Search' button)} ); is( $mech->field('query'), 'foo', 'Filled field correctly' ); regex-error.t100644001750001750 102015076225326 16022 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More; use Test::Warnings qw(:all); use WWW::Mechanize (); my $m = WWW::Mechanize->new; isa_ok( $m, 'WWW::Mechanize' ); like warning { $m->find_link( link_regex => 'foo' ); }, qr[Unknown link-finding parameter "link_regex".+line \d+], 'Passes message, and includes the line number'; like warning { $m->find_link( url_regex => 'foo' ); }, qr[foo passed as url_regex is not a regex.+line \d+], 'Passes message, and includes the line number'; done_testing(); submit_form.t100644001750001750 454215076225326 16123 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More; use Test::Fatal qw( exception ); use Test::Warnings ':all'; use URI::file (); use WWW::Mechanize (); my $mech = WWW::Mechanize->new( cookie_jar => undef, autocheck => 0 ); my $uri = URI::file->new_abs('t/form_with_fields.html')->as_string; $mech->get($uri); { $mech->get($uri); like( exception { $mech->submit_form( form_id => 'i-do-not-exist', ); }, qr/There is no form with ID "i-do-not-exist"/, 'submit_form with no match on form_id', ); } { $mech->get($uri); is( exception { $mech->submit_form( form_id => '6th_form', ); }, undef, 'submit_form with valid form_id', ); } { $mech->get($uri); like( exception { $mech->submit_form( form_thing => 'i-do-not-exist', ); }, qr/Unknown submit_form parameter "form_thing"/, 'submit_form with invalid arg', ); } { $mech->get($uri); like( exception { $mech->submit_form( form_number => 99, ); }, qr/There is no form numbered 99/, 'submit_form with invalid form number', ); } { $mech->get($uri); like( exception { $mech->submit_form( form_name => 99, ); }, qr/There is no form named "99"/, 'submit_form with invalid form name', ); } { $mech->get($uri); like( exception { $mech->submit_form( with_fields => [ 'foo', 'bar' ], ); }, qr/with_fields arg to submit_form must be a hashref/, 'submit_form with invalid arg value for with_fields', ); } { $mech->get($uri); like( exception { $mech->submit_form( fields => [ 'foo', 'bar' ], ); }, qr/fields arg to submit_form must be a hashref/, 'submit_form with invalid arg value for fields', ); } { $mech->get($uri); like( exception { $mech->submit_form( with_fields => {}, # left empty on purpose ) }, qr/no fields provided/, 'submit_form with no fields', ); } done_testing(); perlimports.toml100644001750001750 212115076225326 16411 0ustar00olafolaf000000000000WWW-Mechanize-2.20# Valid log levels are: # debug, info, notice, warning, error, critical, alert, emergency # critical, alert and emergency are not currently used. # # Please use boolean values in this config file. Negated options (--no-*) are # not permitted here. Explicitly set options to true or false. # # Some of these values deviate from the regular perlimports defaults. In # particular, you're encouraged to leave preserve_duplicates and # preserve_unused disabled. cache = false # setting this to true is currently discouraged ignore_modules = ["Test::More"] ignore_modules_filename = "" ignore_modules_pattern = "" # regex like "^(Foo|Foo::Bar)" ignore_modules_pattern_filename = "" libs = ["lib", "t", "t/local"] log_filename = "" log_level = "warn" never_export_modules = [] never_export_modules_filename = "" padding = true preserve_duplicates = false preserve_unused = false tidy_whitespace = true script000755001750001750 015076225326 14304 5ustar00olafolaf000000000000WWW-Mechanize-2.20mech-dump100755001750001750 1366615076225326 16305 0ustar00olafolaf000000000000WWW-Mechanize-2.20/script#!/usr/bin/perl # PODNAME: mech-dump # ABSTRACT: Dumps information about a web page use warnings; use strict; use WWW::Mechanize (); use Getopt::Long; use Pod::Usage; use HTTP::Cookies; my @actions; my $absolute; my $all; my $user; my $pass; my $agent; my $agent_alias; my $cookie_filename; my %command_line_options = ( 'user=s' => \$user, 'password=s' => \$pass, headers => sub { push( @actions, \&dump_headers ) }, forms => sub { push( @actions, \&dump_forms ) }, links => sub { push( @actions, \&dump_links ) }, images => sub { push( @actions, \&dump_images ) }, all => sub { $all++; push( @actions, \&dump_headers, \&dump_forms, \&dump_links, \&dump_images ); }, text => sub { push( @actions, \&dump_text ) }, 'absolute!' => \$absolute, 'agent=s' => \$agent, 'agent-alias=s' => \$agent_alias, 'cookie-file=s' => \$cookie_filename, help => sub { pod2usage(1); }, version => sub { print STDERR $WWW::Mechanize::VERSION, "\n"; exit 0; }, 'completions' => sub { completions(@ARGV); }, ); GetOptions(%command_line_options) or pod2usage(2); sub completions { my (@words) = @_; my @opts; foreach ( sort keys %command_line_options ) { if (m/^ (? [^!]+) ! $/msx) { push @opts, $+{opt}, 'no-' . $+{opt}; } elsif (m/^ (? [^=]+) = [siof]{1} $/msx) { push @opts, ( split qr{\|}, $+{opt} ); } else { push @opts, $_; } } print join "\n", ( map { q{--} . $_ } @opts ); print "\n"; exit 0; } my @uris = @ARGV or die "Must specify a URL or file to check. See --help for details.\n"; @actions = ( \&dump_forms ) unless @actions; binmode( STDOUT, ':utf8' ); my $mech = WWW::Mechanize->new( autocheck => 0 ); if ( defined $agent ) { $mech->agent($agent); } elsif ( defined $agent_alias ) { $mech->agent_alias($agent_alias); } if ( defined $cookie_filename ) { my $cookies = HTTP::Cookies->new( file => $cookie_filename, autosave => 1, ignore_discard => 1 ); $cookies->load(); $mech->cookie_jar($cookies); } else { $mech->cookie_jar(undef); } $mech->env_proxy(); foreach my $uri (@uris) { my $no_ct_check; if ( -e $uri ) { require URI::file; $uri = URI::file->new_abs($uri)->as_string; $no_ct_check = 1; # we don't have to check the content type } my $response = $mech->get($uri); if ( !$response->is_success ) { if ( defined( $response->www_authenticate ) ) { if ( !defined $user or !defined $pass ) { die( "Page requires username and password, but none specified.\n" ); } $mech->credentials( $user, $pass ); $response = $mech->get($uri); $response->is_success or die "Can't fetch $uri with username and password\n", $response->status_line, "\n"; } else { die "$uri returns status ", $response->code, "\n"; } } unless ($no_ct_check) { $mech->is_html or die qq{$uri returns type "}, $mech->ct, qq{", not "text/html"\n}; } foreach my $action (@actions) { $action->($mech); print "\n" if @actions; } } sub dump_headers { my $mech = shift; print "--> Headers:\n" if $all; $mech->dump_headers(undef); return; } sub dump_forms { my $mech = shift; print "--> Forms:\n" if $all; $mech->dump_forms(undef); return; } sub dump_links { my $mech = shift; print "--> Links:\n" if $all; $mech->dump_links( undef, $absolute ); return; } sub dump_images { my $mech = shift; print "--> Images:\n" if $all; $mech->dump_images( undef, $absolute ); return; } sub dump_text { my $mech = shift; $mech->dump_text(); return; } __END__ =pod =encoding UTF-8 =head1 NAME mech-dump - Dumps information about a web page =head1 VERSION version 2.20 =head1 SYNOPSIS mech-dump [options] [file|url] Options: --headers Dump HTTP response headers --forms Dump table of forms (default action) --links Dump table of links --images Dump table of images --all Dump all four of the above, in that order --text Dumps the textual part of the web page --user=user Set the username --password=pass Set the password --cookie-file=filename Set the filename to use for persistent cookies --agent=agent Specify the UserAgent to pass --agent-alias=alias Specify the alias for the UserAgent to pass. Pick one of: * Windows IE 6 * Windows Mozilla * Mac Safari * Mac Mozilla * Linux Mozilla * Linux Konqueror --absolute Show URLs as absolute, even if relative in the page --help Show this message The order of the options specified is relevant. Repeated options get repeated dumps. C will only work on HTML documents when used on remote URLs, but will assume any local file you pass it is HTML. If it is not, there won't be any usable results. Proxy settings are specified through the environment (e.g. C). See L for details. =head1 SEE ALSO L =head1 AUTHOR Andy Lester =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2004 by Andy Lester. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut area_link.html100644001750001750 126715076225326 16224 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Testing AREA tag handling Mark Stosberg's homepage find_link.html100644001750001750 411515076225326 16227 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Testing the links blargle CPAN A CPAN B CPAN C CPAN D MSNBC CNN BBC News News News Rebuild Index NoWhere NoWhere Blongo! Click Here find_link_id.t100644001750001750 233115076225326 16200 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More 'no_plan'; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/find_link_id.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; FIND_BY_ID: { my $x = $mech->find_link( id => 'signature' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->url, 'signature.html', 'found link with given ID' ); } FIND_BY_CLASS: { my $x = $mech->find_link( tag => 'iframe', class => 'smart_iframe' ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->url, 'http://boo.xyz.com/boo_app', 'found link within "iframe" with given class' ); } FIND_ID_BY_REGEX: { my $x = $mech->find_link( id_regex => qr/^sig/ ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->url, 'signature.html', 'found link with ID matching a regex' ); } FIND_CLASS_BY_REGEX: { my $x = $mech->find_link( tag => 'iframe', class_regex => qr/IFRAME$/i ); isa_ok( $x, 'WWW::Mechanize::Link' ); is( $x->url, 'http://boo.xyz.com/boo_app', 'found link with class matching a regex' ); } form-parsing.t100644001750001750 74015076225326 16155 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use strict; use warnings; use Test::More tests => 1; use HTML::Form (); my $base = 'http://localhost/'; my $content = do { local $/ = undef; }; my $forms = [ HTML::Form->parse( $content, $base ) ]; is( scalar @{$forms}, 1, 'Find one form, please' ); __DATA__ WWW::Mechanize::Shell test page
history_1.html100644001750001750 23615076225326 16173 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Testing the history_1 To second page history_2.html100644001750001750 53415076225326 16175 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Testing the history_2
history_3.html100644001750001750 23515076225326 16174 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t Testing the history_3 To first page follow.t100644001750001750 521715076225326 16171 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More; use Test::Fatal qw( dies_ok ); use Test::Warnings qw(warning); use lib 't/local'; use LocalServer (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $agent = WWW::Mechanize->new( autocheck => 0 ); isa_ok( $agent, 'WWW::Mechanize', 'Created object' ); $agent->quiet(1); my $response; $agent->get( $server->url ); ok( $agent->success, 'Got some page' ); is( $agent->uri, $server->url, 'Got local server page' ); $response = $agent->follow_link( n => 99999 ); ok( !$response, q{Can't follow too-high-numbered link} ); $response = $agent->follow_link( n => 1 ); isa_ok( $response, 'HTTP::Response', 'Gives a response' ); isnt( $agent->uri, $server->url, 'Need to be on a separate page' ); ok( $agent->back(), 'Can go back' ); is( $agent->uri, $server->url, 'Back at the first page' ); ok( !$agent->follow_link( text_regex => qr/asdfghjksdfghj/ ), "Can't follow unlikely named link" ); ok( $agent->follow_link( text => 'Link /foo' ), 'Can follow obvious named link' ); isnt( $agent->uri, $server->url, 'Need to be on a separate page' ); ok( $agent->back(), 'Can still go back' ); ok( $agent->follow_link( text_regex => qr/L\x{f6}schen/ ), 'Can follow link with o-umlaut' ); isnt( $agent->uri, $server->url, 'Need to be on a separate page' ); ok( $agent->back(), 'Can still go back' ); ok( $agent->follow_link( text_regex => qr/St\x{f6}sberg/ ), q{Can follow link with o-umlaut, when it's encoded in the HTML, but not in "follow"} ); isnt( $agent->uri, $server->url, 'Need to be on a separate page' ); ok( $agent->back(), 'Can still go back' ); is( $agent->uri, $server->url, 'Back at the start page again' ); $response = $agent->follow_link( text_regex => qr/Snargle/ ); ok( !$response, q{Couldn't find it} ); ok( $agent->follow_link( url => '/foo' ), 'can follow url' ); isnt( $agent->uri, $server->url, 'Need to be on a separate page' ); ok( $agent->back(), 'Can still go back' ); $agent->quiet(0); like warning { $agent->follow_link( n => 'all' ) }, qr/^follow_link\(.*?\) is not valid/, "Can we follow all links?"; ok( $agent->back(), 'Can still go back' ); ok( !$agent->follow_link( url => '/notfoo' ), "can't follow wrong url" ); is( $agent->uri, $server->url, 'Needs to be on the same page' ); eval { $agent->follow_link('/foo') }; like( $@, qr/Needs to get key-value pairs of parameters.*follow\.t/, "Invalid parameter passing gets better error message" ); dies_ok { WWW::Mechanize->new->follow_link( url => '/404' ) } "dies when link does not exist with autocheck"; done_testing; reload.t100644001750001750 245115076225326 16132 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More tests => 15; use lib qw( t/local ); use LocalServer (); use Test::Memory::Cycle; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $agent = WWW::Mechanize->new; isa_ok( $agent, 'WWW::Mechanize', 'Created object' ); NO_GET: { my $r = $agent->reload; ok( !defined($r), 'Initial reload should fail' ); } FIRST_GET: { my $r = $agent->get( $server->url ); isa_ok( $r, 'HTTP::Response' ); ok( $r->is_success, 'Get google webpage' ); ok( $agent->is_html, 'Valid HTML' ); is( $agent->title, 'WWW::Mechanize test page' ); } INVALIDATE: { undef $agent->{content}; undef $agent->{ct}; isnt( $agent->title, 'WWW::Mechanize test page' ); ok( !$agent->is_html, 'Not HTML' ); } RELOAD: { my $r = $agent->reload; isa_ok( $r, 'HTTP::Response' ); ok( $agent->is_html, 'Valid HTML' ); ok( $agent->title, 'WWW::Mechanize test page' ); my $cookie_before = $agent->history(0)->{req}->header('Cookie'); $agent->reload; my $cookie_after = $agent->history(0)->{req}->header('Cookie'); is( $cookie_after, $cookie_before, 'cookies are not multiplied' ); } memory_cycle_ok( $agent, 'Mech: no cycles' ); submit.t100644001750001750 213015076225326 16161 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use lib qw( t/local ); use Test::More tests => 13; use LocalServer (); use Test::Memory::Cycle; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $mech = WWW::Mechanize->new(); isa_ok( $mech, 'WWW::Mechanize', 'Created the object' ) or die; my $response = $mech->get( $server->url ); isa_ok( $response, 'HTTP::Response', 'Got back a response' ) or die; is( $mech->uri, $server->url, 'Got the correct page' ); ok( $response->is_success, 'Got local page' ) or die 'cannot even fetch local page'; ok( $mech->is_html, 'is HTML' ); is( $mech->value('upload'), q{}, 'Hopefully no upload happens' ); $mech->field( query => 'foo' ); # Filled the 'q' field $response = $mech->submit; isa_ok( $response, 'HTTP::Response', 'Got back a response' ); ok( $response->is_success, 'Can click "submit" ("submit" button)' ); like( $mech->content, qr/\bfoo\b/i, 'Found "Foo"' ); is( $mech->value('upload'), q{}, 'No upload happens' ); memory_cycle_ok( $mech, 'Mech: no cycles' ); save_content.t100644001750001750 244215076225326 16262 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 8; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $original = 't/find_inputs.html'; my $saved = 'saved1.test.txt'; my $uri = URI::file->new_abs($original)->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; #unlink $saved; ok( !-e $saved, "$saved does not exist" ); $mech->save_content($saved); my $old_text = slurp($original); my $new_text = slurp($saved); ok( $old_text eq $new_text, 'Saved copy matches the original' ) && unlink $saved; { my $original = 't/save_content.html'; my $saved = 'saved2.test.txt'; my $uri = URI::file->new_abs($original)->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; #unlink $saved; ok( !-e $saved, "$saved does not exist" ); $mech->save_content( $saved, binary => 1 ); my $old_text = slurp($original); my $new_text = slurp($saved); ok( $old_text eq $new_text, 'Saved copy matches the original' ) && unlink $saved; } sub slurp { my $name = shift; open( my $fh, '<', $name ) or die "Can't open $name: $!\n"; return join q{}, <$fh>; } contrib000755001750001750 015076225326 14440 5ustar00olafolaf000000000000WWW-Mechanize-2.20README.md100644001750001750 31715076225326 16040 0ustar00olafolaf000000000000WWW-Mechanize-2.20/contrib# Other Content ## Command Completion ### Installation For Bash: Copy the completion script to operating system specific folder, e.g. * /usr/share/bash-completion/completions/ * /etc/bash_completion.d find_frame.html100644001750001750 41315076225326 16341 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t find some frames image-parse.css100644001750001750 26015076225326 16265 0ustar00olafolaf000000000000WWW-Mechanize-2.20/tbody { background-color:white; background-image:url(/Images/bg-gradient.png); } .logo { background: url("images/logo.png") no-repeat; background-size: 275px 95px; } link-relative.t100644001750001750 113015076225326 16331 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t#!perl use warnings; use strict; use Test::More tests => 6; use URI::file (); BEGIN { use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new( cookie_jar => undef ); isa_ok( $mech, 'WWW::Mechanize' ); my $uri = URI::file->new_abs('t/image-parse.html')->as_string; $mech->get($uri); ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page}; $mech->get('select.html'); ok( $mech->success, 'Fetch select.html, no directory' ); $mech->get('./select.html'); ok( $mech->success, 'Fetch select.html from ./' ); $mech->get('local/click.t'); ok( $mech->success, 'Fetched click.t' ); content.t100644001750001750 202215076225326 16330 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use lib 't/local'; use LocalServer (); use Test::More tests => 10; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } my $mech = WWW::Mechanize->new(); isa_ok( $mech, 'WWW::Mechanize', 'Created the object' ); my $server = LocalServer->spawn(); isa_ok( $server, 'LocalServer' ); diag( 'Running tests against ' . $server->url . '?xml=1' ); my $response = $mech->get( $server->url . '?xml=1' ); isa_ok( $response, 'HTTP::Response', 'Got back a response' ); ok( $response->is_success, 'Got URL' ) or die q{Can't even fetch local url}; is( $response->content_type, 'application/xhtml+xml', 'Content type is application/xhtml+xml' ); ok( $mech->is_html, 'Local page is HTML' ); $mech->field( query => 'foo' ); # Filled the 'q' field $response = $mech->click('submit'); isa_ok( $response, 'HTTP::Response', 'Got back a response' ); ok( $response->is_success, q{Can click 'Go' ('Google Search' button)} ); is( $mech->field('query'), 'foo', 'Filled field correctly' ); failure.t100644001750001750 311615076225326 16312 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use Test::More; use lib 't/local'; use LocalServer (); BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; } my $NONEXISTENT = 'blahblahblah.xx-only-testing.foo.'; my @results = gethostbyname($NONEXISTENT); if (@results) { my ( $name, $aliases, $addrtype, $length, @addrs ) = @results; my $ip = join( '.', unpack( 'C4', $addrs[0] ) ); plan skip_all => "Your ISP is overly helpful and returns $ip for non-existent domain $NONEXISTENT. This test cannot be run."; } my $bad_url = "http://$NONEXISTENT/"; plan tests => 15; require_ok('WWW::Mechanize'); my $server = LocalServer->spawn; isa_ok( $server, 'LocalServer' ); my $mech = WWW::Mechanize->new( autocheck => 0 ); isa_ok( $mech, 'WWW::Mechanize', 'Created object' ); GOOD_PAGE: { my $response = $mech->get( $server->url ); isa_ok( $response, 'HTTP::Response' ); ok( $response->is_success, 'Success' ); ok( $mech->success, 'Get webpage' ); ok( $mech->is_html, 'It\'s HTML' ); is( $mech->title, 'WWW::Mechanize test page', 'Correct title' ); my @links = $mech->links; is( scalar @links, 10, '10 links, please' ); my @forms = $mech->forms; is( scalar @forms, 5, 'Many form' ); } BAD_PAGE: { my $bad_url = "http://$NONEXISTENT/"; $mech->get($bad_url); ok( !$mech->success, 'Failed the fetch' ); ok( !$mech->is_html, "Isn't HTML" ); ok( !defined $mech->title, "No title" ); my @links = $mech->links; is( scalar @links, 0, "No links" ); my @forms = $mech->forms; is( scalar @forms, 0, "No forms" ); } referer.t100644001750001750 402715076225326 16317 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t/localuse warnings; use strict; use FindBin (); use Test::More tests => 14; use Test::Memory::Cycle; BEGIN { delete @ENV{qw( IFS CDPATH ENV BASH_ENV )}; use_ok('WWW::Mechanize'); } our $server; my $agent = WWW::Mechanize->new(); isa_ok( $agent, 'WWW::Mechanize' ); SKIP: { # We want to be safe from non-resolving local host names delete $ENV{HTTP_PROXY}; # Now start a fake webserver, fork, and connect to ourselves my $command = qq'"$^X" "$FindBin::Bin/referer-server"'; if ( $^O eq 'VMS' ) { $command = qq'mcr $^X t/referer-server'; } open $server, "$command |" or die "Couldn't spawn fake server: $!"; sleep 1; # give the child some time my $url = <$server>; chomp $url; $agent->get($url); is( $agent->status, 200, 'Got first page' ) or diag $agent->res->message; is( $agent->content, q{Referer: ''}, 'First page gets sent with empty referrer' ); $agent->get($url); is( $agent->status, 200, 'Got second page' ) or diag $agent->res->message; is( $agent->content, "Referer: '$url'", 'Referer got sent for absolute url' ); $agent->get('.'); is( $agent->status, 200, 'Got third page' ) or diag $agent->res->message; is( $agent->content, "Referer: '$url'", 'Referer got sent for relative url' ); $agent->add_header( Referer => 'x' ); $agent->get($url); is( $agent->status, 200, 'Got fourth page' ) or diag $agent->res->message; is( $agent->content, q{Referer: 'x'}, 'Referer can be set to empty again' ); my $ref = 'This is not the referer you are looking for *jedi gesture*'; $agent->add_header( Referer => $ref ); $agent->get($url); is( $agent->status, 200, 'Got fourth page' ) or diag $agent->res->message; is( $agent->content, "Referer: '$ref'", 'Custom referer can be set' ); $agent->get( $url . 'quit_server' ); ok( $agent->success, 'Quit OK' ); } memory_cycle_ok( $agent, 'No memory cycles found' ); END { close $server if $server; } file_upload.html100644001750001750 24415076225326 16534 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t
find_inputs.html100644001750001750 161515076225326 16616 0ustar00olafolaf000000000000WWW-Mechanize-2.20/t