#!/usr/bin/perl use strict; use warnings; while() { /^#/ and next; chomp; $_ = join ("\n", split (/-- /, $_ ) ); $_ = &tagparity($_); print $_,"\n\n"; # my $no_tags_stripped; # do { $no_tags_stripped = &tagstrip($_) } unless $no_tags_stripped; # print $_,"\n"; } exit; #Here's -- lotsa tagged words that-- needparity. # This is a pretty stupid sub that will break very easily - lines # 0, 3, 4, 5, 6, and 8 in DATA are mangled beyond belief by this sub sub tagparity() { my $string = shift; my @tags; my @temp; my %pairs; # Find pairs of tags and mate 'em up while ( $string =~ / <([^>]*?)> /gx ) { push(@temp, $1); @temp %2 == 0 or next; $pairs{$temp[0]} = $temp[1]; $pairs{$temp[1]} = $temp[0]; push(@tags, @temp); @temp = (); }; # Try to insert mates my $tag_regex = join('|',@tags); for my $stringbit( split(/\n/, $string ) ) { while ( $stringbit =~ /($tag_regex)/g ) { my $match = $1; my $mate = $pairs{$match}; # If we've matched a closing tag, insert an opening # tag, and vice versa. This is the part that mangles # lines 0, 3, 4, 5, 6, and 8 in DATA if($match =~ m{^/}) { $string =~ s/$stringbit/<$mate>$stringbit/ } else { $string =~ s/$stringbit/$stringbit<$mate>/ } } } return $string; } sub tagstrip() { my $changed = undef; if ( m{ <([^>]*?)> [^<]*? }x ) { while ( m{ <([^>]*?)> [^<]*? }gx ) { my $token = $1; s{<$token>}{}g; s{}{}g; } $changed = 1; } else { while ( m{ ]*?)> }x ) { my $close = $1; if ( m{ <($close[^>]*?)> [^<]*? }x ) { my $open = $1; s{<$open>}{}g; s{}{}g; } } $changed = 1; } return $_, $changed; } __DATA__ #0This is a -- string of -- words 1This is a -- string of -- words 2This is a -- string of -- words #3This is a -- nested tagged string of -- words #4This is a -- nested set of -- tokens #5This is -- an awesome -- search engine #6Truly an -- ugly -- nested string 7Here's -- lotsa tagged words that-- need tag parity. #8This string -- causes -- my box to hang