Bug 9259: Use is instead of is_deeply
[koha.git] / t / smolder_smoke_signal
1 #!/usr/bin/perl
2
3 # This file was copied from the smolder distribution and modified.
4 # the copyright and license from the original distribution are
5 # included below.
6
7 # Copyright (c) 2007, Michael Peters
8 # All rights reserved.
9
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
12 # are met:
13
14 #     * Redistributions of source code must retain the above copyright
15 #     notice, this list of conditions and the following disclaimer.
16
17 #     * Redistributions in binary form must reproduce the above copyright
18 #     notice, this list of conditions and the following disclaimer in the
19 #     documentation and/or other materials provided with the distribution.
20
21 #     * Neither the name of the Smolder nor the names of its
22 #     contributors may be used to endorse or promote products derived from
23 #     this software without specific prior written permission.
24
25 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
26 # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
27 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
28 # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
29 # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
30 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
31 # TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
32 # PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
33 # LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
34 # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
35 # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36
37
38 use strict;
39 use warnings;
40 use Getopt::Long;
41 use Pod::Usage;
42 use File::Spec::Functions qw(catdir catfile splitdir);
43 use File::Basename;
44
45 BEGIN {
46     eval { require WWW::Mechanize };
47     if( $@ ) {
48         warn "\nCannot load WWW::Mechanize. " .
49             "\nPlease install it before using smolder_smoke_signal.\n";
50         exit(1);
51     }
52 }
53
54 =pod
55
56 =head1 NAME
57
58 smolder_smoke_signal
59
60 =head1 SYNOPSIS
61
62     ./bin/smolder_smoke_signal --server smolder.foo.com \
63         --username myself --password s3cr3t --file test_report.xml \
64         --project MyProject
65
66 =head1 DESCRIPTION
67
68 Script used to upload a Smoke test report to a running smolder server.
69 This is extremely useful for scripted/automatic test runs but also
70 helpful when using a CLI makes things faster.
71
72 =head1 OPTIONS
73
74 =head2 REQUIRED
75
76 =over
77
78 =item server
79
80 This is the hostname (and port if not 80) of the running Smolder server.
81
82 =item project
83
84 The name of the Smolder project to use for the upload.
85
86 =item file
87
88 The name of the file to upload. Please see F<docs/upload_file_format.pod>
89 for more details about the format that Smolder expects this file to
90 take.
91
92 =back
93
94 =head2 OPTIONAL
95
96 =over
97
98 =item username
99
100 The name of the Smolder user to use for the upload.
101
102 =item password
103
104 The password for the Smolder user given by C<username>.
105
106 =item anonymous
107
108 This option takes no arguments and indicates that the report should be
109 submitted anonymously to a public project. Either the anonymous option
110 is required or C<username> and C<password> are required.
111
112 =item architecture
113
114 The architecture for the given smoke test run. If none is given
115 it will use the default architecture for the project.
116
117 =item platform
118
119 The platform for the given smoke test run. If none is given
120 it will use the default platform for the project.
121
122 =item tags
123
124 A comma separated list of tags that are given for this smoke report run.
125
126     ./bin/smolder_smoke_signal --server smolder.foo.com \
127         --username myself --password s3cr3t --file test_report.xml \
128         --project MyProject --tags "Foo, My Bar"
129
130 =item comments
131
132 Any comments that you want to associate with the smoke test run.
133
134 =item verbose
135
136 Print verbose output of our actions to STDOUT.
137
138 =cut
139
140 # default options
141 our ( $server, $project, $user, $pw, $anonymous, $file, $arch, $platform, $tags, $comments, $verbose );
142 my ( $help, $man );
143
144 GetOptions(
145     'server=s'       => \$server,
146     'project=s'      => \$project,
147     'username=s'     => \$user,
148     'password=s'     => \$pw,
149     'anonymous'      => \$anonymous,
150     'file=s'         => \$file,
151     'architecture=s' => \$arch,
152     'platform=s'     => \$platform,
153     'tags=s'         => \$tags,
154     'comments=s'     => \$comments,
155     'verbose!'       => \$verbose,
156     'help'           => \$help,
157     'man'            => \$man,
158   )
159   || pod2usage();
160
161 if ($help) {
162     pod2usage(
163         -exitval => 0,
164         -verbose => 1,
165     );
166 } elsif ($man) {
167     pod2usage(
168         -exitval => 0,
169         -verbose => 2,
170     );
171 }
172
173 # make sure all the required fields are there
174 _missing_required('server')   unless $server;
175 _missing_required('project')  unless $project;
176 _missing_required('username') unless $user or $anonymous;
177 _missing_required('password') unless $pw   or $anonymous;
178 _missing_required('file')     unless $file;
179
180 # make sure our file is there and is of the right type
181 if ( -r $file ) {
182     unless( $file =~ /\.tar(\.gz)?$/ ) {
183         warn "File '$file' is not of the correct type!\n";
184         exit(1);
185     }
186 } else {
187     warn "File '$file' does not exist, or is not readable!\n";
188     exit(1);
189 }
190
191 # try and reach the smolder server
192 print "Trying to reach Smolder server at $server.\n" if ($verbose);
193 my $mech     = WWW::Mechanize->new();
194 my $base_url = "http://$server/app";
195 $mech->get($base_url);
196 unless ( $mech->status eq '200' ) {
197     warn "Could not reach $server successfully. Received status " . $mech->status . "\n";
198     exit(1);
199 }
200
201 my $content; # holds the content of the current page from $mech
202 if ( $user ) {
203 # now login
204     print "Trying to login with username '$user'.\n" if ($verbose);
205     $mech->get( $base_url . '/public_auth/login' );
206     my $form = $mech->form_name('login');
207     if ( $mech->status ne '200' || !$form ) {
208         warn "Could not reach Smolder login form. Are you sure $server is a Smolder server?\n";
209         exit(1);
210     }
211     $mech->set_fields(
212                       username => $user,
213                       password => $pw,
214                   );
215     $mech->submit();
216     $content = $mech->content;
217     if ( $mech->status ne '200' || $content !~ /Welcome \Q$user\E/ ) {
218         warn "Could not login with username '$user' and password '$pw'!\n";
219         exit(1);
220     }
221 }
222
223 # now go to this project's page
224 printf( "Retrieving project listing for %s\n", $user ? "user '$user'" : 'anonymous' ) if ($verbose);
225 $mech->get( $base_url . _url_base() );
226 $content = $mech->content;
227 $content =~ />\Q$project\E<!--ID:(\d+)-->/;
228 my $project_id = $1;
229 if ( $mech->status ne '200' || !$project_id ) {
230     warn
231       "Could not get your project listing, or you are not a member of the '$project' project!\n";
232     exit(1);
233 }
234
235 # now go to the add-smoke-report page for this project
236 print "Adding smoke report to project '$project' (id: #$project_id).\n" if ($verbose);
237 $mech->get( $base_url . _url_base() . "/add_report/$project_id" );
238 $content = $mech->content;
239 if ( $mech->status ne '200' || $content !~ /New Smoke Report/ ) {
240     warn "Could not reach the Add Smoke Report form!\n";
241     exit(1);
242 }
243 $mech->form_name('add_report');
244 my %fields = (report_file => $file);
245 $fields{platform}     = $platform if ($platform);
246 $fields{architecture} = $arch     if ($arch);
247 $fields{tags}         = $tags     if ($tags);
248 $fields{comments}     = $comments if ($comments);
249 $mech->set_fields(%fields);
250 $mech->submit();
251
252 $content = $mech->content;
253 if ( $mech->status ne '200' || $content !~ /Recent Smoke Reports/ ) {
254     warn "Could not upload smoke report with the given information!\n";
255     exit(1);
256 }
257 $content =~ /#(\d+) Added/;
258 my $report_id = $1;
259
260 print "\nReport successfully uploaded as #$report_id.\n";
261
262 ##########################################################
263 # helper methods
264 ##########################################################
265 sub _missing_required {
266     my $field = shift;
267     warn "Missing required field '$field'!\n";
268     pod2usage();
269 }
270
271 # returns the piece of the URL that points to the appropriate part of
272 # the URL structure based on whether this is an anonymous submission
273 sub _url_base {
274     if ( $anonymous ) {
275         return '/public_projects';
276     } else {
277         return '/developer_projects';
278     }
279 }