How to create tags from one content to another content using PERL

Question

My string_1 = "Noch befinden wir uns aber in der 1. Generation, so dass diese institutionalisierten Handlungsweisen nach wie vor durchschaubar und als menschliche Konstruktion ersichtlich sind. Der Institutionalisierungsvorgang endet erst im Zuge der <\\i>Internalisierung</i> der Folgegeneration durch die (Prim&#x00E4;r)sozialisation, in der die kollektiven Wissensbest&#x00E4;nde als Teil der subjektiven Wirklichkeit verinnerlicht werden. Erst hierdurch werden die Institutionen als Teil einer absolut wahrgenommenen objektiven Wirklichkeit angesehen. Sie erhalten dadurch objektiven Charakter. Diesen Vorgang der Vergegenst&#x00E4;ndlichung nennt Berger/Luckmann <\\i>Objektivation</i>. Der Eindruck eines menschlichen Erzeugnisses verschwindet. Die Institutionen werden als naturgegebene, unhinterfragbare und nicht ver&#x00E4;nderbare faktische Gegebenheiten angesehen, als kollektiv geteilte Wissensbest&#x00E4;nde. Die Autorit&#x00E4;t der Institution an sich, die sich aus ihrer historisch be dingten Faktizit&#x00E4;t ergibt, sowie die Autorit&#x00E4;t der Bezugspersonen, die gesellschaftliche Institutionen, Normen und Verhaltensweisen &#x00FC;bermitteln, f&#x00FC;hren dabei zu einem regelkonformen Handeln der Nachkommen (Berger/Luckmann <\\sup>21</sup>2007, 62–72). "

My string_2 = "regelkonformen Handeln der Nachkommen (Berger/Luckmann 2007, 62–72)."

---

You can see the above two stings, that string_2 contents are available in string_1 but the only difference is HTML tags.

I want to match string_2 in string_1 and have to create/copy what are the tags inside in string_1 matching area to the string_2 contents.

Kindly anybody give any idea to solve this

Thanks Vimal

Answer 1

You can try this code:

my @wordlist = split(/\s+/, $string_2);

s/([^\pN\pL])/sprintf("(?&sub)?%s(?&sub)?", quotemeta $1)/ge for @wordlist;

my $patterns = qr` (?(DEFINE)
       (?<sctag>   <(?!/)[^>]*+> )  # self closing tag
       (?<fctag>   </[^>]*+> )      # foreign closing tag
       (?<comment> <!-- .*? --> )
       (?<cdata>   \Q<![CDATA[\E .*? ]]> )
       (?<tag>     <(\w++)[^>]*+> (?> [^<]++ | (?&all)
                 | (?!</\g{-1})(?&fctag) )*+ </\g{-1}> )
       (?<all>     \s++ | (?&tag) | (?&comment) | (?&cdata) | (?&sctag) ) 
       (?<sub>     (?> (?&all) | (?&fctag) )++ )
                   ) `xsi;

my $search = join '(?&sub)', @wordlist;

if ($content =~ /$patterns (?<res>$search?)/xsi) {
    print "\n$+{res}";
} else {
    print "\nnot found";
}

The idea is to split string_2 on white characters to obtain a wordlist. Each character in the wordlist that is not a letter or a digit is escaped (if needed) and surrounded with an optional reference to the subpattern (?&all)? . Then all items are joined with (?&all) .

However there is probably a cleaner way using an html parser.

Answer 2

The following script splits the search string on whitespace and then inserts a simplified pattern for random HTML between the words:

use strict;
use warnings;

my $string_1 = do {local $/; <DATA>};

my $string_2 = "regelkonformen Handeln der Nachkommen (Berger/Luckmann 2007, 62&#x2013;72).";

# Build a regex to match HTML interjected at whitespace
my $string2_re = join '(?:\s+|<(\w+)\b.*?</\g{-1}>)+', map quotemeta, split ' ', $string_2;

if ($string_1 =~ /($string2_re)/) {
    print "Matching = '$1'";
}

__DATA__
Noch befinden wir uns aber in der 1. Generation, 
so dass diese institutionalisierten Handlungsweisen nach wie vor durchschaubar 
und als menschliche Konstruktion ersichtlich sind. Der Institutionalisierungsvorgang 
endet erst im Zuge der <i>Internalisierung</i> der Folgegeneration durch die 
(Prim&#x00E4;r)sozialisation, in der die kollektiven Wissensbest&#x00E4;nde als Teil 
der subjektiven Wirklichkeit verinnerlicht werden. Erst hierdurch werden die Institutionen 
als Teil einer absolut wahrgenommenen objektiven Wirklichkeit angesehen. Sie erhalten 
dadurch objektiven Charakter. Diesen Vorgang der Vergegenst&#x00E4;ndlichung nennt 
Berger/Luckmann <i>Objektivation</i>. Der Eindruck eines menschlichen Erzeugnisses 
verschwindet. Die Institutionen werden als naturgegebene, unhinterfragbare und nicht 
ver&#x00E4;nderbare faktische Gegebenheiten angesehen, als kollektiv geteilte 
Wissensbest&#x00E4;nde. Die Autorit&#x00E4;t der Institution an sich, die sich aus ihrer 
historisch bedingten Faktizit&#x00E4;t ergibt, sowie die Autorit&#x00E4;t der 
Bezugspersonen, die gesellschaftliche Institutionen, Normen und Verhaltensweisen 
&#x00FC;bermitteln, f&#x00FC;hren dabei zu 
einem regelkonformen Handeln der <a sdj="asdas"><sup>saddfsdfsad</sup></a> Nachkommen (Berger/Luckmann <sup>21</sup>2007, 62&#x2013;72).

Outputs:

Matching = 'regelkonformen Handeln der <a sdj="asdas"><sup>saddfsdfsad</sup></a> Nachkommen (Berger/Luckmann <sup>21</sup>2007, 62&#x2013;72).'

Note: I answered your cross-post yesterday: How to create tags from one content to another content using PERL . If you're going to spam the internet looking for assistance, don't forget to check back to see if someone responds.

Answer 3

I would do it in two parts: finding and replacing.

1: find match, regardless of HTML tags (easy)

my $string_1="your big  string <H1>to</H1> found here";
my $string_2="string to found";
my $match_str = $string_1;
#cleanup HTML tags for matching
$match_str =~ s!<[^>]*>!!gis;
#check if match could be found
if ($match_str =~ m!$string_2!i){
   print "$string_2 found\n";
}

2: Try to extract the original string (hard). This may works.

use Data::Dumper;
my $string_1="your big  string <H1>to</H1> found here";
my $string_2="string to found";
my $se_string_2 = $string_2;
### replace every space with (?:\s*<[^>]*>\s*)+
$se_string_2 =~ s! !\(\?:\\s\*\<\[\^>\]\*\>\\s\*\)\+!gis;
print Dumper( $string_1,$string_2,$se_string_2);
#check if match could be found
while ($string_1 =~ s!($se_string_2)!!i){
   print "$string_2 found, string with tags: $1\n";
}