1

I would like to do add/delete function based on the user's input file.

i have two files. one is user's input file and another one is original xml file. First is checking whether user's request ID is exist in original config or not . if it is exist it will perform delete function , if no ID is exit in original config file, it will perform add function.based on the user's input file request.I start learning perl script.kindly help to suggest how to do add/delete function to the original config file . thanks alot :)

below is my user's input file

add:L83A:55FIP:11:18: #addfunction:DesignID:ProcessID:registerIDs
del:L83A:FRP:149:155:194: #deletefunction:DesignID:ProcessID:registerIDs

here is my original config xml file

<?xml version="1.0" encoding="UTF-8" standalone="no"?>

<Sigma>
<Run>
<DESIGN_ID>L83A</DESIGN_ID>
<PROCESS_ID>55FIP</PROCESS_ID>
<RegisterList>
<Register>70</Register>
<Register>155</Register>
</RegisterList>
</Run>
<Run>
<DESIGN_ID>L83A</DESIGN_ID>
<PROCESS_ID>FRP</PROCESS_ID>
<RegisterList>
<Register>141</Register>
<Register>149</Register>
<Register>151</Register>
<Register>152</Register>
<Register>155</Register>
<Register>194</Register>
</RegisterList>
</Run>
</Sigma>

so the result should comeout by writing xml file

<?xml version="1.0" encoding="UTF-8" standalone="no"?>

<Sigma>
<Run>
<DESIGN_ID>L83A</DESIGN_ID>
<PROCESS_ID>55FIP</PROCESS_ID>
<RegisterList>
<Register>70</Register>
<Register>155</Register>
<Register>11</Register>
<Register>18</Register>
</RegisterList>
</Run>
<Run>
<DESIGN_ID>L83A</DESIGN_ID>
<PROCESS_ID>FRP</PROCESS_ID>
<RegisterList>
<Register>141</Register>
<Register>151</Register>
<Register>152</Register>
</RegisterList>
</Run>
</Sigma>

but my code only replace for 11 and 18 instead of adding . and also cannot perform delete function :(

here is my code:

use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
use feature 'say';
my $filename = 'new.txt';
my $data;
my $run;
open(FILE, '<', $filename) or die $!;
foreach $run(@{XMLin('sigma_loader.xml')->{Run}})  # see how it looks
{
  $data->{$run->{DESIGN_ID}}->{$run->{PROCESS_ID}} =
  {map { $_ => 1 } @{$run->{RegisterList}->{Register}}};
}
while (<FILE>)
{   my $line = $_;
   chomp $line ;
my ($action,$design_id, $process_id, @register_ids) = split /:/, $line; #split the line with add:design_ID:process_ID:register_ID

if(exists $data->{$design_id})
{
 if (exists $data->{$design_id}->{$process_id})
  {
   my $register_id;
foreach $register_id (@register_ids) {
   if (exists $data->{$design_id}->{$process_id}->{$register_id}) {
    say " $design_id: $register_id - existing register ID";
   }
  else {
   say "  $design_id : $register_id - no existing register ID";
   }
   if($action eq 'add')
   {
    $data->{$design_id}->{$process_id}= {$register_id , '1'};
     print Dumper($data);

   }
   if($action eq 'del')
   {
    my $xml = XMLin('sigma_loader.xml', ForceArray => 1, KeepRoot => 1);
    delete $xml->{DESIGN_ID}[0]{PROCESS_ID}[0]{RegisterList}[0]{Register}{$register_id};
    print XMLout($xml, KeepRoot => 1)
  }
  }
}
 else{
   say "$design_id: doesn't have $process_id";
  }
  }
 else
{
   say "$design_id does't exist in data";
}
}
  • 1
    For starters, read [Why is XML::Simple Discouraged?](https://stackoverflow.com/q/33267765/589924) – ikegami May 17 '20 at 10:56

1 Answers1

1

Don't use XML::Simple, use a proper XML module like XML::LibXML. This produces your expected output (with likely-insignificant whitespace differences):

#!/usr/bin/env perl
use warnings;
use strict;
use XML::LibXML;

my $xmlfile = 'sigma_loader.xml';
my $commandfile = 'commands.txt';
my $DEBUG = 1;

my $doc = XML::LibXML->load_xml(location => $xmlfile);

open my $fh, '<', $commandfile or die "$commandfile: $!";
while ( my $line = <$fh> ) {
    chomp($line);
    my ($action,$design_id,$proc_id,@register_ids) = split /:/, $line;
    my @runs = $doc->findnodes("/Sigma/Run[DESIGN_ID='$design_id'"
        ." and PROCESS_ID='$proc_id']");
    print STDERR "Found ".@runs." Run nodes matching DESIGN_ID="
        ."$design_id PROCESS_ID=$proc_id\n" if $DEBUG;
    for my $run (@runs) {
        my ($reglist) = $run->findnodes('./RegisterList')
            or die "Failed to find RegisterList";
        my @regs = $reglist->findnodes('./Register['
            .join(' or ', map {"text()='$_'"} @register_ids).']');
        print STDERR "Found ".@regs." Register nodes for IDs "
            .join(',',@register_ids)."\n" if $DEBUG;
        if ($action eq 'add') {
            my %regs = map { $_->textContent => $_ } @regs;
            for my $regid (@register_ids) {
                next if exists $regs{$regid};
                my $reg = $doc->createElement('Register');
                $reg->appendText($regid);
                $reglist->appendChild($reg);
                print STDERR "Added Register $regid\n" if $DEBUG;
            }
        }
        elsif ($action eq 'del') {
            for my $reg (@regs) {
                print STDERR "Removing Register "
                    .$reg->textContent."\n" if $DEBUG;
                $reglist->removeChild($reg);
            }
        }
        else { die "Unknown action '$action'" }
    }
}

print $doc->toString(1);

Note this makes a few assumptions, like not validating your commands file, assuming that values like $design_id and $proc_id won't break the XPath quoting, assuming there's only one RegisterList per Run, or assuming that within each RegisterList, the Registers are unique. You may have to adjust some of this depending on the specifications of your input files.

haukex
  • 2,973
  • 9
  • 21
  • when i run the code , i get the error Can't locate XML\LibXML.pm in @INC. i tried to install cpan XML::LibLXML in command pmt.but getting time out error. is there anyway to install LibXML ? :( – Pann Phyu Phway May 17 '20 at 13:36
  • Timeout sounds like a network issue. What OS are you on? Depending on that, you may be able to install the module using the system's package manager, for example on Debian/Ubuntu, `sudo apt-get install libxml-libxml-perl`. If you're installing the module from source, like via `cpan` or `cpanm`, you'll need the `libxml2` development package installed (on Debian/Ubuntu, `sudo apt-get install libxml2-dev`). – haukex May 17 '20 at 14:03
  • i am using microsoft windows version 1809 (OS build 17763.1158) – Pann Phyu Phway May 17 '20 at 15:36
  • @PannPhyuPhway [Strawberry Perl](http://strawberryperl.com/) comes with that module preinstalled, and for ActivePerl you should be able to install [XML-LibXML](https://code.activestate.com/ppm/XML-LibXML/) with `ppm`. – haukex May 17 '20 at 15:39
  • seems like my network doesn't have permission for installing such XML:LibXML. :( is there any other way for adding/deleting by using XML::Simple ? – Pann Phyu Phway May 24 '20 at 18:41