Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
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 exploiting the Monastery: (6)
As of 2014-11-23 10:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (129 votes), past polls