forked from tdf/www-bugassistant
-
Notifications
You must be signed in to change notification settings - Fork 0
/
bugzilla.pl
executable file
·162 lines (132 loc) · 4.71 KB
/
bugzilla.pl
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
#!/usr/bin/perl -w
# This file is part of the LibreOffice BSA project.
#
# 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 3 of the License, 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 <http:www.gnu.org/licenses/>.
use strict;
use lib qw(lib);
use Scalar::Util qw(looks_like_number);
use File::Basename qw(dirname);
use File::Spec;
use HTTP::Cookies;
use XMLRPC::Lite;
# URI Bugzilla
my $Bugzilla_uri = "https://bugs.freedesktop.org/xmlrpc.cgi";
=head2 Connect to Bugzilla
Connect to the URI in $Bugzilla_uri
The call will return a XMLRPC::Lite-object
=cut
sub BzConnect {
my $cookie_jar = new HTTP::Cookies('file' => File::Spec->catdir(dirname($0), 'cookies.txt'), 'autosave' => 1);
my $bz = XMLRPC::Lite->proxy($Bugzilla_uri, 'cookie_jar' => $cookie_jar);
}
=head2 Find Unconfirmed Bugs for a Module
The call requires a XMLRPC::Lite-object that has the connection-information to the bugzilla
The call requires the name for a module
The call requires the versions to ask
The call will return a array with bugs or will fail
=cut
sub BzFindUnconfirmedBugsPerModulePerVersionIncludeFields {
my ($bz, $component, @versions, @fields) = @_;
# print STDERR @versions."\n\n";
my $soapresult = $bz->call('Bug.search',
{ product => "LibreOffice",
status => "UNCONFIRMED",
component => $component,
version => [ @versions ],
include_fields => [ @fields ] } );
_die_on_fault($soapresult);
return @{$soapresult->result->{bugs}};
}
=head2 Find the modules in bugzilla for the LibreOffice Product
The call requires a XMLRPC::Lite-object that has the connection-information to the bugzilla
The call will return a array with modules or will fail
=cut
sub BzFindModules {
my ($bz) = @_;
return _find_values_for_field($bz, "component", 1);
}
=head2 Find the versions in bugzilla for the LibreOffice Product
The call requires a XMLRPC::Lite-object that has the connection-information to the bugzilla
The call will return a array with versions or will fail
=cut
sub BzFindVersions {
my($bz) = @_;
return _find_values_for_field($bz, "version", 1);
}
=head2 Find the operating systems in bugzilla for the LibreOffice Product
The call requires a XMLRPC::Lite-object that has the connection-information to the bugzilla
The call will return a array with operating systems or will fail
=cut
sub BzFindOperatingSystems {
my($bz) = @_;
return _find_values_for_field($bz, "op_sys", 0);
}
=head2 Get Attachments of Bug
The call requires a XMLRPC::Lyyite-object that has the connection-information to the bugzilla
The call requires a array of id's to get the attachments from
The call will return a hash with therein array's with the attachments
=cut
sub bzGetAttachmentsOfBugs{
my($bz, @bugNumbers)= @_;
my $attachmentidresult = $bz->call('Bug.attachments',
{ids => [ @bugNumbers ] });
_die_on_fault($attachmentidresult);
return $attachmentidresult->result->{bugs};
}
=head2 Sort versions correctly
The call requires the array to sort
The call will return a array with versions or will fail
=cut
sub BzSortVersions {
my(@versions) = @_;
return sort {
if (looks_like_number(substr($a, 0, 1)) == 0) {
return 1;
} elsif (looks_like_number(substr($b, 0, 1)) == 0) {
return -1;
} else {
return lc($b) cmp lc($a);
}
} @versions;
}
#Gets the values for LibreOffice for a field
#Input: The connection to bugzilla
#Input: The name of the field
#Input: Return only items with LibreOffice visibility
#Output: Array with the values
sub _find_values_for_field {
my($bz, $names, $visibility) = @_;
my @LOValues;
my $soapresult = $bz->call('Bug.fields',
{ names => $names,
include_fields => ['values'] } );
_die_on_fault($soapresult);
my @values = @{$soapresult->result->{fields}->[0]->{values}};
foreach (@values)
{
if ($_->{visibility_values}->[0] eq "LibreOffice" || !$visibility) {
push(@LOValues, $_->{name});
}
}
return @LOValues;
}
#Prints the fault in the soapresult and exists
#Input: The soapresult
sub _die_on_fault {
my($error) = @_;
if ($error->fault) {
my ($package, $filename, $line) = caller;
die "SOAP-error in $filename on line $line: ".$error->faultcode." ".$error->faultstring."\n";
}
}