Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Check Section closing

by anniyan (Monk)
on Jul 25, 2005 at 05:54 UTC ( #477694=perlquestion: print w/ replies, xml ) Need Help??
anniyan has asked for the wisdom of the Perl Monks concerning the following question:

Monks I am new to perl, i have been asked to modify the codes written by another programmer.

The task is this:

first level section no: 1.1 (two digits) second level section no: 1.1.1 (3 digits) third level section no: 1.1.1.1 (4 digits) fourth level section no: 1.1.1.1.(i) (5 digits) fifth level section no: 1.1.1.1.(i).(a) (6 digits)

example

$q ='<sec id="00005"><no>1.1</no> sfasfasdfadsfsdaf <sec id="00010"><no>1.1.1</no> sahfjsahdfasddfj </sec <sec id="00015"><no>1.1.2</no> sahfjsahdfasddfj <sec id="00020"><no>1.1.2.1</no> sahfjsahdfasddfj </sec> <sec id="00025"><no>1.1.2.2</no> safksajdklfasd </sec> </sec> <sec id="00015"><no>1.1.3</no> sahfjsahdfasddfj </sec> </sec> <sec id="00005"><no>1.2</no> sfasfasdfadsfsdaf ........';

I want to find the section closing for the all the levels. Previously it was written for section starting with 3 digits using xml::Twig, whereas now it starts with section 2 digits. I dont know much about Xml::Twig. I think by just changing some modifications in previous coding we can easily attain this. I tried my level best, but i could not able to achieve. Any help appreciated.

The coding for section starting with 3 digits is here:

my $nstr = $str; $strnew =~ s/<(hsp|top\-border|bottom\-border|link locator|cp type)([^ +>]*)>/<$1$2\/>/gsi; $strnew=~s/<bm>.*<\/bm>//gsi; $strnew=~s/(&[^\s&;<>\n]+;)/'a' x length($1)/egsi; #print ERR $strnew; $strnew=~s/(.*)(<art version)/$2/si; my $lines=$1; my $lineno=$lines=~s/\n/\n/gsi; my $newl; my $newc; my (@no,$no,$id); my $t1= new XML::Twig( start_tag_handlers => { "sec" => sub {$newl=$_[0]->parser->current_line,$newc=$_ +[0]->parser->current_column, $_[1]->set_att(linenum=>$newl,colnum=>$n +ewc),return $_[0]} } ); $t1->parse($strnew); $strnew=$t1->sprint; my $t= new XML::Twig( twig_handlers => { "sec"=>\&process_sec }, PrettyPrint=>"none"); $t->parse($strnew); #$strnew=~s/<sec([^>]*)>\n*<no>(?!(<\/no>.*))<\/no>/<sec$1 val="$2"><n +o>$2<\/no>/gsi; #print ERR $strnew."\n"; $strnew=$t->sprint("art"); my (%ntor,%ntoa); %ntor=('1'=>'(i)','2'=>'(ii)','3'=>'(iii)','4'=>'(iv)','5'=>'(v)','6'= +>'(vi)','7'=>'(vii)','8'=>'(viii)','9'=>'(ix)','10'=>'(x)','11'=>'(xi +)','12'=>'(xii)'); %ntoa=('1'=>'(a)','2'=>'(b)','3'=>'(c)','4'=>'(d)','5'=>'(e)','6'=>'(f +)','7'=>'(g)','8'=>'(h)','9'=>'(i)','10'=>'(j)'); my $p1 = new XML::Parser(Style => 'Subs'); $p1->parse($strnew); my @s; sub sec { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k)=@_; $no++; #print $j."\n"; my $tf=$no; my (@val)=map{$#s=--$_; $s[$_]++; @s}$tf; local $"='.'; my @val1=@val; if (scalar(@val) > 3) { $val1[3]=$ntor{$val[3]}; $val1[4]=$ntoa{$val[4]} if (scalar(@val)>4); } my $tp="@val1"; #print $aid_new.".".$tp."\n"; if ($aid_new1 =~ /^\d{2}$/) { if ($j ne "$aid_new.$tp") { print ERR "\n\n WARNING :Line ".($h + $lineno) ." Col +". (++$d)."\n\tCheck content inside the <no> tag. The value may be $a +id_new.$tp"; } } if ($aid_new1 =~ /^\d$/) { if ($j ne "$aid_news.$tp") { print ERR "\n\n WARNING :Line ".($h + $lineno) ." Col +". (++$d)."\n\tCheck content inside the <no> tag. The value may be $a +id_new.$tp"; } } my ($atts)=$j=~s/\.//gsi; $atts-=1; if ($no != $atts) { #print ERR "Check section Opening at line ", $h + $lineno," and c +olumn $d\n"; print ERR "\n\n WARNING :Line ".($h + $lineno)." Col ". (++$d +)."\n\tCheck section Opening"; } #print $no."\n"; } sub sec_ { my ($a,$b)=@_; $no--; #print $no."\n"; } sub process_sec { my ($a,$b)=@_; my $p=$b->first_child_text("no"); #print $p."\n"; $b->set_att(val=>$p); #$b->sprint; return $b; }

Regards,
Anniyan
(CREATED in HELL by DEVIL to s|EVILS|GOODS|g in WORLD)

READMORE tags added by Arunbear

Comment on Check Section closing
Select or Download Code
Re: Check Section closing
by Anonymous Monk on Jul 26, 2005 at 03:20 UTC
    if ($aid_new1 =~ /^\d{2}$/) The \d{2} means match 2 digits

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://477694]
Approved by jbrugger
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (8)
As of 2014-09-23 11:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (219 votes), past polls