line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::Mailman; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
157611
|
use warnings; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
196
|
|
4
|
5
|
|
|
5
|
|
28
|
use strict; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
184
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
27
|
use Carp; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
456
|
|
7
|
5
|
|
|
5
|
|
5137
|
use URI; |
|
5
|
|
|
|
|
46979
|
|
|
5
|
|
|
|
|
190
|
|
8
|
5
|
|
|
5
|
|
9049
|
use WWW::Mechanize; |
|
5
|
|
|
|
|
1075562
|
|
|
5
|
|
|
|
|
277
|
|
9
|
5
|
|
|
5
|
|
6882
|
use HTTP::Cookies; |
|
5
|
|
|
|
|
48156
|
|
|
5
|
|
|
|
|
684
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '1.06'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my @attributes = qw( |
14
|
|
|
|
|
|
|
secure server prefix program list |
15
|
|
|
|
|
|
|
email password moderator_password admin_password |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my %default = ( program => 'mailman' ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $action_re = qr/^(?:admin(?:db)?|edithtml|listinfo|options|private)$/; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# |
23
|
|
|
|
|
|
|
# ACCESSORS / MUTATORS |
24
|
|
|
|
|
|
|
# |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# generic accessors |
27
|
|
|
|
|
|
|
for my $attr (@attributes) { |
28
|
5
|
|
|
5
|
|
56
|
no strict 'refs'; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
14518
|
|
29
|
|
|
|
|
|
|
*{$attr} = sub { |
30
|
97
|
|
|
97
|
|
1877
|
my $self = shift; |
31
|
97
|
100
|
100
|
|
|
601
|
return defined $self->{$attr} ? $self->{$attr} : $default{$attr} || '' |
|
|
100
|
|
|
|
|
|
32
|
|
|
|
|
|
|
if !@_; |
33
|
21
|
|
|
|
|
71
|
return $self->{$attr} = shift; |
34
|
|
|
|
|
|
|
}; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# specialized accessors |
38
|
|
|
|
|
|
|
sub uri { |
39
|
7
|
|
|
7
|
1
|
106
|
my ( $self, $uri ) = @_; |
40
|
7
|
100
|
|
|
|
37
|
if ($uri) { |
41
|
6
|
|
|
|
|
31
|
$uri = URI->new($uri); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# @segments = @prefix, $program, $action, $list, @suffix |
44
|
6
|
|
|
|
|
14240
|
my $program = $self->program; |
45
|
6
|
|
|
|
|
51
|
my ( undef, @segments ) = $uri->path_segments; |
46
|
6
|
|
|
|
|
769
|
my @prefix; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# the program name is found in the url |
49
|
6
|
100
|
|
|
|
45
|
if( grep $_ eq $program, @segments ) { |
|
|
100
|
|
|
|
|
|
50
|
4
|
|
66
|
|
|
42
|
push @prefix, shift @segments |
51
|
|
|
|
|
|
|
while @segments && $segments[0] ne $program; |
52
|
4
|
|
|
|
|
9
|
shift @segments; # drop the program name |
53
|
4
|
100
|
|
|
|
21
|
croak "Invalid URL $uri: no action" |
54
|
|
|
|
|
|
|
if !shift @segments; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# try to autodetect the program name |
58
|
|
|
|
|
|
|
elsif( grep $_ =~ $action_re, @segments ) { |
59
|
1
|
|
66
|
|
|
18
|
push @prefix, shift @segments |
60
|
|
|
|
|
|
|
while @segments && $segments[0] !~ $action_re; |
61
|
1
|
|
|
|
|
4
|
$self->program( pop @prefix ); # get the program name |
62
|
1
|
|
|
|
|
1
|
shift @segments; # drop the action name |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# declare FAIL |
66
|
|
|
|
|
|
|
else { |
67
|
1
|
|
|
|
|
5
|
croak "Invalid URL $uri: no program segment found ($program)"; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# just keep the bits we need |
71
|
4
|
|
|
|
|
30
|
$self->server( $uri->host ); |
72
|
4
|
|
|
|
|
35
|
$self->secure( $uri->scheme eq 'https' ); |
73
|
4
|
|
|
|
|
28
|
$self->userinfo( $uri->userinfo ); |
74
|
4
|
|
|
|
|
20
|
$self->prefix( join '/', @prefix ); |
75
|
4
|
|
|
|
|
16
|
$self->list( shift @segments ); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# create a generic listinfo URL |
79
|
|
|
|
|
|
|
else { |
80
|
1
|
|
|
|
|
5
|
$uri = $self->_uri_for('listinfo'); |
81
|
|
|
|
|
|
|
} |
82
|
5
|
|
|
|
|
50
|
return $uri; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
sub userinfo { |
86
|
36
|
|
|
36
|
1
|
466
|
my $self = shift; |
87
|
36
|
100
|
|
|
|
177
|
return defined $self->{userinfo} ? $self->{userinfo} : '' if !@_; |
|
|
100
|
|
|
|
|
|
88
|
13
|
|
|
|
|
32
|
$self->{userinfo} = my $userinfo = shift; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# update the credentials stored in the robot |
91
|
13
|
50
|
|
|
|
111
|
if ( $self->robot ) { |
92
|
13
|
50
|
|
|
|
32
|
if ($userinfo) { |
93
|
0
|
|
|
|
|
0
|
$self->robot->credentials( split /:/, $userinfo, 2 ); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
else { |
96
|
13
|
|
|
|
|
33
|
$self->robot->clear_credentials(); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
13
|
|
|
|
|
75
|
return $userinfo; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub robot { |
104
|
47
|
|
|
47
|
1
|
31637
|
my $self = shift; |
105
|
47
|
100
|
|
|
|
330
|
return defined $self->{robot} ? $self->{robot} : '' if !@_; |
|
|
100
|
|
|
|
|
|
106
|
9
|
|
|
|
|
29
|
$self->{robot} = shift; |
107
|
9
|
|
|
|
|
35
|
$self->userinfo( $self->userinfo ); # update credentials |
108
|
9
|
|
|
|
|
31
|
return $self->{robot}; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
push @attributes, qw( uri userinfo robot ); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# |
114
|
|
|
|
|
|
|
# CONSTRUCTOR |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub new { |
118
|
11
|
|
|
11
|
1
|
6802
|
my ( $class, %args ) = @_; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# create the object |
121
|
11
|
|
|
|
|
38
|
my $self = bless {}, $class; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# get the rest of attributes |
124
|
132
|
|
|
|
|
326
|
$self->$_( delete $args{$_} ) |
125
|
11
|
|
|
|
|
37
|
for grep { exists $args{$_} } @attributes; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# bring in the robot if needed |
128
|
9
|
100
|
|
|
|
39
|
if ( !$self->robot ) { |
129
|
8
|
|
|
|
|
66
|
my %mech_options = ( |
130
|
|
|
|
|
|
|
agent => "WWW::Mailman/$VERSION", |
131
|
|
|
|
|
|
|
stack_depth => 2, # make it a Bear of Very Little Brain |
132
|
|
|
|
|
|
|
quiet => 1, |
133
|
|
|
|
|
|
|
autocheck => 0, # Fancy my making a mistake like that |
134
|
|
|
|
|
|
|
); |
135
|
8
|
100
|
|
|
|
45
|
$mech_options{cookie_jar} = HTTP::Cookies->new( |
136
|
|
|
|
|
|
|
file => delete $args{cookie_file}, |
137
|
|
|
|
|
|
|
ignore_discard => 1, # Promise me you'll never forget me |
138
|
|
|
|
|
|
|
autosave => 1, |
139
|
|
|
|
|
|
|
) if exists $args{cookie_file}; |
140
|
8
|
|
|
|
|
181
|
$self->robot( WWW::Mechanize->new(%mech_options) ); |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# some unknown parameters remain |
144
|
9
|
100
|
|
|
|
81
|
croak "Unknown constructor parameters: @{ [ keys %args ] }" |
|
1
|
|
|
|
|
289
|
|
145
|
|
|
|
|
|
|
if keys %args; |
146
|
|
|
|
|
|
|
|
147
|
8
|
|
|
|
|
31
|
return $self; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# |
151
|
|
|
|
|
|
|
# PRIVATE METHODS |
152
|
|
|
|
|
|
|
# |
153
|
|
|
|
|
|
|
sub _uri_for { |
154
|
13
|
|
|
13
|
|
6806
|
my ( $self, $action, @options ) = @_; |
155
|
13
|
|
|
|
|
60
|
my $uri = URI->new(); |
156
|
13
|
100
|
|
|
|
7243
|
$uri->scheme( $self->secure ? 'https' : 'http' ); |
157
|
13
|
50
|
|
|
|
5961
|
$uri->userinfo( $self->userinfo ) |
158
|
|
|
|
|
|
|
if $self->userinfo; |
159
|
13
|
|
|
|
|
37
|
$uri->host( $self->server ); |
160
|
13
|
|
66
|
|
|
893
|
$uri->path( join '/', $self->prefix || (), |
161
|
|
|
|
|
|
|
$self->program, $action, $self->list, @options ); |
162
|
13
|
|
|
|
|
464
|
return $uri; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub _login_form { |
166
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
167
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# shortcut |
170
|
0
|
0
|
|
|
|
|
return if !$mech->forms; |
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my $form; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# login is required if the form asks for: |
175
|
|
|
|
|
|
|
# - a login/password |
176
|
0
|
0
|
|
|
|
|
if ( $form = $mech->form_with_fields('password') ) { |
|
|
0
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
$form->value( email => $self->email ); |
178
|
0
|
|
|
|
|
|
$form->value( password => $self->password ); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# - an admin (or moderator) password |
182
|
|
|
|
|
|
|
elsif ( $form = $mech->form_with_fields('adminpw') ) { |
183
|
0
|
|
0
|
|
|
|
$form->value( adminpw => $self->admin_password |
184
|
|
|
|
|
|
|
|| $self->moderator_password ); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# otherwise, no authentication required |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
return $form; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub _load_uri { |
193
|
0
|
|
|
0
|
|
|
my ( $self, $uri ) = @_; |
194
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
195
|
0
|
|
|
|
|
|
$mech->get($uri); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# authentication required? |
198
|
0
|
0
|
|
|
|
|
if ( my $form = $self->_login_form ) { |
199
|
0
|
|
|
|
|
|
$mech->request( $form->click ); |
200
|
0
|
0
|
|
|
|
|
croak "Couldn't login on $uri" if $self->_login_form; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# get the version if we don't have it yet |
204
|
0
|
0
|
0
|
|
|
|
$self->{version} = $1 |
205
|
|
|
|
|
|
|
if !exists $self->{version} |
206
|
|
|
|
|
|
|
&& $mech->content =~ / version (\d+\.\d+\.\d+\w*); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# we're on! |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# |
212
|
|
|
|
|
|
|
# INTERNAL UTILITY FUNCTIONS |
213
|
|
|
|
|
|
|
# |
214
|
|
|
|
|
|
|
sub _form_data { |
215
|
|
|
|
|
|
|
return { |
216
|
0
|
0
|
0
|
|
|
|
map { |
217
|
0
|
|
|
0
|
|
|
$_->type eq 'submit' || $_->readonly |
218
|
|
|
|
|
|
|
? () # ignore buttons and read-only inputs |
219
|
|
|
|
|
|
|
: ( $_->name => $_->value ) |
220
|
|
|
|
|
|
|
} $_[0]->inputs |
221
|
|
|
|
|
|
|
}; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# |
225
|
|
|
|
|
|
|
# ACTIONS |
226
|
|
|
|
|
|
|
# |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# The option form has 5 submit buttons, listed here with their inputs: |
229
|
|
|
|
|
|
|
# |
230
|
|
|
|
|
|
|
# * change-of-address: |
231
|
|
|
|
|
|
|
# - new-address |
232
|
|
|
|
|
|
|
# - confirm-address |
233
|
|
|
|
|
|
|
# - fullname |
234
|
|
|
|
|
|
|
# - changeaddr-globally |
235
|
|
|
|
|
|
|
# * unsub: |
236
|
|
|
|
|
|
|
# - unsubconfirm |
237
|
|
|
|
|
|
|
# * othersubs |
238
|
|
|
|
|
|
|
# * emailpw |
239
|
|
|
|
|
|
|
# * changepw: |
240
|
|
|
|
|
|
|
# - newpw |
241
|
|
|
|
|
|
|
# - confpw |
242
|
|
|
|
|
|
|
# - pw-globally |
243
|
|
|
|
|
|
|
# * options-submit: |
244
|
|
|
|
|
|
|
# - disablemail |
245
|
|
|
|
|
|
|
# - deliver-globally |
246
|
|
|
|
|
|
|
# - digest |
247
|
|
|
|
|
|
|
# - mime |
248
|
|
|
|
|
|
|
# - mime-globally |
249
|
|
|
|
|
|
|
# - dontreceive |
250
|
|
|
|
|
|
|
# - ackposts |
251
|
|
|
|
|
|
|
# - remind |
252
|
|
|
|
|
|
|
# - remind-globally |
253
|
|
|
|
|
|
|
# - conceal |
254
|
|
|
|
|
|
|
# - rcvtopic |
255
|
|
|
|
|
|
|
# - nodupes |
256
|
|
|
|
|
|
|
# - nodupes-globally |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# most routines will be identical, so generate them: |
259
|
|
|
|
|
|
|
{ |
260
|
|
|
|
|
|
|
my %options = ( |
261
|
|
|
|
|
|
|
address => 'change-of-address', |
262
|
|
|
|
|
|
|
unsub => 'unsub', |
263
|
|
|
|
|
|
|
changepw => 'changepw', |
264
|
|
|
|
|
|
|
options => 'options-submit', |
265
|
|
|
|
|
|
|
); |
266
|
|
|
|
|
|
|
while ( my ( $method, $button ) = each %options ) { |
267
|
5
|
|
|
5
|
|
55
|
no strict 'refs'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
4203
|
|
268
|
|
|
|
|
|
|
*$method = sub { |
269
|
0
|
|
|
0
|
|
|
my ( $self, $options ) = @_; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# select the options form |
272
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
273
|
0
|
|
0
|
|
|
|
$self->_load_uri( |
274
|
|
|
|
|
|
|
$self->_uri_for( 'options', $self->email || '' ) ); |
275
|
0
|
|
|
|
|
|
$mech->form_with_fields('fullname'); |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# change of options |
278
|
0
|
0
|
|
|
|
|
if ($options) { |
279
|
0
|
|
|
|
|
|
$mech->set_fields(%$options); |
280
|
0
|
|
|
|
|
|
$mech->click($button); |
281
|
0
|
|
|
|
|
|
$mech->form_with_fields('fullname'); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
return _form_data( $mech->current_form ); |
285
|
|
|
|
|
|
|
}; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# emailpw doesn't need any parameter |
290
|
|
|
|
|
|
|
sub emailpw { |
291
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# no auto-authenticate |
294
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
295
|
0
|
|
|
|
|
|
$mech->get( my $uri = $self->_uri_for( 'options', $self->email ) ); |
296
|
|
|
|
|
|
|
|
297
|
0
|
0
|
|
|
|
|
if ( $mech->form_with_fields('emailpw') ) { |
|
|
0
|
|
|
|
|
|
298
|
0
|
|
|
|
|
|
$mech->click('emailpw'); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
elsif ( $mech->form_with_fields('login-remind') ) { |
301
|
0
|
|
|
|
|
|
$mech->click('login-remind'); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
else { |
304
|
0
|
|
|
|
|
|
croak "Unable to find a password email form on $uri"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# othersubs needs some parsing to be useful |
309
|
|
|
|
|
|
|
sub othersubs { |
310
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
311
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
312
|
0
|
|
|
|
|
|
$self->_load_uri( $self->_uri_for( 'options', $self->email ) ); |
313
|
0
|
|
|
|
|
|
$mech->form_with_fields('fullname'); |
314
|
0
|
|
|
|
|
|
$mech->click('othersubs'); |
315
|
|
|
|
|
|
|
|
316
|
0
|
|
|
|
|
|
my $uri = $mech->uri; |
317
|
|
|
|
|
|
|
return |
318
|
0
|
|
|
|
|
|
map { URI->new_abs( $_, $uri ) } |
|
0
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
$mech->content =~ m{[^<]+}g; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub roster { |
323
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
324
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
325
|
0
|
|
|
|
|
|
$self->_load_uri( $self->_uri_for('roster') ); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# try to detect authentication issues [private_roster] |
328
|
0
|
0
|
|
|
|
|
if ( $mech->content !~ // ) { |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# authenticate through listinfo |
331
|
0
|
|
|
|
|
|
$mech->get( $self->_uri_for('listinfo') ); |
332
|
0
|
|
|
|
|
|
my $form = $mech->form_with_fields('roster-pw'); |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# in case the roster is reserved to admins, |
335
|
|
|
|
|
|
|
# we'll try the admin passwords first |
336
|
0
|
|
0
|
|
|
|
my $password = $self->admin_password || $self->moderator_password; |
337
|
0
|
0
|
|
|
|
|
$mech->set_fields( 'roster-email' => $self->email ) if !$password; |
338
|
0
|
|
0
|
|
|
|
$mech->set_fields( 'roster-pw' => $password || $self->password ); |
339
|
0
|
|
|
|
|
|
$mech->click('SubscriberRoster'); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
# subscriber list may be empty, e.g. for privacy reasons |
343
|
|
|
|
|
|
|
return |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# TODO: distinguishes types of subscribers |
346
|
0
|
|
|
|
|
|
map { s/ at /@/; $_ } # [obscure_addresses] |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
$mech->content =~ m{]*>([^<]*)}g; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# most admin routines will be identical... |
351
|
|
|
|
|
|
|
sub admin { |
352
|
0
|
|
|
0
|
1
|
|
my ( $self, $section, $options ) = @_; |
353
|
0
|
|
|
|
|
|
my $mech = $self->robot; |
354
|
0
|
|
|
|
|
|
$self->_load_uri( $self->_uri_for( admin => $section ) ); |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# get the main form |
357
|
0
|
|
|
|
|
|
$mech->form_number(1); |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# change of options |
360
|
0
|
0
|
|
|
|
|
if ($options) { |
361
|
0
|
|
|
|
|
|
$mech->current_form->accept_charset('iso-8859-1'); |
362
|
0
|
|
|
|
|
|
$mech->set_fields(%$options); |
363
|
0
|
|
|
|
|
|
$mech->click(); |
364
|
0
|
|
|
|
|
|
$mech->form_number(1); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
|
return _form_data( $mech->current_form ); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# so, use a bit of currying |
371
|
|
|
|
|
|
|
for my $section ( |
372
|
|
|
|
|
|
|
qw( |
373
|
|
|
|
|
|
|
general passwords language nondigest digest |
374
|
|
|
|
|
|
|
bounce archive gateway autoreply contentfilter topics |
375
|
|
|
|
|
|
|
) |
376
|
|
|
|
|
|
|
) |
377
|
|
|
|
|
|
|
{ |
378
|
5
|
|
|
5
|
|
40
|
no strict 'refs'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
820
|
|
379
|
0
|
|
|
0
|
|
|
*{"admin_$section"} = sub { shift->admin( "$section", @_ ) } |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub version { |
383
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
384
|
0
|
0
|
|
|
|
|
return $self->{version} if exists $self->{version}; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
# get it as part of a page download |
387
|
0
|
|
|
|
|
|
$self->_load_uri( $self->_uri_for('listinfo') ); |
388
|
0
|
|
|
|
|
|
return $self->{version}; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
1; |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
__END__ |