1

I have an xml data shown below. I want to do some manipulations on this data. Whenever 'colname' attribute is missing from 'entry' tag, my code should insert that attribute taking the values from 'cols' attribute in 'tgroup' tag.

<tbl ID="I78">
<table colsep="0" frame="none" rowsep="0">
<tgroup cols="4">
<tbody valign="top">
<row>
<entry>i.</entry>
<entry>181.10</entry>
<entry>An inmate shall comply with the dispositions imposed by a hearing officer in a Tier I, Tier II and Tier III hearings.</entry>
<entry>I, II, III</entry>
</row>
</tbody>
</tgroup>
</table>
</tbl>
<tbl ID="I93">
<table colsep="0" frame="none" rowsep="0">
<tgroup cols="4">
<tbody>
<row>
<entry align="center"><ital>Pledge number</ital></entry>
<entry align="center"><ital>Date</ital></entry>
<entry align="center"><ital>R</ital></entry>
<entry><ital>A or S</ital></entry>
</row>
<row>
<entry><ital>Disposition column</ital></entry>
<entry>(<ital>Renewed</ital>)</entry>
<entry>(<ital>Renewed</ital>)</entry>
</row>
<row>
<entry>(<ital>Auction Sale</ital>)</entry>
</row>
</tbody>
</tgroup>
<eos></eos>
</table>
<eop></eop>
</tbl>

My code is shown below:

foreach $line (@data){
    if($line =~ /<tgroup(.*?)cols=\"(.*?)\">/i){
      $colcount=$2;
        print "\nTgroup tag found... no of cols are $colcount";
    }

    $templine=$line;
    my $temp2line;

    while($templine=~ /<tbody(.*?)>(.*?)<\/tbody>/){
        $temp2line=$2;
        while($temp2line=~ /<row>(.*?)<\/row>/){
            $rowdata=$1;
            $rowdataforfinalreplacing=$rowdata;
            $temprowdata=$rowdata;
            while($rowdata=~/<entry align="center">/i){
                for ($i; $i<= $colcount; $i++){
                    $temprowdata=~s/<entry align="center">/<entry align="center" colname=\"$i\">/i;
                    print "\ni value :$i";
                }
                $rowdata=~s/<entry(.*?)<\/entry>//;
            }
            while($rowdata=~/<entry>/i){
                for (my $i=1; $i<= $colcount; $i++){
                    $temprowdata=~s/<entry>/<entry colname=\"$i\">/i;
                }
                $rowdata=~s/<entry>(.*?)<\/entry>//;
            }
            $temp2line=~s/<row>(.*?)<\/row>//i;
            $line=~s/$rowdataforfinalreplacing/$temprowdata/sgi;
        }
    }

The problem is, when two rows are present simultaneously, only one row is getting updated. when I debug, I found the values are getting updated correctly, but while writing to the output file, they are being ignored. I am unable to find out where the control is going wrong in my code. Any help on this is highly appreciated. Thanks in advance !

Here is the output of the code.. The highlighted data is not getting updated.

Here is the output of the code

2 Answers 2

6

Please, don't use regular expression to parse xml data. It's a pain.

Said that, your xml data is not well formed because you have several root tags. I've added <root> to make it well formed.

Here you have an example with XML::Twig:

#!/usr/bin/env perl

use warnings;
use strict;
use XML::Twig;

my ($colname);

XML::Twig->new(
    start_tag_handlers => {
        'tgroup' => sub { $colname = $_->att('cols') },
    },
    twig_handlers => {
        'entry' => sub { $_->set_att('colname', $colname) },
    },
    pretty_print => 'indented',
)->parsefile(shift)->print;

Run it like:

perl script.pl xmlfile

That yields:

<root>
  <tbl ID="I78">
    <table colsep="0" frame="none" rowsep="0">
      <tgroup cols="4">
        <tbody valign="top">
          <row>
            <entry colname="4">i.</entry>
            <entry colname="4">181.10</entry>
            <entry colname="4">An inmate shall comply with the dispositions imposed by a hearing officer in a Tier I, Tier II and Tier III hearings.</entry>
            <entry colname="4">I, II, III</entry>
          </row>
        </tbody>
      </tgroup>
    </table>
  </tbl>
  <tbl ID="I93">
    <table colsep="0" frame="none" rowsep="0">
      <tgroup cols="4">
        <tbody>
          <row>
            <entry align="center" colname="4">
              <ital>Pledge number</ital>
            </entry>
            <entry align="center" colname="4">
              <ital>Date</ital>
            </entry>
            <entry align="center" colname="4">
              <ital>R</ital>
            </entry>
            <entry colname="4">
              <ital>A or S</ital>
            </entry>
          </row>
          <row>
            <entry colname="4">
              <ital>Disposition column</ital>
            </entry>
            <entry colname="4">(<ital>Renewed</ital>)</entry>
            <entry colname="4">(<ital>Renewed</ital>)</entry>
          </row>
          <row>
            <entry colname="4">(<ital>Auction Sale</ital>)</entry>
          </row>
        </tbody>
      </tgroup>
      <eos></eos>
    </table>
    <eop></eop>
  </tbl>
</root>

UPDATE to increment colname attribute. See comments.

#!/usr/bin/env perl

use warnings;
use strict;
use XML::Twig;

my ($colname, $n);

XML::Twig->new(
        start_tag_handlers => {
                'tgroup' => sub { $colname = $_->att('cols') },
                'row' => sub { $n = 1 },
        },
        twig_handlers => {
                'entry' => sub { $_->set_att('colname', $n++) },
        },
        pretty_print => 'indented',
)->parsefile(shift)->print;
8
  • does running this script will overwrite the source file? I see only one argument being passed to this.. Nov 24, 2013 at 13:21
  • @RaviKumar: No. It will print it to the shell. Redirect it to a file, like: perl script.pl xmlfile >out_xmlfile
    – Birei
    Nov 24, 2013 at 13:26
  • ok. In each row, if there are four entry tags, the colname value should increment from 1 to 4. Your output shows constant value. How can i change it? Nov 24, 2013 at 13:34
  • @RaviKumar: Was that requirement in the original question or is it a new one?
    – Birei
    Nov 24, 2013 at 14:16
  • It was there when I first saw the question. Nov 24, 2013 at 15:08
3

Your <row>(.*)</row> does not respect XML nesting. I.e., you have something like

<row>
   ...
   <row>
      ...
   </row>
   <row>
      ...
   </row>
</row>

and the outer loop only picks up everything up to the end of the first inner row element and operates on that.

Lesson? Don’t use regular expressions for XML parsing. It can be done in languages like Perl with their extended RE grammars, but it gets really messy soon. You’re better off using a proper XML library.

4
  • I'm pretty much new to perl and working on xml nesting for the first time. Thanks for the advice, I will make a note of this. Nov 24, 2013 at 13:21
  • 1
    ... if you see a regex parse it don't forget to scream! :)
    – Zaid
    Nov 24, 2013 at 14:16
  • I've given <row>(.*?)<\/row> which should stumble upon first </row> and I don't have nested rows in the xml data. Nov 24, 2013 at 16:17
  • True – the indenting in your screenshot looks like you did, though. Nov 24, 2013 at 16:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.