| 1 |
3 |
ahitrov@rambler.ru |
package Jevix::Makeup; |
| 2 |
|
|
|
| 3 |
|
|
# ========================================== |
| 4 |
|
|
# |
| 5 |
|
|
# Jevix Version 0.9.5 (windows-1251) |
| 6 |
|
|
# |
| 7 |
|
|
# Developed by Igor Askarov |
| 8 |
|
|
# |
| 9 |
|
|
# Please send all suggestions to |
| 10 |
|
|
# Igor Askarov <juks@juks.ru> |
| 11 |
|
|
# http://www.jevix.ru/ |
| 12 |
|
|
# |
| 13 |
|
|
# Release date: 21/01/2008 |
| 14 |
|
|
# |
| 15 |
|
|
# === Methods list========================== |
| 16 |
|
|
# |
| 17 |
|
|
# new the constructor |
| 18 |
|
|
# procces entry sub |
| 19 |
|
|
# preset presets selector |
| 20 |
|
|
# makeup makeup the text |
| 21 |
|
|
# quotes quotes processor |
| 22 |
|
|
# cuttags tags processor |
| 23 |
|
|
# tagend looking fo tag end |
| 24 |
|
|
# planttags sub to bring the tags back |
| 25 |
|
|
# vanish sub to remove all the stuff and bring the text to plain mode |
| 26 |
|
|
# parseTagsAllowString parse the tagsAllow string to hash |
| 27 |
|
|
# parseTagsDenyString parse the tagsDeny string to hash |
| 28 |
|
|
# |
| 29 |
|
|
# ========================================== |
| 30 |
|
|
|
| 31 |
|
|
use strict; |
| 32 |
|
|
use warnings; |
| 33 |
|
|
|
| 34 |
|
|
my $markLength = 7; |
| 35 |
|
|
my $strip; |
| 36 |
|
|
my $result; |
| 37 |
|
|
my $tags; |
| 38 |
|
|
my $conf; |
| 39 |
|
|
|
| 40 |
|
|
my @singleTags = qw/link input spacer img br hr/; |
| 41 |
|
|
my @breakingTags = qw/p td div hr/; |
| 42 |
|
|
my @spaceTags = qw/br/; |
| 43 |
|
|
my @tagsToEat = qw/script style/; |
| 44 |
|
|
|
| 45 |
|
|
# ==The constructor |
| 46 |
|
|
sub new { |
| 47 |
|
|
my Jevix::Makeup $class = shift; |
| 48 |
|
|
|
| 49 |
|
|
return $class; |
| 50 |
|
|
} |
| 51 |
|
|
|
| 52 |
|
|
# ==Here we've got the input |
| 53 |
|
|
sub process($$$) { |
| 54 |
|
|
my($class, $text, $userConfig) = @_; |
| 55 |
|
|
|
| 56 |
|
|
$conf = $userConfig ? $userConfig : {presetBasic=>1}; |
| 57 |
|
|
$class->preset(); |
| 58 |
|
|
|
| 59 |
|
|
$strip = ""; |
| 60 |
|
|
$tags = []; |
| 61 |
|
|
|
| 62 |
|
|
$result = {}; |
| 63 |
|
|
$result->{error} = 0; |
| 64 |
|
|
$result->{errorLog} = []; |
| 65 |
|
|
|
| 66 |
|
|
if(!$conf->{isHTML}) { $strip = $$text; } else { $class->cuttags($text, $conf, $result); } |
| 67 |
|
|
if($conf->{quotes}) { $class->quotes($conf); } |
| 68 |
|
|
$class->makeup($conf); |
| 69 |
|
|
|
| 70 |
|
|
$result->{text} = ""; |
| 71 |
|
|
if($conf->{isHTML}) { $class->planttags($result); } else { $result->{text} = $strip; } |
| 72 |
|
|
|
| 73 |
|
|
return $result; |
| 74 |
|
|
} |
| 75 |
|
|
|
| 76 |
|
|
# ==Choosing default setup when necessary |
| 77 |
|
|
sub preset($$) { |
| 78 |
|
|
my ($class) = @_; |
| 79 |
|
|
|
| 80 |
|
|
if(!$conf || $conf->{presetBasic}) { |
| 81 |
|
|
$conf->{isHTML} = 1 if(!defined($conf->{isHTML})); # HTML mode |
| 82 |
|
|
$conf->{lineBreaks} = 1 if(!defined($conf->{lineBreaks})); # Linebreaks to <br/> |
| 83 |
|
|
$conf->{paragraphs} = 0 if(!defined($conf->{paragraphs})); # Paragraphs |
| 84 |
|
|
$conf->{dashes} = 1 if(!defined($conf->{dashes})); # Replace hyphens with dashes when necessary |
| 85 |
|
|
$conf->{dots} = 1 if(!defined($conf->{dots})); # Replace 3 dots with a symbol |
| 86 |
|
|
$conf->{edgeSpaces} = 1 if(!defined($conf->{edgeSpaces})); # Wipe edge space characters |
| 87 |
|
|
$conf->{multiSpaces} = 1 if(!defined($conf->{multiSpaces})); # Wipe multispaces |
| 88 |
|
|
$conf->{redundantSpaces} = 1 if(!defined($conf->{redundantSpaces})); # Wipe redundant spaces |
| 89 |
|
|
$conf->{compositeWordsLength} = 10 if(!defined($conf->{compositeWordsLength})); # The maximim length of composite word to be put inside <nobr> |
| 90 |
|
|
$conf->{tagLf} = 1 if(!defined($conf->{tagLf})); # Wipe crs and lfs after droppped tag |
| 91 |
|
|
$conf->{nbsp} = 1 if(!defined($conf->{nbsp})); # Insert non-breaking spaces |
| 92 |
|
|
$conf->{quotes} = 1 if(!defined($conf->{quotes})); # Makeup quotes |
| 93 |
|
|
$conf->{qaType} = 0 if(!defined($conf->{qaType})); # Main quotes type |
| 94 |
|
|
$conf->{qbType} = 2 if(!defined($conf->{qbType})); # Nested quotes type |
| 95 |
|
|
$conf->{misc} = 1 if(!defined($conf->{misc})); # Misc substitutions |
| 96 |
|
|
$conf->{codeMode} = 2 if(!defined($conf->{codeMode})); # The way jevix should represent html special characters |
| 97 |
|
|
} |
| 98 |
|
|
|
| 99 |
|
|
# If tagsAllow came as a string |
| 100 |
|
|
if(defined($conf->{tagsAllow}) && !ref($conf->{tagsAllow})) { |
| 101 |
|
|
my $tmp = $class->parseTagsAllowString($conf->{tagsAllow}); |
| 102 |
|
|
$conf->{tagsAllow} = $tmp->{tagsAllow}; |
| 103 |
|
|
$conf->{tagsDenyAllAttributes} = $tmp->{tagsDenyAllAttributes}; |
| 104 |
|
|
} |
| 105 |
|
|
|
| 106 |
|
|
# If tagsDeny came as a string |
| 107 |
|
|
if(defined($conf->{tagsDeny}) && !ref($conf->{tagsDeny})) { |
| 108 |
|
|
$conf->{tagsDeny} = $class->parseTagsDenyString($conf->{tagsDeny}); |
| 109 |
|
|
} |
| 110 |
|
|
} |
| 111 |
|
|
|
| 112 |
|
|
# ==Imposing clear text |
| 113 |
|
|
sub makeup($$) { |
| 114 |
|
|
my ($class, $conf) = @_; |
| 115 |
|
|
|
| 116 |
|
|
# ==Misc |
| 117 |
|
|
# Prepositions |
| 118 |
|
|
my $prp_rus = "�|���|����|�|���|��|��|���|��|��|�|��|���|���|�|���|��|���|����|��|��|��|�|��|���|�����|��|���|��|���|����|���|���|�|������|��|�|�����"; |
| 119 |
|
|
my $prp_eng = "aboard|about|above|absent|across|after|against|along|alongside|amid|amidst|among|amongst|around|as|astride|at|atop|before|behind|below|beneath|beside|besides|between|beyond|but|by|despite|down|during|except|following|for|from|in|inside|into|like|mid|minus|near|nearest|notwithstanding|of|off|on|onto|opposite|out|outside|over|past|re|round|save|since|than|through|throughout|till|to|toward|towards|under|underneath|unlike|until|up|upon|via|with|within|without"; |
| 120 |
|
|
my $prp = "$prp_rus|$prp_eng"; |
| 121 |
|
|
|
| 122 |
|
|
my $letters = "A-Za-z�-��-ѳ���"; # Characters |
| 123 |
|
|
my $cap_letters = "A-Z�-�"; # Capital characters |
| 124 |
|
|
|
| 125 |
|
|
my $sp = " \xA0\t"; # space class |
| 126 |
|
|
my $rt = "\r?\n"; # cr class |
| 127 |
|
|
|
| 128 |
|
|
my $br = "\x00\x0F.[\x01\x03].\x0F\x00"; # br tag |
| 129 |
|
|
my $pt = "\x00\x0F.[\x02].\x0F\x00"; # Paragraph tag |
| 130 |
|
|
my $ps = "\x00\x0F.[\x02][\x01\x03]\x0F\x00"; # Paragraph start |
| 131 |
|
|
my $pe = "\x00\x0F.[\x02][\x02\x00]\x0F\x00"; # Paragraph end |
| 132 |
|
|
my $to = "\x00\x0F..[\x03\x01]\x0F\x00"; # Opening tag |
| 133 |
|
|
my $tc = "\x00\x0F..[\x02\x00]\x0F\x00"; # Closing tag |
| 134 |
|
|
my $bb = "\x00\x0F..[\x02\x03]\x0F\x00"; # Tag where <nobr> is open |
| 135 |
|
|
my $nb = "\x00\x0F..[\x01\x00]\x0F\x00"; # Tag where no <nobr> open |
| 136 |
|
|
my $ts = "\x00\x0F"; # Tag start |
| 137 |
|
|
my $te = "\x0F\x00"; # Tag end |
| 138 |
|
|
|
| 139 |
|
|
my $brt = "<br *\/?>"; # br tag in text mode |
| 140 |
|
|
my $pst = "<p>"; |
| 141 |
|
|
my $pet = "</p>"; |
| 142 |
|
|
|
| 143 |
|
|
# Codes, metasymbols or what ever? |
| 144 |
|
|
my ($cdash, $cnbsp, $cdots, $cfracs, $ccopy, $creg); |
| 145 |
|
|
if(!$conf->{codeMode}) { |
| 146 |
|
|
($cdash, $cnbsp, $cdots, $ccopy, $creg) = ("�", "�", "�", "�", "�"); |
| 147 |
|
|
$cfracs = {'1/4'=>"?", '1/2'=>"?", '3/4'=>"?"}; |
| 148 |
|
|
} elsif($conf->{codeMode} == 1) { |
| 149 |
|
|
($cdash, $cnbsp, $cdots, $ccopy, $creg) = ("—", " ", "…", "©", "®"); |
| 150 |
|
|
$cfracs = {'1/4'=>"¼", '1/2'=>"½", '3/4'=>"¾"}; |
| 151 |
|
|
} else { |
| 152 |
|
|
($cdash, $cnbsp, $cdots, $ccopy, $creg) = ("—", " ", "…", "©", "®"); |
| 153 |
|
|
$cfracs = {'1/4'=>"¼", '1/2'=>"½", '3/4'=>"¾"}; |
| 154 |
|
|
} |
| 155 |
|
|
|
| 156 |
|
|
# Wiping edge spaces |
| 157 |
|
|
if($conf->{edgeSpaces}) { $strip =~ s/^[$sp\r\n]*(.+?)[$sp\r\n]*$/$1/isg; } |
| 158 |
|
|
|
| 159 |
|
|
# Wiping spaces between tags (</td> </tr>) |
| 160 |
|
|
if($conf->{tagSpaces}) { $strip =~ s/($tc)[$sp]($tc)/$1$2/isg; } |
| 161 |
|
|
|
| 162 |
|
|
# Wiping multispaces |
| 163 |
|
|
if($conf->{multiSpaces}) { $strip =~ s/([$sp]){2,}/$1/ig; } |
| 164 |
|
|
|
| 165 |
|
|
# Wiping redundant spaces |
| 166 |
|
|
if($conf->{redundantSpaces}) { $strip =~ s{([$sp]+(?![:;]-[)(])([;:,.)?!]))|(\()(?<![:%;]-\()[$sp]+}{$1 ? $2 : $3}eig; } |
| 167 |
|
|
|
| 168 |
|
|
if($conf->{nbsp}) { |
| 169 |
|
|
# Prepositions with |
| 170 |
|
|
$strip =~ s/(^|\x00|[$sp])($prp)[$sp]([0-9$letters])/$1$2$cnbsp$3/gm; |
| 171 |
|
|
|
| 172 |
|
|
# with digits |
| 173 |
|
|
$strip =~ s{($nb|^)(.*?)($bb|$)}{ my ($a, $b, $c) = ($1, $2, $3); $b =~ s/([0-9]+)([$sp]+| | )(?:(?=[0-9]{2,})|(?=%))/$1$cnbsp/ig; "$a$b$c"; }eisg; |
| 174 |
|
|
} |
| 175 |
|
|
|
| 176 |
|
|
# Put composite words inside <nobr> |
| 177 |
|
|
if($conf->{compositeWords}) { $strip =~ s{($nb|^)(.*?)($bb|$)}{ my ($a, $b, $c) = ($1, $2, $3); |
| 178 |
|
|
$b =~ s{(^|[$sp\x00]| )([$letters]+(?:-[$letters]+)+)(?=$|[$sp\x00])}{ |
| 179 |
|
|
my $d = !defined($1) ? "" : $1; my $e = !defined($2) ? "" : $2; my $f = !defined($3) ? "" : $3; |
| 180 |
|
|
if(length($e) <= $conf->{compositeWordsLength}) { "$d<nobr>$e<\/nobr>" } else {"$d$e$f"} |
| 181 |
|
|
}eig; "$a$b$c"; |
| 182 |
|
|
}eisg; } |
| 183 |
|
|
|
| 184 |
|
|
# Dots |
| 185 |
|
|
if($conf->{dots}) { $strip =~ s/\.{3}|�|…/$cdots/ig; } |
| 186 |
|
|
|
| 187 |
|
|
# Dashes |
| 188 |
|
|
if($conf->{dashes}) { |
| 189 |
|
|
# Hyphen |
| 190 |
|
|
$strip =~ s/([^$sp])([$sp]| | )(-{1,2}|�|—|—)/$1$cnbsp$cdash/ig; |
| 191 |
|
|
# "Speech" hyphen |
| 192 |
|
|
$strip =~ s/((?:^|$ps|$br|$brt(?:$rt)*|[$rt]))[$sp]*(?: )*(-{1,2}|�|—|—)[$sp]*(?: )*(.)/$1$cdash$cnbsp$3/ig; |
| 193 |
|
|
} |
| 194 |
|
|
|
| 195 |
|
|
# Misc stuff |
| 196 |
|
|
if($conf->{misc}) { |
| 197 |
|
|
# Fracs |
| 198 |
|
|
$strip =~ s{(?:(?<=[$sp\x00])|(?<=^))([13])/([24])(?:(?=[$sp\x00])|(?=$))}{if(defined($cfracs->{"$1/$2"})) { $cfracs->{"$1/$2"} } else { "$1/$2" } }esg; |
| 199 |
|
|
# Copyright & registered |
| 200 |
|
|
$strip =~ s{(?:(?<=[$sp\x00])|(?<=^))(\([cr]\)|©|�)(?:(?=[$sp\x00?!;.,])|(?=$))}{ if((lc($1) eq "(c)") || (lc($1) eq "©") || ($1 eq "�")) {$ccopy} elsif((lc($1) eq "(r)") || (lc($1) eq "®") || ($1 eq "�")) {$creg} else { $2 } }eig; |
| 201 |
|
|
} |
| 202 |
|
|
|
| 203 |
|
|
# Paragraphs |
| 204 |
|
|
if($conf->{paragraphs}) { $strip =~ s{(^|$pe(?:$rt$rt)?|$rt$rt)(?!$ps)(.+?)($br)?($brt)?(?<!$pe)(?:(?=$)|(?=$rt$rt)|(?=$ps))}{ my ($a, $b, $c) = ($1,$2,$3||""); (($b =~ /^[ \r\n]+$/) || ($b =~ /^(<br *\/?>|$br)+$/)) ? "$a$b$c" : "$a<p>$b</p>";}eisg; } |
| 205 |
|
|
|
| 206 |
|
|
# Line break |
| 207 |
|
|
if($conf->{lineBreaks}) { $strip =~ s/(?<!$pt)(?<!$br)(?<!$br\r)(?<!$pe\r\n\r\n)(?<!$pe\n\n)(?<!$pe\r\n)(?<!$pe\n)(?<!$pe\r)(?<!$pe)(?<!$pet\r\n\r\n)(?<!$pet\r\n\r)(?<!$pet\n\n)(?<!$pet\r\n)(?<!$pet\n)(?<!$pet\r)(?<!$pet)(?<!$pst)($rt)(?!$brt)/<br \/>$1/isg; } |
| 208 |
|
|
} |
| 209 |
|
|
|
| 210 |
|
|
# ==impose quotes |
| 211 |
|
|
sub quotes($$) { |
| 212 |
|
|
my ($class, $conf) = @_; |
| 213 |
|
|
|
| 214 |
|
|
my $i; |
| 215 |
|
|
my ($a_open, $b_open) = (0,0); |
| 216 |
|
|
my ($cp, $c, $cn, $cn_is_sp, $cp_is_sp) = ('', '', '', 0, 0); |
| 217 |
|
|
my ($qaStart, $qaEnd, $qbStart, $qbEnd); |
| 218 |
|
|
my (@qs, @qe, @qs_ansi, @qe_ansi, @qs_html, @qe_html, @qs_ent, @qe_ent,); |
| 219 |
|
|
|
| 220 |
|
|
# space class |
| 221 |
|
|
my $sp =" \t\xA0"; |
| 222 |
|
|
# characters |
| 223 |
|
|
my $letters = "A-Za-z�-��-ѳ���"; |
| 224 |
|
|
|
| 225 |
|
|
@qs_ansi = ("�", "�", "�", "�", "�", '"'); |
| 226 |
|
|
@qe_ansi = ("�", "�", "�", "�", "�", '"'); |
| 227 |
|
|
@qs_html = ("«", "“", "„", "‘", "‚", """); |
| 228 |
|
|
@qe_html = ("»", "”", "“", "’", "‘", """); |
| 229 |
|
|
# << `` .. ` . " |
| 230 |
|
|
@qs_ent = ("«", "“", "„", "‘", "‚", """); |
| 231 |
|
|
# >> '' '' ' ` " |
| 232 |
|
|
@qe_ent = ("»", "”", "“", "’", "‘", """); |
| 233 |
|
|
|
| 234 |
|
|
# Quotes collection |
| 235 |
|
|
if(!$conf->{codeMode}) { |
| 236 |
|
|
@qs = @qs_ansi; @qe = @qe_ansi; |
| 237 |
|
|
} elsif ($conf->{codeMode} == 1) { |
| 238 |
|
|
@qs = @qs_html; @qe = @qe_html; |
| 239 |
|
|
} else { |
| 240 |
|
|
@qs = @qs_ent; @qe = @qe_ent; |
| 241 |
|
|
} |
| 242 |
|
|
|
| 243 |
|
|
# Getting configuration setting |
| 244 |
|
|
$conf->{qaType} ||= 0; |
| 245 |
|
|
$conf->{qbType} ||= 1; |
| 246 |
|
|
$conf->{qaType} = ($conf->{qaType} >= 0 && $conf->{qaType} <= 5) ? $conf->{qaType} : 0; |
| 247 |
|
|
$conf->{qbType} = ($conf->{qbType} >= 0 && $conf->{qbType} <= 5) ? $conf->{qbType} : 1; |
| 248 |
|
|
|
| 249 |
|
|
# Selecting quotes as requested by user |
| 250 |
|
|
($qaStart, $qaEnd) = ($qs[$conf->{qaType}], $qe[$conf->{qaType}]); |
| 251 |
|
|
($qbStart, $qbEnd) = ($qs[$conf->{qbType}], $qe[$conf->{qbType}]); |
| 252 |
|
|
|
| 253 |
|
|
# Resetting all the quotes inside text to <"> |
| 254 |
|
|
my $qa = join('|', @qs_ansi) . '|' . join('|', @qe_ansi) . '|' . join('|', @qs_html) . '|' . join('|', @qe_html) . '|' . join('|', @qs_ent) . '|' . join('|', @qe_ent); |
| 255 |
|
|
$strip =~ s/(?:(?:(?<=[^$letters])|(?<=^))($qa))|(?:($qa)(?:(?=[^$letters])|(?=$)))/\"/ig; |
| 256 |
|
|
|
| 257 |
|
|
my $spread = 1; |
| 258 |
|
|
my $mv = 0; |
| 259 |
|
|
my $mvn = 0; |
| 260 |
|
|
my @st; |
| 261 |
|
|
$i = 0; |
| 262 |
|
|
my $skip = 0; |
| 263 |
|
|
my @space; # Space tags flag |
| 264 |
|
|
my @break; # Text break flags |
| 265 |
|
|
|
| 266 |
|
|
$st[$_] = '' foreach(0..$spread + 1); |
| 267 |
|
|
$space[$_] = 0 foreach(0 + 1..$spread + 1); |
| 268 |
|
|
$break[$_] = 0 foreach(0 + 1..$spread + 1); |
| 269 |
|
|
$space[0] = 1; |
| 270 |
|
|
$break[0] = 1; |
| 271 |
|
|
|
| 272 |
|
|
while(1) { |
| 273 |
|
|
# Skipping tags |
| 274 |
|
|
foreach(0..$spread) { |
| 275 |
|
|
do { |
| 276 |
|
|
$skip = 0; |
| 277 |
|
|
if($i + $_ + $mv <= length($strip)) { |
| 278 |
|
|
if($i + $_ + $mv + 1 < length($strip)) { |
| 279 |
|
|
if((substr($strip, $i + $_ + $mv, 1) eq "\x00") && (substr($strip, $i + $_ + $mv + 1, 1) eq "\x0F")) { |
| 280 |
|
|
$space[$_ + 1] |= (ord(substr($strip, $i + $_ + $mv + 2, 1)) & 2) >> 1; |
| 281 |
|
|
$break[$_ + 1] |= ord(substr($strip, $i + $_ + $mv + 2, 1)) & 1; |
| 282 |
|
|
$mv += $markLength; |
| 283 |
|
|
if(!$_) { $mvn = $mv; } |
| 284 |
|
|
$st[$_ + 1] = ""; |
| 285 |
|
|
$skip = 1; |
| 286 |
|
|
} |
| 287 |
|
|
} |
| 288 |
|
|
if(!$skip) { $st[$_ + 1] = substr($strip, $i + $_ + $mv, 1); } |
| 289 |
|
|
} |
| 290 |
|
|
} while($skip); |
| 291 |
|
|
} |
| 292 |
|
|
|
| 293 |
|
|
$i += $mvn; |
| 294 |
|
|
$mv = 0; |
| 295 |
|
|
$mvn = 0; |
| 296 |
|
|
|
| 297 |
|
|
($cp, $c, $cn) = ($st[0], $st[1], $st[2]); |
| 298 |
|
|
$cp_is_sp = (($cp =~ /[^0-9$letters]/) || $space[0] || $space[1] || $break[0] || !$i) ? 1 : 0; |
| 299 |
|
|
$cn_is_sp = (($cn =~ /[^0-9$letters]/) || $space[2] || $break[2] || $cn eq '') ? 1 : 0; |
| 300 |
|
|
|
| 301 |
|
|
# Reset state if breaking tag appears |
| 302 |
|
|
if($break[1] || $i == length($strip)) { |
| 303 |
|
|
if($a_open || $b_open) { |
| 304 |
|
|
# Log quote error if appears |
| 305 |
|
|
if($conf->{logErrors}) { |
| 306 |
|
|
my $quoteErrSampleLength = 100; |
| 307 |
|
|
my $z = $i - 1; |
| 308 |
|
|
my $y; |
| 309 |
|
|
while(1) { |
| 310 |
|
|
if(substr($strip, $z, 1) eq " " || substr($strip, $z, 1) eq "\xA0" || !$z) { if($i-$z <= $quoteErrSampleLength) {$y = $z}} |
| 311 |
|
|
last if(!$z); |
| 312 |
|
|
$z--; |
| 313 |
|
|
} |
| 314 |
|
|
my $sample = substr($strip, $y, ($i - $y)); |
| 315 |
|
|
$sample =~ s/\x00\x0F[^\x0F]+\x0F\x00//g; |
| 316 |
|
|
$sample =~ s/<\/?[a-z]+.*?>//g; |
| 317 |
|
|
push(@{$result->{errorLog}}, {type=>"Quote_error", message=>"Quote mismatch near [$sample]<--"}); |
| 318 |
|
|
$result->{error} = 1; |
| 319 |
|
|
} |
| 320 |
|
|
} |
| 321 |
|
|
$a_open = 0; |
| 322 |
|
|
$b_open = 0; |
| 323 |
|
|
} |
| 324 |
|
|
|
| 325 |
|
|
if($c eq '"') { |
| 326 |
|
|
if(!$a_open) { |
| 327 |
|
|
$a_open = 1; |
| 328 |
|
|
substr($strip, $i, 1) = $qaStart; |
| 329 |
|
|
$i += length($qaStart) - 1; |
| 330 |
|
|
} elsif ($a_open && (($i == length($strip) - 1) || (!$b_open && $cn_is_sp))) { |
| 331 |
|
|
$a_open = 0; |
| 332 |
|
|
substr($strip, $i, 1) = $qaEnd; |
| 333 |
|
|
$i += length($qaEnd) - 1; |
| 334 |
|
|
} elsif ($a_open && !$b_open) { |
| 335 |
|
|
$b_open = 1; |
| 336 |
|
|
substr($strip, $i, 1) = $qbStart; |
| 337 |
|
|
$i += length($qbStart) - 1; |
| 338 |
|
|
} elsif ($a_open && $b_open) { |
| 339 |
|
|
$b_open = 0; |
| 340 |
|
|
substr($strip, $i, 1) = $qbEnd; |
| 341 |
|
|
$i += length($qbEnd) - 1; |
| 342 |
|
|
} |
| 343 |
|
|
} |
| 344 |
|
|
|
| 345 |
|
|
last if($i == length($strip)); |
| 346 |
|
|
$st[0] = $st[1]; |
| 347 |
|
|
$space[0] = $space[1]; |
| 348 |
|
|
$break[0] = $break[1]; |
| 349 |
|
|
$space[$_] = 0 foreach(0 + 1..$spread + 1); |
| 350 |
|
|
$break[$_] = 0 foreach(0 + 1..$spread + 1); |
| 351 |
|
|
$i++; |
| 352 |
|
|
} |
| 353 |
|
|
} |
| 354 |
|
|
|
| 355 |
|
|
# ==Cutting the tags away |
| 356 |
|
|
sub cuttags($$$$) { |
| 357 |
|
|
my($class, $text, $conf, $result) = @_; |
| 358 |
|
|
my $i = 0; # loop counter |
| 359 |
|
|
my $hop; # Jump length |
| 360 |
|
|
my ($c, $cn); # current & next character |
| 361 |
|
|
my ($tl, $ts, $te, $cl, $tagName, $tagBody, $tagContent); # tag length, tag dimensions, tag name, tag body text, single tag flag, content inside the tag |
| 362 |
|
|
my ($isTag, $isTagStart, $isSingle, $isSingleClosed, $isSpace, $isBreaking, $nobrIsOpen, $flagSet2, $flagSet1, $flagSet0); # some useful flags |
| 363 |
|
|
my @tagsOpen; # an array storing the info about all the tags currently open |
| 364 |
|
|
|
| 365 |
|
|
# space class |
| 366 |
|
|
my $sp =" \t\xA0"; |
| 367 |
|
|
|
| 368 |
|
|
while(1) { |
| 369 |
|
|
$hop = index($$text, "<", $i); |
| 370 |
|
|
|
| 371 |
|
|
if($hop < 0) { |
| 372 |
|
|
$strip .= substr($$text, $i, length($$text) - $i); |
| 373 |
|
|
last; |
| 374 |
|
|
} elsif($hop > 0) { |
| 375 |
|
|
$strip .= substr($$text, $i, $hop - $i); |
| 376 |
|
|
$i = $hop; |
| 377 |
|
|
} |
| 378 |
|
|
|
| 379 |
|
|
($c, $cn) = unpack("aa", substr($$text, $i, 2)); |
| 380 |
|
|
|
| 381 |
|
|
$isTag = 0; |
| 382 |
|
|
|
| 383 |
|
|
# =If tag opens |
| 384 |
|
|
$isTagStart = ($cn =~ /!|[a-z]/i) ? 1 : 0; |
| 385 |
|
|
if($isTagStart || ($cn eq "/")) { $isTag = 1; } |
| 386 |
|
|
|
| 387 |
|
|
if($isTag) { |
| 388 |
|
|
$ts = $i; # Tag start position |
| 389 |
|
|
$te = $isTagStart ? tagend($text, $ts) : index($$text, ">", $ts); # Tag end position |
| 390 |
|
|
|
| 391 |
|
|
if($te) { |
| 392 |
|
|
$tagBody = substr($$text, $ts, $te - $ts + 1); |
| 393 |
|
|
$tagName = $isTagStart ? ($tagBody =~ m/^<([a-z]+)/i)[0] : ($tagBody =~ m/^<\/\s*([a-z]+)/i)[0]; |
| 394 |
|
|
$tagName =~ tr/A-Z/a-z/; |
| 395 |
|
|
} |
| 396 |
|
|
|
| 397 |
|
|
if($te && $tagName) { |
| 398 |
|
|
$tagBody = substr($$text, $ts, $te - $ts + 1); |
| 399 |
|
|
$tagName = $isTagStart ? ($tagBody =~ m/^<([a-z]+)/i)[0] : ($tagBody =~ m/^<\/\s*([a-z]+)/i)[0]; |
| 400 |
|
|
$tagName =~ tr/A-Z/a-z/; |
| 401 |
|
|
|
| 402 |
|
|
# =Flags |
| 403 |
|
|
# Detecting whether the tag is single (self-closing) or double |
| 404 |
|
|
$isSingleClosed = 0; |
| 405 |
|
|
$isSingle = 0; |
| 406 |
|
|
if($isTagStart) { |
| 407 |
|
|
if(grep{$tagName eq $_} @singleTags) { |
| 408 |
|
|
$isSingle = 1; |
| 409 |
|
|
} elsif (substr($tagBody, length($tagBody) - 2, 1) eq "/") { |
| 410 |
|
|
$isSingle = 1; |
| 411 |
|
|
$isSingleClosed = 1; |
| 412 |
|
|
} |
| 413 |
|
|
} |
| 414 |
|
|
|
| 415 |
|
|
# Detecting wether this is space tag or not |
| 416 |
|
|
$isSpace = (grep{$tagName eq $_} @spaceTags) ? 1 : 0; |
| 417 |
|
|
|
| 418 |
|
|
# Detecting wether this is breaking tag or not |
| 419 |
|
|
$isBreaking = (grep{$tagName eq $_} @breakingTags) ? 1 : 0; |
| 420 |
|
|
|
| 421 |
|
|
# Tag Length |
| 422 |
|
|
$tl = $te - $ts + 1; |
| 423 |
|
|
|
| 424 |
|
|
# Updating the status for tags open |
| 425 |
|
|
if($conf->{checkHTML} && !$isSingle) { |
| 426 |
|
|
if($isTagStart) { |
| 427 |
|
|
push(@tagsOpen, $tagName); |
| 428 |
|
|
} else { |
| 429 |
|
|
if($tagsOpen[$#tagsOpen] ne $tagName) { |
| 430 |
|
|
# HTML error |
| 431 |
|
|
$result->{error} = 1; |
| 432 |
|
|
if($conf->{logErrors}) { push(@{$result->{errorLog}}, {type=>"HTML_Parse", position=>$i, message=>"Found closing tag <$tagName> while waiting tag <" . $tagsOpen[$#tagsOpen] . "> to close!"}); } |
| 433 |
|
|
} else { |
| 434 |
|
|
pop(@tagsOpen); |
| 435 |
|
|
} |
| 436 |
|
|
} |
| 437 |
|
|
} |
| 438 |
|
|
|
| 439 |
|
|
# Eating tag content for some tags like <script> |
| 440 |
|
|
$tagContent = ""; |
| 441 |
|
|
$cl = 0; |
| 442 |
|
|
if((grep{$tagName eq $_} @tagsToEat) && $isTagStart) { |
| 443 |
|
|
$cl = index($$text, "</$tagName>", $ts + $tl) - $ts - $tl; |
| 444 |
|
|
if($cl > 0) { |
| 445 |
|
|
$tagContent = substr($$text, $ts + $tl, $cl); |
| 446 |
|
|
} else { |
| 447 |
|
|
$cl = 0; |
| 448 |
|
|
$result->{error} = 1; |
| 449 |
|
|
if($conf->{logErrors}) { push(@{$result->{errorLog}}, {type=>"HTML_Parse", position=>$i, message=>"Can't find <$tagName> end!"}); } |
| 450 |
|
|
} |
| 451 |
|
|
} |
| 452 |
|
|
|
| 453 |
|
|
# Should I drop all the tags by default? |
| 454 |
|
|
my $dropTag = 0; |
| 455 |
|
|
if($conf->{tagsDenyAll}) { $dropTag = 1; } |
| 456 |
|
|
|
| 457 |
|
|
# Checking deny list |
| 458 |
|
|
if(defined($conf->{tagsDeny}) && !$dropTag) { |
| 459 |
|
|
if($conf->{tagsDeny}->{$tagName}) { $dropTag = 1; } |
| 460 |
|
|
} |
| 461 |
|
|
|
| 462 |
|
|
# Checking allow list |
| 463 |
|
|
if(defined($conf->{tagsAllow}) && $dropTag) { |
| 464 |
|
|
if($conf->{tagsAllow}->{$tagName}) { $dropTag = 0; } |
| 465 |
|
|
} |
| 466 |
|
|
|
| 467 |
|
|
# Nobr tag status |
| 468 |
|
|
if($tagName eq "nobr" && $isTagStart) { |
| 469 |
|
|
$nobrIsOpen = 1; |
| 470 |
|
|
} elsif(($tagName eq "nobr" && !$isTagStart) || (grep{$tagName eq $_} @breakingTags)) { |
| 471 |
|
|
$nobrIsOpen = 0; |
| 472 |
|
|
} |
| 473 |
|
|
|
| 474 |
|
|
# =Final part |
| 475 |
|
|
if(!$dropTag) { |
| 476 |
|
|
# =Processing tags |
| 477 |
|
|
# Tag name to lower case |
| 478 |
|
|
if($conf->{tagNamesToLower}) { |
| 479 |
|
|
if($isTagStart) { $tagBody = "<" . $tagName . substr($tagBody, length($tagName) + 1, length($tagBody) - length($tagName) - 1); } |
| 480 |
|
|
else { $tagBody =~ tr/A-Z/a-z/; } |
| 481 |
|
|
} |
| 482 |
|
|
# Tag name to upper case |
| 483 |
|
|
if($conf->{tagNamesToUpper}) { |
| 484 |
|
|
if($isTagStart) { $tagBody = "<" . uc($tagName) . substr($tagBody, length($tagName) + 1, length($tagBody) - length($tagName) - 1); } |
| 485 |
|
|
else { $tagBody =~ tr/a-z/A-Z/; } |
| 486 |
|
|
} |
| 487 |
|
|
# =Tag parameters to lower or upper case |
| 488 |
|
|
if($isTagStart && ($conf->{tagAttributesToLower} || $conf->{tagAttributesToUpper})) { |
| 489 |
|
|
# Regular parameters |
| 490 |
|
|
my $tmp = ""; |
| 491 |
|
|
while ($tagBody =~ m/([^\s]*\s*)(?:([a-z\r]+)(\s*)(?==)(=\s*))?/ig ) { |
| 492 |
|
|
$tmp .= $1 if ($1); if($conf->{tagAttributesToLower}) { if($2) { $tmp .= lc($2); } } else { if($2) { $tmp .= uc($2); } } $tmp .= $3 if ($3); $tmp .= $4 if ($4); $tmp .= $5 if ($5); |
| 493 |
|
|
} |
| 494 |
|
|
|
| 495 |
|
|
# Single parameters (like <checked>) |
| 496 |
|
|
if($conf->{tagAttributesToLower}) { $tagBody =~ s{(?<!=)( +([a-z]+))}{lc($1)}eig; } |
| 497 |
|
|
elsif($conf->{tagAttributesToUpper}) { $tagBody =~ s{(?<!=)( +([a-z]+))}{uc($1)}eig; } |
| 498 |
|
|
} |
| 499 |
|
|
|
| 500 |
|
|
# Simple XSS & tag attributes protection |
| 501 |
|
|
if($isTagStart && ($conf->{simpleXSS} || $conf->{tagsAllow}->{$tagName}->{validAttributes} || $conf->{tagsAllow}->{$tagName}->{invalidAttributes} || $conf->{tagsAllow}->{$tagName}->{denyAllAttributes} || $conf->{tagsDenyAllAttributes})) { |
| 502 |
|
|
$tagBody =~ s{(?<!<)(\s*)([a-z]+)([$sp]*=[$sp]*)("[^"]+"|[^$sp/>]+)} { |
| 503 |
|
|
my ($a, $b, $c, $d) = ($1||'', $2, $3, $4); |
| 504 |
|
|
if($conf->{simpleXSS} && ($b =~ /^on/ig || $d =~ /javascript|expression/ig)) { |
| 505 |
|
|
''; |
| 506 |
|
|
} elsif(($conf->{tagsDenyAllAttributes} || $conf->{tagsAllow}->{$tagName}->{denyAllAttributes} || ($conf->{tagsAllow}->{$tagName}->{invalidAttributes} && $conf->{tagsAllow}->{$tagName}->{invalidAttributes}->{$b})) |
| 507 |
|
|
&& !(($conf->{tagsAllow}->{$tagName}->{validAttributes} && $conf->{tagsAllow}->{$tagName}->{validAttributes}->{$b}) |
| 508 |
|
|
|| $conf->{tagsAllow}->{$tagName}->{allowAllAttributes}) |
| 509 |
|
|
) { |
| 510 |
|
|
''; |
| 511 |
|
|
} elsif($conf->{tagsAllow}->{$tagName}->{validAttributes} && !$conf->{tagsAllow}->{$tagName}->{validAttributes}->{$b}) { |
| 512 |
|
|
''; |
| 513 |
|
|
} else { |
| 514 |
|
|
$a . $b . $c . $d; |
| 515 |
|
|
} |
| 516 |
|
|
}eig; |
| 517 |
|
|
} |
| 518 |
|
|
|
| 519 |
|
|
# Close single tag |
| 520 |
|
|
if($conf->{tagCloseSingle} && $isSingle && !$isSingleClosed) { |
| 521 |
|
|
if(substr($tagBody, length($tagBody) - 2, 1) ne "/") { |
| 522 |
|
|
if(substr($tagBody, length($tagBody) - 2, 1) ne " ") { substr($tagBody, length($tagBody) - 2, 1) .= " /"; } else { substr($tagBody, length($tagBody) - 2, 1) .= "/"; } |
| 523 |
|
|
} |
| 524 |
|
|
} |
| 525 |
|
|
|
| 526 |
|
|
# Quote attribute values |
| 527 |
|
|
if($conf->{tagQuoteValues} && $isTagStart) { |
| 528 |
|
|
my $tmp = ""; |
| 529 |
|
|
# 1 23 4 5 6 |
| 530 |
|
|
while($tagBody =~ m/([<a-z >]+)?((=)(\s*)([^ >]+)([ >]+))?/ig) { |
| 531 |
|
|
$tmp .= $1 if($1); |
| 532 |
|
|
if($2) { |
| 533 |
|
|
$tmp .= $3 if($3); |
| 534 |
|
|
$tmp .= $4 if($4); |
| 535 |
|
|
if($5 && substr($5, 0, 1) ne '"' && substr($5, length($5) - 1, 1) ne '"') { $tmp .= "\"$5\""; } else { $tmp .= $5; } |
| 536 |
|
|
$tmp .= $6 if($6); |
| 537 |
|
|
} |
| 538 |
|
|
} |
| 539 |
|
|
$tagBody = $tmp; |
| 540 |
|
|
} |
| 541 |
|
|
|
| 542 |
|
|
# Unquote attribute values |
| 543 |
|
|
if($conf->{tagUnQuoteValues}) { |
| 544 |
|
|
$tagBody =~ s/([a-z]+)(\s*)(=)(\s*)"([^\=\s">]+)"/$1$2$3$4$5/ig; #" |
| 545 |
|
|
} |
| 546 |
|
|
|
| 547 |
|
|
# Saving the tag |
| 548 |
|
|
push(@$tags, {name=>$tagName, body=>$tagBody, content=>$tagContent}); |
| 549 |
|
|
|
| 550 |
|
|
# Forming flagSet |
| 551 |
|
|
# |
| 552 |
|
|
# |byte2: _ _ _ _ _ _ isSpace isBreaking| byte1: _ _ _ _ _ p br| byte0: _ _ _ _ nobr isTagStart |
| 553 |
|
|
$flagSet2 = 0; |
| 554 |
|
|
if($isSpace) { $flagSet2 |= 2; } |
| 555 |
|
|
if($isBreaking) { $flagSet2 |= 1; } |
| 556 |
|
|
$flagSet1 = 0; |
| 557 |
|
|
if($tagName eq "br") { $flagSet1 |= 1; } |
| 558 |
|
|
if($tagName eq "p") { $flagSet1 |= 2; } |
| 559 |
|
|
$flagSet0 = 0; |
| 560 |
|
|
if($isTagStart) { $flagSet0 |= 1; } |
| 561 |
|
|
if($nobrIsOpen) { $flagSet0 |= 2; } |
| 562 |
|
|
# Planting the marker |
| 563 |
|
|
$strip .= "\x00\x0F" . chr($flagSet2) . chr($flagSet1) . chr($flagSet0) . "\x0F\x00"; |
| 564 |
|
|
} |
| 565 |
|
|
|
| 566 |
|
|
# Moving the pointer (tag end position + content length) |
| 567 |
|
|
$i = $te + $cl; |
| 568 |
|
|
|
| 569 |
|
|
# Eating crs & lfs after dropped tag |
| 570 |
|
|
if($conf->{tagLf} && $dropTag) { |
| 571 |
|
|
while(1) { |
| 572 |
|
|
if(substr($$text, $i + 1, 1) eq "\r") { $i++; } elsif(substr($$text, $i + 1, 1) eq "\n") { $i++; last; } else { last } |
| 573 |
|
|
} |
| 574 |
|
|
} |
| 575 |
|
|
} |
| 576 |
|
|
} else { |
| 577 |
|
|
# This is not a tag, just add the "<" to result |
| 578 |
|
|
$strip .= $c; |
| 579 |
|
|
} |
| 580 |
|
|
|
| 581 |
|
|
last if($i == length($$text)); |
| 582 |
|
|
$i++; |
| 583 |
|
|
} |
| 584 |
|
|
} |
| 585 |
|
|
|
| 586 |
|
|
# ==Find where tag ends |
| 587 |
|
|
sub tagend($$$) { |
| 588 |
|
|
my ($text, $i) = @_; |
| 589 |
|
|
|
| 590 |
|
|
my $gotcha = 0; |
| 591 |
|
|
my $quote = 0; |
| 592 |
|
|
|
| 593 |
|
|
$i |= 0; |
| 594 |
|
|
|
| 595 |
|
|
while (1) { |
| 596 |
|
|
if (substr($$text, $i, 1) eq '"') { $quote ^= 1; } |
| 597 |
|
|
if (!$quote && substr($$text, $i, 1) eq '>') { $gotcha = $i; } |
| 598 |
|
|
last if ($i == length($$text) || $gotcha); |
| 599 |
|
|
$i++; |
| 600 |
|
|
} |
| 601 |
|
|
|
| 602 |
|
|
return $gotcha; |
| 603 |
|
|
} |
| 604 |
|
|
|
| 605 |
|
|
# ==Bring everything back to HTML |
| 606 |
|
|
sub planttags($$) { |
| 607 |
|
|
my ($class, $result) = @_; |
| 608 |
|
|
my $i = 0; |
| 609 |
|
|
my $max = length($strip); |
| 610 |
|
|
my $ctag = 0; |
| 611 |
|
|
my $step; |
| 612 |
|
|
|
| 613 |
|
|
while (1) { |
| 614 |
|
|
if($i < $max - 2 && substr($strip, $i, 2) eq "\x00\x0F") { |
| 615 |
|
|
$result->{text} .= $$tags[$ctag]->{body}; |
| 616 |
|
|
if($$tags[$ctag]->{content}) { $result->{text} .= $$tags[$ctag]->{content}; } |
| 617 |
|
|
$i += $markLength; |
| 618 |
|
|
$ctag++; |
| 619 |
|
|
} else { |
| 620 |
|
|
if($i < $max - 2) { $step = index($strip, "\x00\x0F", $i) - $i; } else { $step = $max - $i; } |
| 621 |
|
|
if($step < 0) { $step = $max - $i; } |
| 622 |
|
|
|
| 623 |
|
|
if($step >= 0) { |
| 624 |
|
|
$result->{text} .= substr($strip, $i, $step); |
| 625 |
|
|
$i += $step; |
| 626 |
|
|
} |
| 627 |
|
|
} |
| 628 |
|
|
|
| 629 |
|
|
last if($i == $max); |
| 630 |
|
|
} |
| 631 |
|
|
} |
| 632 |
|
|
|
| 633 |
|
|
# ==Bring the text to plain mode== |
| 634 |
|
|
sub vanish($$) { |
| 635 |
|
|
my($class, $text) = @_; |
| 636 |
|
|
|
| 637 |
|
|
$$text =~ s/«|“|„|‘|‚|"|»|”|“|’|«|“|„|‘|‚|"|»|”|’|�|�|�|�|�|"|�|�|�/"/ig; |
| 638 |
|
|
$$text =~ s/ | |�/ /ig; |
| 639 |
|
|
$$text =~ s/—|–|—|–|�|�/-/ig; |
| 640 |
|
|
$$text =~ s/…|…|�/.../ig; |
| 641 |
|
|
$$text =~ s/©|©|�/(c)/ig; |
| 642 |
|
|
$$text =~ s/®|®|�/(r)/ig; |
| 643 |
|
|
$$text =~ s/¼|¼/1\/4/ig; |
| 644 |
|
|
$$text =~ s/½|½/1\/2/ig; |
| 645 |
|
|
$$text =~ s/¾|¾/3\/4/ig; |
| 646 |
|
|
} |
| 647 |
|
|
|
| 648 |
|
|
# ==Parse the tagsAllow string advanced format== |
| 649 |
|
|
sub parseTagsAllowString($$) { |
| 650 |
|
|
my($class, $string) = @_; |
| 651 |
|
|
|
| 652 |
|
|
return {tagsAllow=>{}, tagsDenyAllAttributes=>0} if(!$string); |
| 653 |
|
|
|
| 654 |
|
|
my $tagsAllow = {}; |
| 655 |
|
|
my $tagsDenyAllAttributes = 0; |
| 656 |
|
|
|
| 657 |
|
|
# Should I deny all tag attributes by default? |
| 658 |
|
|
if(substr($string,0,1) eq '|') { |
| 659 |
|
|
$tagsDenyAllAttributes = 1; |
| 660 |
|
|
substr($string,0,1) = ''; |
| 661 |
|
|
}; |
| 662 |
|
|
|
| 663 |
|
|
# Parsing the Configuration String |
| 664 |
|
|
while($string =~ /([a-z:|]+)/ig) { |
| 665 |
|
|
my $tBody = $1; |
| 666 |
|
|
my ($tagName) = ($tBody =~ /^([a-z]+)/i)[0]; |
| 667 |
|
|
|
| 668 |
|
|
last if(!$tagName); |
| 669 |
|
|
|
| 670 |
|
|
my $attrList = (); |
| 671 |
|
|
$tagsAllow->{$tagName}->{val}=1; |
| 672 |
|
|
|
| 673 |
|
|
if($tBody =~ /^$tagName\|$/i) { |
| 674 |
|
|
$tagsAllow->{$tagName}->{denyAllAttributes}=1; |
| 675 |
|
|
} elsif($tBody =~ /^$tagName\:$/i) { |
| 676 |
|
|
$tagsAllow->{$tagName}->{allowAllAttributes}=1; |
| 677 |
|
|
} else { |
| 678 |
|
|
while($tBody =~ /:([a-z]+)/ig) { |
| 679 |
|
|
$tagsAllow->{$tagName}->{validAttributes}->{$1}=1; |
| 680 |
|
|
} |
| 681 |
|
|
|
| 682 |
|
|
while($tBody =~ /\|([a-z]+)/ig) { |
| 683 |
|
|
if(!$tagsAllow->{$tagName}->{validAttributes}->{$1}) { |
| 684 |
|
|
$tagsAllow->{$tagName}->{invalidAttributes}->{$1}=1; |
| 685 |
|
|
} |
| 686 |
|
|
} |
| 687 |
|
|
} |
| 688 |
|
|
} |
| 689 |
|
|
|
| 690 |
|
|
return {tagsAllow=>$tagsAllow, tagsDenyAllAttributes=>$tagsDenyAllAttributes}; |
| 691 |
|
|
} |
| 692 |
|
|
|
| 693 |
|
|
# ==Parse the tagsAllow string advanced format== |
| 694 |
|
|
sub parseTagsDenyString($$) { |
| 695 |
|
|
my($class, $string) = @_; |
| 696 |
|
|
|
| 697 |
|
|
return {} if(!$string); |
| 698 |
|
|
|
| 699 |
|
|
my $tagsDeny = {}; |
| 700 |
|
|
while($string =~ /([a-z]+)/ig) { |
| 701 |
|
|
$tagsDeny->{$1}->{val}=1; |
| 702 |
|
|
} |
| 703 |
|
|
|
| 704 |
|
|
return $tagsDeny; |
| 705 |
|
|
} |
| 706 |
|
|
|
| 707 |
|
|
return 1; |