#!/usr/bin/perl -- use strict; use warnings; use feature ":5.14"; use XML::Simple; use XML::Twig; use Data::Dump qw' dd '; use Data::Dumper; use List::Compare; use HTML::Table; my $ndiff; my $odiff; my @oapi; my @napi; my @oldclasses; my @newclasses; my @oldfiles; my @newfiles; my @oldnsp; my @newnsp; my @newonly; my @oldonly; my @names_in_newapi; my @names_in_oldapi; my @memnew; my @memold; my @list; my $i = 0; my $j = 0; my $apichanges = 'apichanges.html'; my ($tablec, $tablef, $tablen, $tablemst, $tname); my $tr = 2; my $crow = 2; my $ccol = 3; ############################################## # doxygen generates DoxyDocs.pm by default that represents the complete API # rename older version of api to oldDoxyDocs.pm and rename new version to newDoxyDocs.pm # inside these two files rename the default $doxydocs variable to $olddoxydocs # and $newdoxydocs in their related file. ############################################## # require "oldDoxyDocs.pm"; # our $olddoxydocs; # require "newDoxyDocs.pm"; # our $newdoxydocs; ############################################## # Script takes oldDoxyDocs.pm and newDoxyDocs.pm and converts to xml # then filters out unneeded tags from xml then puts all classes, # files, namespaces into hash containing two arrays with each element # of array containing all related properties of each class, etc. # # USAGE: apixml.pl oldapi.xml newapi.xml # Then open apichanges.html # # following lines convert pm files to xml files oldapi.xml and newapi.xml ############################################## # my $ofh = 'oldapi.xml'; # my $oxs = new XML::Simple(RootName => "apiroot"); # $oxs->XMLout($olddoxydocs, XMLDecl => 1, OutputFile => $ofh); # add this option to convert attributes to elements NoAttr => 1, # my $nfh = 'newapi.xml'; # my $nxs = new XML::Simple(RootName => "apiroot"); # $nxs->XMLout($newdoxydocs, XMLDecl => 1, OutputFile => $nfh); Main( @ARGV ); exit( 0 ); sub Main { my %files; my %class; my %results; my $item_to_compare; my $filename; my $ssprint = sub { my( $twig, $_ ) = @_; push @{ $files{ $filename }}, $_->sprint; # push all classes, files, namespaces into files hash with separate array for each file return; }; my $twig = XML::Twig->new( ignore_elts => { brief => 'discard', detailed => 'discard', includes => 'discard', included_by => 'discard', reimplemented_by => 'discard' }, pretty_print => 'indented', escape_gt => 1, keep_encoding => 1, TwigHandlers => { 'apiroot/classes' => $ssprint, 'apiroot/files' => $ssprint, 'apiroot/namespaces' => $ssprint, }, ); for my $file( @_ ) { $filename = $file; eval { $twig->parsefile( $file ); 1; } or warn "ERROR parsefile($file): $@ "; # following code gathers names of all classes, files, namespaces # from oldapi and newapi xml files and puts in arrays my $root = $twig->root; my @class = $root->children( 'classes' ); foreach my $cls (@class) { my $clsname = $cls->{'att'}->{'name'}; if ($filename eq 'oldapi.xml') { push (\@oldclasses, $clsname); } else { push (\@newclasses, $clsname); } } my @hfiles = $root->children( 'files' ); foreach my $hfile (@hfiles) { if ($filename eq 'oldapi.xml') { push (\@oldfiles, $hfile->{'att'}->{'name'}); } else { push (\@newfiles, $hfile->{'att'}->{'name'}); } } my @namesp = $root->children( 'namespaces' ); foreach my $nsp (@namesp) { if ($filename eq 'oldapi.xml') { push (\@oldnsp, $nsp->{'att'}->{'name'}); } else { push (\@newnsp, $nsp->{'att'}->{'name'}); } } $twig->purge; } # dd \%files; open (OUTFILE, ">$apichanges") or die "Cannot open $apichanges for writing \n"; print OUTFILE <

API Changes

EOF $tablec = new HTML::Table(-rows=>1, -cols=>2, -align=>'center', -rules=>'rows,cols', -border=>2, -bgcolor=>'white', -width=>'85%', -spacing=>0, -padding=>0, -style=>'color: green', -class=>'api', -evenrowclass=>'even', -oddrowclass=>'odd', -head=> ['Classes Added', 'Classes Removed'], ); # following code compares arrays to find new classes, # files, namespaces added and old ones removed my $cc = List::Compare->new(\@oldclasses, \@newclasses); @newonly = $cc->get_complement; @oldonly = $cc->get_unique; for my $row (@newonly) { $tablec->addRow($row); } for my $row (@oldonly) { $tablec->setCell($tr++,2,$row); } print OUTFILE $tablec; undef @newonly; undef @oldonly; $tr = 2; $tablef = new HTML::Table(-rows=>1, -cols=>2, -align=>'center', -rules=>'rows,cols', -border=>2, -bgcolor=>'white', -width=>'85%', -spacing=>0, -padding=>0, -style=>'color: green', -class=>'api', -evenrowclass=>'even', -oddrowclass=>'odd', -head=> ['Header Files Added', 'Header Files Removed'], ); my $fc = List::Compare->new(\@oldfiles, \@newfiles); @newonly = $fc->get_complement; @oldonly = $fc->get_unique; for my $row (@newonly) { $tablef->addRow($row); } for my $row (@oldonly) { $tablef->setCell($tr++,2,$row); } print OUTFILE $tablef; undef @newonly; undef @oldonly; $tr = 2; $tablen = new HTML::Table(-rows=>1, -cols=>2, -align=>'center', -rules=>'rows,cols', -border=>2, -bgcolor=>'white', -width=>'85%', -spacing=>0, -padding=>0, -style=>'color: green', -class=>'api', -evenrowclass=>'even', -oddrowclass=>'odd', -head=> ['Namespaces Added', 'Namespaces Removed'], ); my $nc = List::Compare->new(\@oldnsp, \@newnsp); @newonly = $nc->get_complement; @oldonly = $nc->get_unique; for my $row (@newonly) { $tablen->addRow($row); } for my $row (@oldonly) { $tablen->setCell($tr++,2,$row); } print OUTFILE $tablen; undef @newonly; undef @oldonly; $tr = 2; # following code references the two arrays in hash that contain # all info about classes, files, and namespaces in old and new api # then compares arrays to find what is new, changed or removed. my $hashref = \%files; my $oldapi = $hashref->{"oldapi.xml"}; my $newapi = $hashref->{"newapi.xml"}; my $lc = List::Compare->new(\@{$oldapi}, \@{$newapi}); @oldonly = $lc->get_unique; # unique to old version @newonly = $lc->get_complement; # get all new items includes all item prop info $tablemst = new HTML::Table(-rows=>1, -cols=>3, -align=>'center', -rules=>'rows,cols', -border=>2, -bgcolor=>'white', -width=>'85%', -spacing=>0, -padding=>0, -style=>'color: green', -class=>'api', -evenrowclass=>'even', -oddrowclass=>'odd', -head=> ['Modified Class, File, or Namespace', 'Locations found', 'Specific Change'], ); # following code takes each new, changed, or removed item and # filters through regex to remove xml markup to make it easier to read # also takes just the name of each item to be used for later comparisons for $odiff (@oldonly) { if($odiff =~ m/(.*name.*?\>)/) { push (@names_in_oldapi, $1); } } for $ndiff (@newonly) { if($ndiff =~ m/(.*name.*?\>)/) { push (@names_in_newapi, $1); } } # this subroutine finds index of element representing item that # was modified in oldonly and newonly arrays so they can be extracted # and broken down and compared to find exactly what changed sub findindex { 1 while $_[0] ne pop; @_-1; } sub ret_ancestors($$$;$); sub ret_ancestors($$$;$) {my ($r, $l, $e, $a) = @_; $a = [] unless $a; return unless $l and ref($l); if (ref($l) =~ /HASH/) {for(sort keys %$l) {unless (/$e/) {push @$a, $_; ret_ancestors($r, $l->{$_}, $e, $a); pop @$a;} else {&$r(@$a);} } } elsif (ref($l) =~ /ARRAY/) {for(1..@$l) {unless ($l->[$_-1] =~ /$e/) {push @$a, $_; ret_ancestors($r, $l->[$_-1], $e, $a); pop @$a;} else {&$r(@$a);} } } } # following code finds indexes of elements that exist in both arrays after lc compare is done, # -1 means that item does not exist in oldapi array for $item_to_compare (@names_in_newapi) { my $oindex = findindex($item_to_compare, @names_in_oldapi); my $nindex = findindex($item_to_compare, @names_in_newapi); push (@oapi, (split '\n', $oldonly[$oindex])) if $oindex != -1; # ignore items that are new or removed push (@napi, (split '\n', $newonly[$nindex])) if $oindex != -1; # only split on items that have changed my $oitemstr = XMLin($oldonly[$oindex], KeyAttr=>['name', 'declaration_name']); # convert to hash my $nitemstr = XMLin($newonly[$nindex], KeyAttr=>['name', 'declaration_name']); # convert to hash map(s/\W<([^>]+)>/$1/g, $item_to_compare); map(s/(\/|<\/\w+>)//g, $item_to_compare); my $memc = List::Compare->new(\@oapi, \@napi); @memnew = $memc->get_complement; # item property changes that exist in new version or unique if prop added in new api @memold = $memc->get_unique; # item property as it appears in old api or unique if prop removed in new api if (@memold) { map(s/\W<([^>]+)>/$1/, @memold); } # strips out xml tags for easier viewing if (@memold) { map(s/(\/|<\/\w+>)//, @memold); } if (@memnew) { map(s/\W<([^>]+)>/$1/, @memnew); } if (@memnew) { map(s/(\/|<\/\w+>)//, @memnew); } if (@memnew) { if (@memold) { for $tname (@memold) { $tname =~ m/[declaration_]?name="(\w+[:]?.\w+[:]?.\w+)/; #extract name from name attribute $tablemst->addRow($item_to_compare,$1); ret_ancestors sub {@list = join(" => ", @_)}, $nitemstr, $1; $tablemst->setCell($tr++,2,@list); $tablemst->setCell($crow++,$ccol,"From this:$memold[$i++]To this:$memnew[$j++]"); } } elsif (!@memold) { for $tname (@memnew) { $tname =~ m/[declaration_]?name="(\w+[:]?.\w+[:]?.\w+)/; $tablemst->addRow($item_to_compare,$1); ret_ancestors sub {@list = join(" => ", @_)}, $nitemstr, $1; $tablemst->setCell($tr++,2,@list); $tablemst->setCell($crow++,$ccol,"From this:NEW ITEM ADDEDTo this:$memnew[$j++]"); } } } elsif (@memold) { if (!@memnew) { for $tname (@memold) { $tname =~ m/[declaration_]?name="(\w+[:]?.\w+[:]?.\w+)/; #extract name from name attribute $tablemst->addRow($item_to_compare,$1); ret_ancestors sub {@list = join(" => ", @_)}, $oitemstr, $1; $tablemst->setCell($tr++,2,@list); $tablemst->setCell($crow++,$ccol,"From this:$memold[$i++]To this:ITEM REMOVED"); } } } else { $tablemst->setCell(2, 1, 'Nothing Changed'); } $i = 0; $j = 0; undef @oapi; undef @napi; undef @memold; undef @memnew; } undef @oldonly; undef @newonly; print OUTFILE $tablemst; print OUTFILE < COF close OUTFILE; }