comment on

Thanks to you and anonymous monk I have almost hacked together an api comparison script. I don't have much experience in perl but here is what I have so far. Maybe you can help clean it up or approach it from a better angle. Providing script and two example xml files that need to be named oldapi.xml and newapi.xml. Run script and provide two xml files as argument to produce apichanges.html. Also can you tell me why I am getting uninitialized value $e in regexp error.

#!/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 complet
+e 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 $old
+doxydocs
# 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', in
+cludes => 'discard', included_by => 'discard', reimplemented_by => 'd
+iscard' },
        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, namespac
+es
        # 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 <<EOF;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

<html>
<head>
<style type="text/css">
h1 {text-align:center}
table.api {
    font-family: verdana,arial,sans-serif;
    font-size:11px;
    color:#333333;
    border-width: 1px;
    border-color: #666666;
    border-collapse: collapse;
}
table.api th {
    border-width: 1px;
    padding: 8px;
    border-style: solid;
    border-color: #666666;
    background-color: #dedede;
}
table.api td {
    border-width: 1px;
    padding: 8px;
    border-style: solid;
    border-color: #666666;
    background-color: #ffffff;
}
</style>
</head>
<body>

<h1>API Changes</h1>
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 Fil
+es 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 R
+emoved'],
                             );
    
    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 i
+tem 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 Namespa
+ce', '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 compa
+risons

    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 extrac
+ted
    # 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 arra
+ys 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', 'decla
+ration_name']); # convert to hash
      my $nitemstr = XMLin($newonly[$nindex], KeyAttr=>['name', 'decla
+ration_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 ex
+ist in new version or unique if prop added in new api
      @memold = $memc->get_unique; # item property as it appears in ol
+d api or unique if prop removed in new api

      if (@memold) { map(s/\W<([^>]+)>/$1/, @memold); } # strips out x
+ml 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,"<b>From this:</b><br\>
+$memold[$i++]<br\><br\><b>To this:</b><br\>$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,"<b>From this:</b><br\>N
+EW ITEM ADDED<br\><br\><b>To this:</b><br\>$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(" => ", @_)}, $oitemst
+r, $1;
                $tablemst->setCell($tr++,2,@list);
                $tablemst->setCell($crow++,$ccol,"<b>From this:</b><br
+\>$memold[$i++]<br\><br\><b>To this:</b><br\>ITEM REMOVED<br\><br\>")
+;
           }
         }
      }
      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;
</body>
</html>
COF
close OUTFILE;
}
[download]

<?xml version='1.0' standalone='yes'?>
<apiroot>
  <classes name="Panoply::AttributeDesc">
    <all_members name="AttributeDesc" protection="public" scope="Panop
+ly::AttributeDesc" virtualness="non_virtual" />
    <public_members>
      <members name="xname" kind="variable" protection="public" static
+="no" type="std::string" virtualness="non_virtual">
      </members>
      <members name="value" kind="variable" protection="public" static
+="no" type="std::string" virtualness="non_virtual">
      </members>
    </public_members>
  </classes>
  <classes name="Panoply::BAR">
    <all_members name="BAR" protection="public" scope="Panoply::BAR" v
+irtualness="non_virtual" />
    <all_members name="type" protection="public" scope="Panoply::BAR" 
+virtualness="pure_virtual" />
    <public_methods>
      <members name="BAR" const="no" kind="function" protection="publi
+c" static="no" virtualness="non_virtual" volatile="no">
        <parameters declaration_name="pciReg" type="Register::Ptr" />
      </members>
      <members name="~BAR" const="no" kind="function" protection="publ
+ic" static="no" type="virtual" virtualness="virtual" volatile="no">
      </members>
    </public_methods>
  </classes>
</apiroot>
[download]

<?xml version='1.0' standalone='yes'?>
<apiroot>
  <classes name="Panoply::AttributeDesc">
    <all_members name="AttributeDesc" protection="public" scope="Panop
+ly::AttributeDesc" virtualness="non_virtual" />
    <public_members>
      <members name="zxname" kind="variable" protection="public" stati
+c="no" type="std::string" virtualness="non_virtual">
      </members>
      <members name="value" kind="variable" protection="public" static
+="no" type="std::string" virtualness="non_virtual">
      </members>
    </public_members>
  </classes>
  <classes name="Panoply::BAR">
    <all_members name="BAR" protection="public" scope="Panoply::BAR" v
+irtualness="non_virtual" />
    <all_members name="type" protection="public" scope="Panoply::BAR" 
+virtualness="pure_virtual" />
    <all_members name="~BAR" protection="public" scope="Panoply::BAR" 
+virtualness="virtual" />
    <public_methods>
      <members name="BAR" const="no" kind="function" protection="publi
+c" static="no" virtualness="non_virtual" volatile="no">
        <parameters declaration_name="pciReg" type="Register::Ptr" />
      </members>
      <members name="~BAR" const="no" kind="function" protection="publ
+ic" static="no" type="virtual" virtualness="virtual" volatile="no">
      </members>
    </public_methods>
  </classes>
</apiroot>
[download]

In reply to Re^4: getting ancestors of element by jccunning
in thread getting ancestors of element by jccunning

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.