« back to all changes in this revision
Viewing changes to bin/japiohtml
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Wolfgang Baer
- Date: 2005-10-06 15:52:05 UTC
- Revision ID: james.westby@ubuntu.com-20051006155205-f3t983pid9uyc0gv
Tags: upstream-0.9.5+cvs20051006
Import upstream version 0.9.5+cvs20051006
- files added:
- bin
- design
- share
- share/java
- src
- src/net
- src/net/wuffies
- src/net/wuffies/japi
- web
added
removed
bin/japiohtml
1
#!/usr/bin/perl -w
2
###############################################################################
3
# japiohtml - Convert japicompat output to pretty html format.
4
# Copyright (C) 2000,2002,2003,2004,2005 Stuart Ballard <stuart.a.ballard@gmail.com>
5
#
6
# This program is free software; you can redistribute it and/or
7
# modify it under the terms of the GNU General Public License
8
# as published by the Free Software Foundation; either version 2
9
# of the License, or (at your option) any later version.
10
#
11
# This program is distributed in the hope that it will be useful,
12
# but WITHOUT ANY WARRANTY; without even the implied warranty of
13
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14
# GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License
17
# along with this program; if not, write to the Free Software
18
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19
###############################################################################
20
21
## GLOBAL VARIABLES ##
22
23
# Some global variables used for displaying stuff.
24
$japiover = "0.9.2";
25
@categories = ();
26
@packages = ();
27
# Would be nice not to hardcode this - maybe later...
28
@things = ("package", "class", "interface", "field", "method", "constructor");
29
30
$javatypes = {Z=>'boolean', B=>'byte', C=>'char', D=>'double', F=>'float',
31
I=>'int', J=>'long', S=>'short', V=>'void'};
32
33
# Requirements
34
#use IO::Handle;
35
sub sig2type($);
36
sub readable_member($);
37
sub readable_item($);
38
sub htmlencode($);
39
40
my $verline = <>;
41
chomp $verline;
42
($filever, $origfile, $newfile) = ($1, $2, $3)
43
if $verline =~ /^%\%japio ([^ ]+) ([^ ]+) ([^ ]+)(?: .*)?$/;
44
unless (defined $filever) {
45
print STDERR <<EOF;
46
This does not look like a japio file.
47
EOF
48
exit 1;
49
}
50
if ($filever ne $japiover) {
51
print STDERR <<EOF;
52
This japio file claims to be version $filever, but this version of japiohtml
53
only supports version $japiover.
54
EOF
55
exit 1;
56
}
57
58
($orig,$origdate) = ($1, $2)
59
if $origfile =~ /^([^@]*?)(?:\.japi(?:\.gz)?)?(?:@(.*))?$/;
60
($new, $newdate) = ($1, $2)
61
if $newfile =~ /^([^@]*?)(?:\.japi(?:\.gz)?)?(?:@(.*))?$/;
62
$origdate =~ s/_/ /g if $origdate;
63
$newdate =~ s/_/ /g if $newdate;
64
65
my $date = gmtime() . " GMT";
66
67
print <<EOF;
68
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
69
"http://www.w3.org/TR/html4/loose.dtd">
70
<html>
71
<head>
72
<title>Results of comparison between $orig and $new</title>
73
<link rel="stylesheet" type="text/css" href="japi.css">
74
</head>
75
<body>
76
<h1>Results of comparison between $orig and $new</h1>
77
<p class="datestamp">Comparison run at $date</p>
78
EOF
79
print <<EOF if $origdate;
80
<p class="datestamp">$orig API scanned at $origdate</p>
81
EOF
82
print <<EOF if $newdate;
83
<p class="datestamp">$new API scanned at $newdate</p>
84
EOF
85
print <<EOF;
86
<h2>Summary</h2>
87
EOF
88
89
my $alt = 1;
90
while (<>) {
91
chomp;
92
if (/^notify (.*)$/) {
93
print "<p class='notify'>$1</p>\n";
94
} elsif (/^categories (.*)$/) {
95
print <<EOF;
96
<table class="legend" align="right" border="0" cellspacing="0" cellpadding="3">
97
<tr>
98
<th>Legend:</th>
99
<td>All correct -</td>
100
EOF
101
for (my $i = 100; $i >= 0; $i -= 10) {
102
print <<EOF;
103
<td class="ok-${i}pct"> </td>
104
EOF
105
}
106
print <<EOF;
107
<td class="ok-none"> </td>
108
<td>- None correct</td>
109
</tr>
110
</table>
111
<br clear="all">
112
<table class="summary" border="0" cellspacing="0" cellpadding="3">
113
<tr class="colhead">
114
<td> </td>
115
EOF
116
my @bits = split / /, $1;
117
foreach my $bit (@bits) {
118
if ($bit =~ /^(=?)(.)(.*)/) {
119
my $cat = "$2$3";
120
my $capegory = uc($2).$3;
121
my $letter = $2;
122
my $ok = $1;
123
$letter = $1 if $cat =~ /_(.)/;
124
$cat =~ s/_//;
125
$letters->{$cat} = $letter;
126
$capegory =~ s/_//;
127
push @categories, $cat;
128
$okcats->{$cat} = 1 if $ok;
129
$cat =~ s/\./-/g;
130
print <<EOF;
131
<th class="$cat">$capegory</th>
132
EOF
133
}
134
}
135
print <<EOF;
136
</tr>
137
EOF
138
} elsif (/^summary (.*)$/) {
139
die "No categories line found before summary line" unless @categories;
140
my @bits = split / /, $1;
141
my ($extra, $total, $values, $etotal, $oktotal, $nonmoototal) = ({}, 0, {}, 0, 0, 0);
142
my $pkg = shift @bits;
143
foreach my $bit (@bits) {
144
my ($plus, $key, $value, $smootval, $mootval) = ($1, $2, $3, $4, $5)
145
if $bit =~ /^(\+?)([^:+]+):([0-9]+)\^([0-9]+)>([0-9]+)$/;
146
$etotal += $value - $smootval - $mootval;
147
$oktotal += $value - $smootval - $mootval if $okcats->{$key};
148
if ($plus) {
149
$extra->{$key} = $value - $smootval - $mootval;
150
} else {
151
$total += $value - $smootval;
152
$nonmoototal += $value - $smootval - $mootval;
153
$values->{$key} = $value - $smootval - $mootval;
154
$values->{MOOT} += $mootval;
155
}
156
}
157
my $pkgn = $pkg;
158
my $pkga;
159
my $pkgl;
160
if ($pkg eq "#") {
161
print "\n";
162
$pkga = $pkgn = "Total";
163
} elsif ($pkg =~ /^#(.)(.*)$/) {
164
$pkgn = uc($1) . $2;
165
$pkgn .= "e" if $pkgn =~ /[sx]$/;
166
$pkgn .= "s";
167
$pkga = $pkgn;
168
} else {
169
$pkgl = $pkg; $pkgl =~ s/\./_/g;
170
$pkga = $pkgn;
171
$pkga =~ s/\./.<span class="sp"> <\/span>/g;
172
$pkga = "<a href=\"#pkg_$pkgl\">$pkga</a>";
173
push @packages, $pkg;
174
}
175
my $pctclass = "none";
176
if ($etotal) {
177
$pctclass = (int($oktotal * 10 / $etotal) * 10)."pct" if $oktotal;
178
} else {
179
$pctclass = "moot";
180
}
181
print <<EOF;
182
<tr class="alternating-$alt">
183
<th class="ok-$pctclass">$pkga:</th>
184
EOF
185
$alt = 3 - $alt;
186
foreach my $key (@categories) {
187
my $val;
188
if ($values->{$key}) {
189
$val = (int($values->{$key} * 10000 / $total)/100) . "%";
190
} elsif ($extra->{$key}) {
191
$val = (int($extra->{$key} * 10000 / $total)/100) . "%";
192
}
193
if ($val) {
194
if ($pkg ne "#" && $key ne "good") {
195
my $errl = $key; $errl =~ s/\./_/g;
196
$val = "<a href=\"#err_${errl}_$pkgl\">$val</a>";
197
}
198
} else {
199
$val = " ";
200
}
201
my $class = $key; $class =~ s/\./-/g;
202
print <<EOF;
203
<td class="$class" title="$pkgn $key">$val</td>
204
EOF
205
}
206
207
use integer;
208
209
# Now we need to integerize the percentages so we can emit a table whose
210
# width (minus the "extra" bit) adds up to exactly 100 pixels. We also want
211
# to ensure that *anything* nonzero gets at least a pixel. See the file
212
# design/percent-rounding.txt for a justification of this algorithm.
213
214
# Start off assuming nothing's less than 1%, and iterate until we find
215
# that we're right. m is the number of adjustable (<1%) items, and t is
216
# the total of the non-adjustable items. Lastm keeps track of what we
217
# thought m was last time round. We loop until we do an entire pass without
218
# m ending up different from lastm. Lastm starts off as -1 just so that the
219
# m == lastm test fails first time around.
220
my $t = $total;
221
my $m = 0;
222
my $lastm = -1;
223
my $adjustable = {};
224
until ($m == $lastm) {
225
$lastm = $m;
226
227
# Loop over the items that haven't already been marked adjustable. For
228
# each such item, determine whether it needs to be adjustable based on
229
# the current values of m and t. If it does, mark it as adjustable and
230
# update m and t accordingly.
231
foreach my $item (keys %$values) {
232
if ($values->{$item} > 0) {
233
if (!$adjustable->{$item}) {
234
if ($values->{$item} * (100-$m) < $t) {
235
$t -= $values->{$item};
236
$m++;
237
$adjustable->{$item} = 1;
238
}
239
}
240
}
241
}
242
}
243
244
# Having calculated the final values of m and t, and also knowing exactly
245
# which items are adjustable, we can now calculate the adjusted totals.
246
# Non-adjustable items are scaled up by a constant factor; adjustable
247
# items are all set to exactly 1% of the scaled total.
248
my $adjtotal = 100 * $t;
249
my $adjvalue = {};
250
foreach my $item (keys %$values) {
251
if ($values->{$item} > 0) {
252
if ($adjustable->{$item}) {
253
$adjvalue->{$item} = $t;
254
} else {
255
$adjvalue->{$item} = $values->{$item} * (100-$m);
256
}
257
}
258
}
259
260
# Calculate the percentage rounded *down* to the nearest integer, and also
261
# calculate the magnitude of the difference between the integer percentage
262
# and the actual percentage. This is still all done in integer math...
263
# While we're at it, sum the percentages so we can see how close we got,
264
# later.
265
my $totalpct = 0;
266
my $percent = {};
267
my $diff = {};
268
foreach my $item (keys %$values) {
269
if ($values->{$item} > 0) {
270
$percent->{$item} = ($adjvalue->{$item} * 100) / $adjtotal;
271
$diff->{$item} = $adjvalue->{$item} * 100 - $percent->{$item} * $adjtotal;
272
$totalpct += $percent->{$item};
273
} else {
274
$diff->{$item} = 0;
275
}
276
}
277
278
# Find the items with the largest differences, and adjust them upwards,
279
# until 100% is reached. No need to reset the difference since we're looping
280
# through the items and will never repeat: it's easy to show that the upper
281
# bound on the number of upwards adjustments needed is smaller than the
282
# number of items.
283
foreach my $item (sort { $diff->{$b} <=> $diff->{$a} } keys %$values) {
284
if ($values->{$item} > 0) {
285
last if ($totalpct >= 100);
286
$percent->{$item}++;
287
$totalpct++;
288
}
289
}
290
291
foreach my $item (keys %$extra) {
292
if ($extra->{$item} > 0) {
293
$percent->{$item} = ($extra->{$item} * 1000 + 5) / ($total * 10);
294
$percent->{$item} = 1 unless $percent->{$item};
295
$totalpct += $percent->{$item};
296
}
297
}
298
299
print <<EOF;
300
<td>
301
<table width="$totalpct" cellpadding="0" cellspacing="0" class="bar">
302
<tr>
303
EOF
304
foreach my $item (@categories) {
305
if (exists $percent->{$item}) {
306
my $pct = $percent->{$item};
307
my $class = $item; $class =~ s/\./-/g;
308
my $altc = uc($letters->{$item});
309
my $alt = $altc x ($percent->{$item} / 5);
310
$alt = $altc unless $alt;
311
print <<EOF if $pct;
312
<td width="$pct" class="$class-bar" title="$pkgn $item">
313
<img src="1x1.gif" width="1" height="12" alt="$alt">
314
</td>
315
EOF
316
}
317
}
318
print <<EOF;
319
</tr>
320
</table>
321
</td>
322
</tr>
323
EOF
324
} elsif (/^error (.*)$/) {
325
my $line = $1;
326
my ($etype, $isa, $item, $sups, $rest) = split / /, $line, 5;
327
my ($pkg, $cmember) = split /,/, $item;
328
push @{$errors->{"$pkg/$etype"}}, $line;
329
$totals->{"$etype/$isa"}++;
330
$totals->{"$etype/$isa/$pkg"}++;
331
} elsif (/^end japio$/) {
332
last;
333
} else {
334
die "Line not understood in japio file:\n$_";
335
}
336
}
337
print <<EOF;
338
</table>
339
<h2>Errors</h2>
340
<table class="phead" width="100%">
341
<tr>
342
<td>
343
<h3>Total</h3>
344
EOF
345
my $ct = 0;
346
foreach my $cat (@categories) {
347
next if $cat eq "good";
348
my $cap = uc($1).$2 if $cat =~ /^(.)(.*)$/;
349
my $catn = $cat; $catn =~ s/\./-/g;
350
my $vals = "";
351
foreach my $thing (@things) {
352
my $tot = $totals->{"$cat/$thing"};
353
if ($tot) {
354
my $th = $thing;
355
if ($tot > 1) {
356
$th .= "e" if $th =~ /[sx]$/;
357
$th .= "s";
358
}
359
$vals .= "," if $vals;
360
$vals .= " $tot $th";
361
}
362
}
363
$vals = " None" unless $vals;
364
print <<EOF;
365
<span class="$catn">$cap:$vals.</span>
366
EOF
367
}
368
print <<EOF;
369
</td>
370
</tr>
371
</table>
372
<p> </p>
373
EOF
374
foreach my $pkg (@packages) {
375
my $pkgl = $pkg; $pkgl =~ s/\./_/g;
376
my $catlinks = "";
377
my $anyerrors = 0;
378
foreach my $cat (@categories) {
379
my $catl = $cat; $catl =~ s/\./_/g;
380
unless ($cat eq "good") {
381
if ($errors->{"$pkg/$cat"}) {
382
$anyerrors = 1;
383
} else {
384
$catlinks .= "<a name=\"err_${catl}_$pkgl\"></a>";
385
}
386
}
387
}
388
if ($anyerrors) {
389
print <<EOF;
390
<table class="phead" width="100%">
391
<tr>
392
<td>
393
<h3><a name="pkg_$pkgl"></a>$catlinks$pkg</h3>
394
EOF
395
my $ct = 0;
396
foreach my $cat (@categories) {
397
next if $cat eq "good";
398
my $cap = uc($1).$2 if $cat =~ /^(.)(.*)$/;
399
my $catn = $cat; $catn =~ s/\./-/g;
400
my $catl = $cat; $catl =~ s/\./_/g;
401
my $vals = "";
402
foreach my $thing (@things) {
403
my $tot = $totals->{"$cat/$thing/$pkg"};
404
if ($tot) {
405
my $th = $thing;
406
if ($tot > 1) {
407
$th .= "e" if $th =~ /[sx]$/;
408
$th .= "s";
409
}
410
$vals .= "," if $vals;
411
$vals .= " $tot $th";
412
}
413
}
414
print <<EOF if $vals;
415
<a class="$catn" href="#err_${catl}_$pkgl">$cap:$vals.</a>
416
EOF
417
}
418
print <<EOF;
419
</td>
420
</tr>
421
</table>
422
EOF
423
} else {
424
print <<EOF;
425
<a name="pkg_$pkgl"></a>$catlinks
426
EOF
427
}
428
foreach my $cat (@categories) {
429
if ($errors->{"$pkg/$cat"}) {
430
my $catl = $cat; $catl =~ s/\./_/g;
431
my $catc = $cat; $catc =~ s/\./-/g;
432
my $cap = uc($1).$2 if $cat =~ /^(.)(.*)$/;
433
print <<EOF;
434
<h4 class="ehead"><a name="err_${catl}_$pkgl"></a>$cap</h4>
435
<ul class="$catc">
436
EOF
437
foreach my $line (@{$errors->{"$pkg/$cat"}}) {
438
my ($etype, $isa, $item, $sups, $rest) = split / /, $line, 5;
439
my ($was, $is) = split /\//, $rest;
440
$was =~ s/~s/\//g; $was =~ s/~t/~/g;
441
$is =~ s/~s/\//g; $is =~ s/~t/~/g;
442
my $msg = $was ? "$was in $orig, but" : "";
443
my $ritem = readable_item($item);
444
my $outline = htmlencode("$isa $ritem: $msg $is in $new");
445
print <<EOF;
446
<li>$outline</li>
447
EOF
448
}
449
print <<EOF;
450
</ul>
451
EOF
452
}
453
}
454
}
455
print <<EOF;
456
</body>
457
</html>
458
EOF
459
460
sub htmlencode($) {
461
my ($val) = @_;
462
$val =~ s/&/&/g;
463
$val =~ s/</</g;
464
$val =~ s/>/>/g;
465
return $val;
466
}
467
468
sub readable_item($) {
469
my ($item) = @_;
470
my ($fqclass, $member) = split /!/, $item, 2;
471
my ($pkg, $class) = split /,/, $fqclass, 2;
472
my $ritem = $pkg;
473
if ($class) {
474
$class =~ s/\$/./g;
475
$ritem .= ".$class";
476
}
477
$ritem .= "." . readable_member($member) if $member;
478
return $ritem;
479
}
480
481
# Convert all the type signatures in a method name...
482
sub readable_member($) {
483
my ($member) = @_;
484
if ($member =~ /^(.*)\((.*)\)$/) {
485
my ($name, $params) = ($1, $2);
486
$params = sig2typelist($params);
487
$member = "$name($params)";
488
} elsif ($member =~ /^#(.*)$/) {
489
$member = $1;
490
}
491
$member;
492
}
493
494
# Convert a type signature as used in a japi file to a displayable type.
495
sub sig2type($) {
496
my ($sig) = @_;
497
return sig2type($1) . '[]' if $sig =~ /^\[(.*)$/;
498
return sig2type($1) . "..." if $sig =~ /^\.(.*)$/;
499
return "? super " . sig2type($1) if $sig =~ /^\}(.*)$/;
500
return "?" if $sig eq "{Ljava/lang/Object;";
501
return "? extends " . sig2type($1) if $sig =~ /^\{(.*)$/;
502
return "T" if $sig eq "\@0";
503
return "T" . ($1 + 1) if $sig =~ /^\@([0-9]+)$/;
504
return $javatypes->{$sig} if $javatypes->{$sig};
505
my $gparams;
506
$sig = $1 if $sig =~ /^L(.*);$/;
507
($sig, $gparams) = ($1, $2) if $sig =~ /^([^<>]+)<(.*)>$/;
508
$sig =~ s-/-.-g;
509
$sig =~ s/\$/./g;
510
$sig = "$sig<" . sig2typelist($gparams) . ">" if defined($gparams);
511
return $sig;
512
}
513
sub sig2typelist($) {
514
my ($list) = @_;
515
my @sigs = splitgenstr($list);
516
return join(", ", map {sig2type($_)} @sigs);
517
}
518
sub countchar($$) {
519
my ($str, $char) = @_;
520
$str =~ s/[^$char]//g;
521
return length $str;
522
}
523
524
sub splitgenstr($) {
525
my ($str) = @_;
526
my @items = split(/,/, $str);
527
my @result = ();
528
529
my $class = "";
530
foreach my $item (@items) {
531
$class .= "," if $class;
532
$class .= $item;
533
if (countchar($class, "<") == countchar($class, ">")) {
534
push @result, $class;
535
$class = "";
536
}
537
}
538
push @result, $class if $class;
539
return @result;
540
}
b'\\ No newline at end of file'
Loggerhead is a web-based interface for Breezy
Version: 2.0.1