source: devel/pb-modules/lib/ProjectBuilder/Log.pm @ 2397

Last change on this file since 2397 was 1153, checked in by Bruno Cornec, 9 years ago
  • Avoid File::MimeInfo? hard requirement. Only abort if not found when needed.
  • Improve report when a perl module is missing
  • Kill an existing crashed VM using an SSH port needed for another VM (should avoid crashed VM to stay when building for all VMs)
  • Use a new parameter vmbuildtm as a timeout before killing the VM (shoudl correspond to build + transfer time)
  • use twice the number of VMs for ports in the range for SSH communication to allow for VMs to finish in an unordered way.
  • Fix a bug in test modules when using Test simple only
  • Mail::Sendmail is now optional for Log module as well, even if not used yet
  • Update pb.conf doc with info for vmbuildtm and vmmem
  • Ready for 0.10.1
File size: 6.0 KB
Line 
1package ProjectBuilder::Log;
2
3# this class can be used to store and analyze the complete log from pb
4# this includes more than one vm
5
6use strict;
7use ProjectBuilder::Version;
8use ProjectBuilder::Base;
9use ProjectBuilder::Log::Item;
10
11sub new {
12    # contains the object name (here PBLog)
13    my $object = shift;
14    my $self = {};
15
16    # $self should point to an object of type $object
17    bless($self, $object);
18   
19    # this array stores our childs
20    $self->{'logitems'} = [];
21
22    return($self);
23}
24
25# returns number of handled ProjectBuilder::Log::Item's
26sub countItems {
27    my $self = shift;
28    return scalar(@{$self->{'logitems'}});
29}
30
31# returns an array of all names of handled ProjectBuilder::Log::Item's
32# the name is the vm name (e.g. ubuntu-10.04-i386 (by default))
33sub itemNames {
34    my $self = shift;
35    my @result = ();
36
37    foreach my $item (@{$self->{'logitems'}}) {
38        push(@result, $item->name());
39    }
40    return @result;
41}
42
43# set's the log for ProjectBuilder::Log::item $vmname
44# if such an item is not present, one is added
45# $log should only contain the log of one machine
46sub setLog {
47    my $self = shift;
48    my $vmname = shift;
49    my $log = shift;
50     
51    my $logitem = $self->findItem($vmname);
52    if (!$logitem) {
53        $logitem = new ProjectBuilder::Log::Item($vmname);
54        push(@{$self->{'logitems'}}, $logitem);
55    }
56    $logitem->setLog($log);
57}
58
59# used to analyze the complete log of pb
60sub setCompleteLog {
61    my $self = shift;
62    my $log = shift;
63    my $tmplog = "";
64    my $item = undef;
65     
66    foreach my $line (split("\n", $log)) {
67        if ($line =~ m/^Waiting [0-9]+ s for VM/) {
68            # here starts a new machine, so append the tmplog to the last one
69            if (defined($item)) {
70                $item->setLog($tmplog);
71            }
72            if($line =~ m/VM ([^\s]+)/){
73                $item = new ProjectBuilder::Log::Item($1);
74                push(@{$self->{'logitems'}}, $item);
75                $tmplog = 0;
76            }
77        } else {
78            $tmplog .= $line ."\n";
79        }
80    }
81    if (defined($item) && ($tmplog)) {
82        $item->setLog($tmplog);
83    }
84}
85
86# nums the issues (Warnings and Errors from lintian and rpmlint
87# if no name is given, the total of all ProjectBuilder::Log::Item's is returned
88sub numQaIssues {
89    my $self = shift;
90    my $itemname = shift || "";
91    my $result = 0;
92
93    if ($itemname eq "") {
94        # no machine selected, so return combine from all items
95        foreach my $item (@{$self->{'logitems'}}) {
96            $result += scalar($item->qaIssues());
97        }
98    } else {
99        my $item = $self->findItem($itemname);
100        if ($item) {
101            $result = $item->numQaIssues();
102        }
103    }
104    return $result;
105}
106
107# returns the issues itself
108# behaves like numQaIssues
109sub qaIssues {
110    my $self = shift;
111    my $itemname = shift || "";
112    my @result = ();
113
114    if ($itemname eq "") {
115        # no machine selected, so return combine from all items
116        foreach my $item (@{$self->{'logitems'}}) {
117            push(@result, $item->qaIssues());
118        }
119    } else {
120        my $item = $self->findItem($itemname);
121        if ($item) {
122            push(@result, $item->qaIssues());
123        }
124    }
125    return @result;
126}
127
128# same as num qaIssues but for compile errors
129sub numErrors {
130    my $self = shift;
131    my $itemname = shift || "";
132    my $result = 0;
133
134    if ($itemname eq "") {
135        # no machine selected, so return combine from all items
136        foreach my $item (@{$self->{'logitems'}}) {
137            $result += $item->numErrors();
138        }
139    } else {
140        my $item = $self->findItem($itemname);
141        if ($item) {
142            $result = $item->numErrors();
143        }
144    }
145    return $result;
146}
147
148# returns the compile errors itself
149# behaves like numQaIssues
150sub errors {
151    my $self = shift;
152    my $itemname = shift || "";
153    my @result = ();
154
155    if ($itemname eq "") {
156        # no machine selected, so return combine from all items
157        foreach my $item (@{$self->{'logitems'}}) {
158            push(@result, $item->errors());
159        }
160    } else {
161        my $item = $self->findItem($itemname);
162        if ($item) {
163            push(@result, $item->errors());
164        }
165    }
166    return @result;
167}
168
169# same as num qaIssues but for compile warnings
170sub numWarnings {
171    my $self = shift;
172    my $itemname = shift || "";
173    my $result = 0;
174
175    if ($itemname eq "") {
176        # no machine selected, so return combine from all items
177        foreach my $item (@{$self->{'logitems'}}) {
178            $result += $item->numWarnings();
179        }
180    } else {
181        my $item = $self->findItem($itemname);
182        if ($item) {
183            $result = $item->numWarnings();
184        }
185    }
186    return $result;
187}
188
189# returns the compile warnings itself
190# behaves like numQaIssues
191sub warnings {
192    my $self = shift;
193    my $itemname = shift || "";
194    my @result = ();
195
196    if ($itemname eq "") {
197        # no machine selected, so return combine from all items
198        foreach my $item (@{$self->{'logitems'}}) {
199            push(@result, $item->warnings());
200        }
201    } else {
202        my $item = $self->findItem($itemname);
203        if ($item) {
204            push(@result, $item->warnings());
205        }
206    }
207    return @result;
208}
209
210# prints out a summary of the log
211sub summary {
212    my $self = shift;
213    my $summary = "";
214
215    $summary = "Items: ". $self->countItems();
216    $summary .= " (QA Issues: ". $self->numQaIssues();
217    $summary .= ", Warnings: ". $self->numWarnings();
218    $summary .= ", Errors: ". $self->numErrors() .")\n";
219    foreach my $name ($self->itemNames()) {
220        $summary .= $name ." (QA Issues: ". $self->numQaIssues($name);
221        $summary .= ", Warnings: ". $self->numWarnings($name);
222        $summary .= ", Errors: ". $self->numErrors($name) .")\n";
223    }
224    return $summary;
225}
226
227# mails the summary to $to
228sub mailSummary {
229    eval
230    {
231        require Mail::Sendmail;
232        Mail::Sendmail->import();
233    };
234    if ($@) {
235        # Mail::Sendmail not found not sending mail !
236        pb_log(0,"No Mail::Sendmail module found so not sending any mail !\n");
237    } else {
238        my $self = shift;
239        my $to = shift || "";
240
241        if ($to eq "") {
242            pb_log(0,"Please give a To: address\n");
243            return;
244        }
245        my %mail = (   
246            To => $to,
247            From => "pb\@localhost",
248            Message => $self->summary()
249        );
250        if (! sendmail(%mail)) { 
251            if (defined $Mail::Sendmail::error) {
252                return $Mail::Sendmail::error;
253            } else {
254                return "Unkown error";
255            }
256        }
257        pb_log(0,"Mail send to ". $to ."\n");
258    }
259}
260
261# private part (perl does not no about private, but it is meant so)
262# find's item with name $vmname in handled OB::Log::Item's
263sub findItem {
264    my $self = shift;
265    my $vmname = shift;
266
267    # find existing item or add item if needed
268    foreach my $logitem (@{$self->{'logitems'}}) {
269        if ($logitem->name eq $vmname) {
270            return $logitem;
271        }
272    }
273    return 0;
274}
275
2761;
Note: See TracBrowser for help on using the repository browser.