1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
#!/usr/bin/perl -w
use strict;
use lib './inc';
use IO::Catch;
our $_STDOUT_;
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
# Disable all ReadLine functionality
$ENV{PERL_RL} = 0;
delete $ENV{PAGER}
if $ENV{PAGER};
$ENV{PERL_HTML_DISPLAY_CLASS}="HTML::Display::Dump";
use Test::More tests => 8;
use_ok('WWW::Mechanize::Shell');
my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
isa_ok $s, 'WWW::Mechanize::Shell';
sub cleanup() {
# clean up $_STDOUT_ so it fits on one line
#diag $_STDOUT_;
$_STDOUT_ =~ s/[\r\n]+/|/g;
$_STDOUT_ =~ s!(?<=:)(\s+)!(">" x (length($1)/2))!eg;
};
SKIP: {
$s->agent->{base} = 'http://example.com';
$s->agent->update_html(<<HTML);
<html>
<head><base href="http://example.com" />
<title>An HTML page</title>
</head>
<body>
<h1>(H1.1)</h1>
<h2>(H2)</h2>
<h3>(H3.1)</h3>
<h3>(H3.2)</h3>
<h4>(H4)</h4>
<h1>(H1.2)</h1>
<h5>(H5)</h5>
<h1></h1>
<h1> Some spaces before this</h1>
<h1>
A newline in
this</h1>
<h2>
<h3>
</body>
</html>
HTML
$s->cmd('headers');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:<no text>|h1:Some spaces before this|h1:A newline in this|h2:><empty tag>|h3:>><empty tag>|", "The default works");
undef $_STDOUT_;
$s->cmd('headers 12345');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h4:>>>(H4)|h1:(H1.2)|h5:>>>>(H5)|h1:<no text>|h1:Some spaces before this|h1:A newline in this|h2:><empty tag>|h3:>><empty tag>|", "Explicitly specifying the default works as well");
undef $_STDOUT_;
$s->cmd('headers 1');
cleanup;
is($_STDOUT_,"h1:(H1.1)|h1:(H1.2)|h1:<no text>|h1:Some spaces before this|h1:A newline in this|", "H1 headers works as well");
undef $_STDOUT_;
$s->cmd('headers 23');
cleanup;
is($_STDOUT_,"h2:>(H2)|h3:>>(H3.1)|h3:>>(H3.2)|h2:><empty tag>|h3:>><empty tag>|", "Restricting to a subset works too");
undef $_STDOUT_;
$s->cmd('headers 25');
cleanup;
is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:><empty tag>|", "A noncontingous subset as well");
undef $_STDOUT_;
$s->cmd('headers 52');
cleanup;
is($_STDOUT_,"h2:>(H2)|h5:>>>>(H5)|h2:><empty tag>|", "Even in a weirdo order");
undef $_STDOUT_;
};
|
