g2_form.pl

#! /usr/bin/perl -w

use strict;
use warnings;
use feature 'say';
use XML::LibXML;
use Excel::Writer::XLSX;

my $path = "C:/genie/perl-5.20/scripts/input_files";

my $parser = XML::LibXML->new;
my $old = $parser->parse_file("$path/old.xml")
  or die "Unable to read old.xml : $!";
my $new = $parser->parse_file("$path/new.xml")
  or die "Unabla to read new.xml : $!";

my @fields = qw( order sqlType sqlSize sqlPK sqlNullable sqlAttributes
		 desc group type size formType separ mandatory insert
		 update search show unicity fttype control );

my %old_fields;
for my $field ($old->findnodes('//field')) {
  my $k = $field->findvalue('name');
  for (@fields) {
    $old_fields{$k}{$_} = $field->findvalue($_);
  }
}
my %new_fields;
for my $field ($new->findnodes('//field')) {
  my $k = $field->findvalue('name');
  for (@fields) {
    $new_fields{$k}{$_} = $field->findvalue($_);
  }
}

my ($wk,$ws,$hformat,$fformat) = excel4log();
my $row = 1;
for my $k (sort keys %old_fields) {
  for (sort @fields) {
    if ($old_fields{$k}{$_} ne $new_fields{$k}{$_}) {
      my $col;
      $ws->write_string(++$row,$col++,$k,$fformat);
      $ws->write_string($row,$col++,$_);
      $ws->write_string($row,$col++,$old_fields{$k}{$_});
      $ws->write_string($row,$col++,$new_fields{$k}{$_});
    }
  }
  $row++;
}

sub excel4log {
  my $wk = Excel::Writer::XLSX->new( 'g2_form.xlsx' ) or die $!;
  my $ws = $wk->add_worksheet('Comparaison des formulaires');
  my $hformat = _header_format(\$wk);
  my $fformat = _field_format(\$wk);

  my $col = 0;
  $ws->write_string(0,$col++,$_,$hformat) for (qw(Field Value OLD NEW));

  return ($wk,$ws,$hformat,$fformat);

  sub _field_format {
    my $wk = shift;
    my $format = $$wk->add_format();
    $format->set_bold();
    return $format;
  }
  sub _header_format {
    my $wk = shift;
    my $format = $$wk->add_format();
    $format->set_bold();
    $format->set_align('center');
    return $format;
  }
}