in reply to Re^2: twig inbuilt methods to sort whole xml tree
in thread twig inbuilt methods to sort whole xml tree

Update: Replaced code with tested , working code.

This creates an artificial sort order, in order to implement higher priority for specifed elements (Up to 9999 of these). 

#!/bin/perl -w
use strict;
use XML::Twig;

my $twig= XML::Twig->new(pretty_print=>'indented');

$twig->parse(\*DATA);
my $root=$twig->root;

$root->first_child->sort_children_on_att("type");

#Specify list of items (mainterm) that are forced FIRST in the sort or
+der
sort_my_kids($root,['mainterm',]);

$twig->print;

sub sort_my_kids{
   my ($me,$OrderTheseFirst) = @_;
   $me->sort_children(
         # Use special sort "get_key" sub, to specify artificial sort 
+order
         # Generated key is: 4-digit "Specified order", Tag, Value
     sub{my $el=shift; 
             my $tag=$el->tag; 
             my ($i)= (grep({$tag eq $OrderTheseFirst->[$_]} 0..$#$Ord
+erTheseFirst) , 9999);
             ##Debug# printf "  %04d%s\t",$i,$tag;
             return (sprintf "%04d%s%s",$i,$tag,$el->text_only());
             }        
    );
    foreach my $kid($me->children){
        sort_my_kids($kid,$OrderTheseFirst); # Recursive
    }    
}

[download]
Add your own __DATA__ section.

     Theory is when you know something, but it doesn't work.
    Practice is when something works, but you don't know why it works.
    Programmers combine Theory and Practice: Nothing works and they don't know why.         -Anonymous

Replies are listed 'Best First'.
Re^4: twig inbuilt methods to sort whole xml tree
by bharathinc (Novice) on Mar 10, 2010 at 09:10 UTC

    Thank you Dear, your coding is fentastic. This solution is working. Even I did my code as below. But my code was specific to elements.Here is my code

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

my (@sortedM, @sortedL);
my $i=0;
my $twig= new XML::Twig(twig_handlers => { 
                                'enhancement' => sub {$_->first_child-
+>sort_children_on_att("type");},
                                'descriptor' => \&sortSubEltsHandler,
                            },
                        pretty_print => 'indented',    
            keep_atts_order => 1,
            );            
$twig->parse(\*DATA); 
$twig->print;
$twig->purge;

sub sortSubEltsHandler
{     
    my( $t,$elt)= @_;
    my $root= $t->root;    
    my @mainterms = $root->descendants(q{mainterm});
       @sortedM = reverse sort { $a->text cmp $b->text }
        @mainterms;
    my @links = $root->descendants(q{link});
       @sortedL =reverse sort { $a->text cmp $b->text }
        @links;
    $elt->cut_children;
    foreach my $mainterm (@sortedM) {
    my $new_elt= XML::Twig::Elt->new($mainterm->name => $mainterm->tex
+t);
    $new_elt->paste($elt);
    }
    foreach my $link (@sortedL) {
    my $new_elt= XML::Twig::Elt->new($link->name => $link->text);
    $new_elt->paste($elt);
    }
}#end of sortSubEltsHandler

__DATA__
<enhancement>
<descriptorgroup>
<descriptors type="MED" controlled="y">
<descriptor>
<mainterm weight="a">plague</mainterm>
<mainterm>disease</mainterm>
<mainterm>pestilence</mainterm>
<link>f</link>
<link>C</link>
<link>M</link>
</descriptor>
</descriptors>
<descriptors type="DRG" controlled="y">
<descriptor>
<mainterm>panadol</mainterm>
<mainterm weight="a">zorro</mainterm>
<mainterm>xenon</mainterm>
<mainterm weight="a">aspirin</mainterm>
<link>b</link>
<link>P</link>
<link>z</link>
</descriptor>
</descriptors>
</descriptorgroup>
</enhancement>

    [download]
[reply]
[d/l]

      hi NetWallah, I am getting below warning messages more than 200 times. When I ran earlier your code, I did not get this message. now I am getting this. I even added prints in between to check where the variable is not initialized. I could not trace. Use of uninitialized value in string comparison (cmp) at C:/Perl/site/lib/XML/twig.pm line 8820, <DATAFILE> line 9. XML I have tested is as below. Earlier xml was simple, but this is complex. Could u please help me how to solve this error. thank you in advance

      Read more... (63 kB)
[reply]
        The XML you posted was incomplete - I had to trim and balance it to make it work, but it works ok after that, producing: 
        ?xml version="1.0" encoding="UTF-8"?>
<bibdataset xmlns="http://www.elsevier.com/xml/ani/ani" xmlns:ait="htt
+p://www.elsevier.com/xml/ani/ait" xmlns:ce="http://www.elsevier.com/x
+ml/ani/common" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 
+xsi:schemaLocation="http://www.elsevier.com/xml/ani/ani http://www.el
+sevier.com/xml/ani/ani512.xsd">
  <item>
    <ait:process-info>
      <ait:date-delivered day="04" month="03" year="2010"></ait:date-d
+elivered>
      <ait:date-sort day="1" month="1" year="2000"></ait:date-sort>
      <ait:status stage="S300" state="new" type="core"></ait:status>
    </ait:process-info>
    <bibrecord>
      <head>
        <abstracts>
          <abstract original="y">
            <ce:para>Controversy exists concerning the correct surgica
+l management 
            .....</ce:para>
          </abstract>
        </abstracts>
        <author-group>
          <affiliation country="usa">
            <address-part>3000 W Cypress Creek Rd</address-part>
            <city-group>Fort Lauderdale, FL 33309</city-group>
            <organization>Department of Colorectal Surgery, Cleveland 
+Clinic Florida</organization>
          </affiliation>

....

        [download]
        The reason you and I are getting the 
        Use of uninitialized value in string comparison (cmp) at /usr/share/pe
+rl5/XML/Twig.pm line 8567.
Use of uninitialized value in string comparison (cmp) at /usr/share/pe
+rl5/XML/Twig.pm line 8567.

        [download]
        is because the statement
                $root->first_child->sort_children_on_att("type")
        requires the first child ("item", in your data) to contain the attribute "type", but it does not.

        You need to decide what attribute name you want the xml order to be based on, and pass the right parameter.

             Theory is when you know something, but it doesn't work.
            Practice is when something works, but you don't know why it works.
            Programmers combine Theory and Practice: Nothing works and they don't know why.         -Anonymous

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom