Filename | /var/www/foswikidev/core/lib/Foswiki/Compatibility.pm |
Statements | Executed 346 statements in 2.32ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
13 | 1 | 1 | 240µs | 428µs | readSymmetricallyEncodedMETA | Foswiki::Compatibility::
39 | 1 | 1 | 128µs | 128µs | _symmetricalDataDecode | Foswiki::Compatibility::
1 | 1 | 1 | 15µs | 32µs | BEGIN@4 | Foswiki::Compatibility::
1 | 1 | 1 | 10µs | 40µs | BEGIN@6 | Foswiki::Compatibility::
1 | 1 | 1 | 9µs | 15µs | BEGIN@5 | Foswiki::Compatibility::
1 | 1 | 1 | 4µs | 4µs | BEGIN@8 | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | _getOldAttachAttr | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | _makeBadAnchorName | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | _upgradeCategoryItem | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | makeCompatibleAnchors | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | migrateToFileAttachmentMacro | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | upgradeCategoryTable | Foswiki::Compatibility::
0 | 0 | 0 | 0s | 0s | upgradeFrom1v0beta | Foswiki::Compatibility::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | package Foswiki::Compatibility; | ||||
3 | |||||
4 | 2 | 29µs | 2 | 48µs | # spent 32µs (15+17) within Foswiki::Compatibility::BEGIN@4 which was called:
# once (15µs+17µs) by Foswiki::Serialise::Embedded::read at line 4 # spent 32µs making 1 call to Foswiki::Compatibility::BEGIN@4
# spent 17µs making 1 call to strict::import |
5 | 2 | 25µs | 2 | 21µs | # spent 15µs (9+6) within Foswiki::Compatibility::BEGIN@5 which was called:
# once (9µs+6µs) by Foswiki::Serialise::Embedded::read at line 5 # spent 15µs making 1 call to Foswiki::Compatibility::BEGIN@5
# spent 6µs making 1 call to warnings::import |
6 | 2 | 57µs | 2 | 70µs | # spent 40µs (10+30) within Foswiki::Compatibility::BEGIN@6 which was called:
# once (10µs+30µs) by Foswiki::Serialise::Embedded::read at line 6 # spent 40µs making 1 call to Foswiki::Compatibility::BEGIN@6
# spent 30µs making 1 call to Exporter::import |
7 | |||||
8 | # spent 4µs within Foswiki::Compatibility::BEGIN@8 which was called:
# once (4µs+0s) by Foswiki::Serialise::Embedded::read at line 13 | ||||
9 | 1 | 5µs | if ( $Foswiki::cfg{UseLocale} ) { | ||
10 | require locale; | ||||
11 | import locale(); | ||||
12 | } | ||||
13 | 1 | 1.84ms | 1 | 4µs | } # spent 4µs making 1 call to Foswiki::Compatibility::BEGIN@8 |
14 | |||||
15 | =begin TML | ||||
16 | |||||
17 | ---+ package Foswiki::Compatibility | ||||
18 | |||||
19 | Support for compatibility with old versions. Packaged | ||||
20 | separately because 99.999999% of the time this won't be needed. | ||||
21 | |||||
22 | =cut | ||||
23 | |||||
24 | sub _upgradeCategoryItem { | ||||
25 | my ( $catitems, $ctext ) = @_; | ||||
26 | my $catname = ''; | ||||
27 | my $scatname = ''; | ||||
28 | my $catmodifier = ''; | ||||
29 | my $catvalue = ''; | ||||
30 | my @cmd = split( /\|/, $catitems ); | ||||
31 | my $src = ''; | ||||
32 | my $len = @cmd; | ||||
33 | if ( $len < '2' ) { | ||||
34 | |||||
35 | # FIXME | ||||
36 | return ( $catname, $catmodifier, $catvalue ); | ||||
37 | } | ||||
38 | my $svalue = ''; | ||||
39 | |||||
40 | my $i; | ||||
41 | my $itemsPerLine; | ||||
42 | |||||
43 | # check for CategoryName=CategoryValue parameter | ||||
44 | my $paramCmd = ''; | ||||
45 | my $cvalue = ''; # was$query->param( $cmd[1] ); | ||||
46 | if ($cvalue) { | ||||
47 | $src = "<!---->$cvalue<!---->"; | ||||
48 | } | ||||
49 | elsif ($ctext) { | ||||
50 | foreach ( split( /\r?\n/, $ctext ) ) { | ||||
51 | if (/$cmd[1]/) { | ||||
52 | $src = $_; | ||||
53 | last; | ||||
54 | } | ||||
55 | } | ||||
56 | } | ||||
57 | |||||
58 | if ( $cmd[0] eq 'select' || $cmd[0] eq 'radio' ) { | ||||
59 | $catname = $cmd[1]; | ||||
60 | $scatname = $catname; | ||||
61 | |||||
62 | #$scatname =~ s/[^a-zA-Z0-9]//g; | ||||
63 | my $size = $cmd[2]; | ||||
64 | for ( $i = 3 ; $i < $len ; $i++ ) { | ||||
65 | my $value = $cmd[$i]; | ||||
66 | $svalue = $value; | ||||
67 | if ( $src =~ m/$value/ ) { | ||||
68 | $catvalue = $svalue; | ||||
69 | } | ||||
70 | } | ||||
71 | |||||
72 | } | ||||
73 | elsif ( $cmd[0] eq 'checkbox' ) { | ||||
74 | $catname = $cmd[1]; | ||||
75 | $scatname = $catname; | ||||
76 | |||||
77 | #$scatname =~ s/[^a-zA-Z0-9]//g; | ||||
78 | if ( $cmd[2] eq 'true' || $cmd[2] eq '1' ) { | ||||
79 | $i = $len - 4; | ||||
80 | $catmodifier = 1; | ||||
81 | } | ||||
82 | $itemsPerLine = $cmd[3]; | ||||
83 | for ( $i = 4 ; $i < $len ; $i++ ) { | ||||
84 | my $value = $cmd[$i]; | ||||
85 | $svalue = $value; | ||||
86 | |||||
87 | # I18N: FIXME - need to look at this, but since it's upgrading | ||||
88 | # old forms that probably didn't use I18N, it's not a high | ||||
89 | # priority. | ||||
90 | if ( $src =~ m/$value[^a-zA-Z0-9\.]/ ) { | ||||
91 | $catvalue .= ", " if ($catvalue); | ||||
92 | $catvalue .= $svalue; | ||||
93 | } | ||||
94 | } | ||||
95 | |||||
96 | } | ||||
97 | elsif ( $cmd[0] eq 'text' ) { | ||||
98 | $catname = $cmd[1]; | ||||
99 | $scatname = $catname; | ||||
100 | |||||
101 | #$scatname =~ s/[^a-zA-Z0-9]//g; | ||||
102 | # SMELL: unchecked implicit untaint? | ||||
103 | $src =~ m/<!---->(.*)<!---->/; | ||||
104 | if ($1) { | ||||
105 | $src = $1; | ||||
106 | } | ||||
107 | else { | ||||
108 | $src = ''; | ||||
109 | } | ||||
110 | $catvalue = $src; | ||||
111 | } | ||||
112 | |||||
113 | return ( $catname, $catmodifier, $catvalue ); | ||||
114 | } | ||||
115 | |||||
116 | =begin TML | ||||
117 | |||||
118 | ---++ StaticMethod upgradeCategoryTable( $session, $web, $topic, $meta, $text ) -> $text | ||||
119 | |||||
120 | Upgrade old style category table | ||||
121 | |||||
122 | May throw Foswiki::OopsException | ||||
123 | |||||
124 | =cut | ||||
125 | |||||
126 | sub upgradeCategoryTable { | ||||
127 | my ( $session, $web, $topic, $meta, $text ) = @_; | ||||
128 | |||||
129 | my $icat = | ||||
130 | $session->templates->readTemplate( 'twikicatitems', no_oops => 1 ); | ||||
131 | |||||
132 | if ($icat) { | ||||
133 | my @items = (); | ||||
134 | |||||
135 | # extract category section and build category form elements | ||||
136 | my ( $before, $ctext, $after ) = split( /<!--TWikiCat-->/, $text ); | ||||
137 | |||||
138 | # cut TWikiCat part | ||||
139 | $text = $before || ''; | ||||
140 | $text .= $after if ($after); | ||||
141 | $ctext = '' if ( !$ctext ); | ||||
142 | |||||
143 | my $ttext = ''; | ||||
144 | foreach ( split( /\r?\n/, $icat ) ) { | ||||
145 | my ( $catname, $catmod, $catvalue ) = | ||||
146 | _upgradeCategoryItem( $_, $ctext ); | ||||
147 | if ($catname) { | ||||
148 | push @items, ( [ $catname, $catmod, $catvalue ] ); | ||||
149 | } | ||||
150 | } | ||||
151 | my $prefs = $session->{prefs}; | ||||
152 | my $webObject = Foswiki::Meta->new( $session, $web ); | ||||
153 | my $listForms = $webObject->getPreference('WEBFORMS'); | ||||
154 | $listForms =~ s/^\s*//g; | ||||
155 | $listForms =~ s/\s*$//g; | ||||
156 | my @formTemplates = split( /\s*,\s*/, $listForms ); | ||||
157 | my $defaultFormTemplate = ''; | ||||
158 | $defaultFormTemplate = $formTemplates[0] if (@formTemplates); | ||||
159 | |||||
160 | if ( !$defaultFormTemplate ) { | ||||
161 | $session->logger->log( 'warning', | ||||
162 | "Form: can't get form definition to convert category table " | ||||
163 | . " for topic $web.$topic" ); | ||||
164 | foreach my $oldCat (@items) { | ||||
165 | my $name = $oldCat->[0]; | ||||
166 | my $value = $oldCat->[2]; | ||||
167 | $meta->put( 'FORM', { name => '' } ); | ||||
168 | $meta->putKeyed( | ||||
169 | 'FIELD', | ||||
170 | { | ||||
171 | name => $name, | ||||
172 | title => $name, | ||||
173 | value => $value | ||||
174 | } | ||||
175 | ); | ||||
176 | } | ||||
177 | return; | ||||
178 | } | ||||
179 | |||||
180 | require Foswiki::Form; | ||||
181 | my $def = new Foswiki::Form( $session, $web, $defaultFormTemplate ); | ||||
182 | $meta->put( 'FORM', { name => $defaultFormTemplate } ); | ||||
183 | |||||
184 | foreach my $fieldDef ( @{ $def->getFields() } ) { | ||||
185 | my $value = ''; | ||||
186 | foreach my $oldCatP (@items) { | ||||
187 | my @oldCat = @$oldCatP; | ||||
188 | my $name = $oldCat[0] || ''; | ||||
189 | $name =~ s/[^A-Za-z0-9_\.]//g; | ||||
190 | if ( $name eq $fieldDef->{name} ) { | ||||
191 | $value = $oldCat[2]; | ||||
192 | last; | ||||
193 | } | ||||
194 | } | ||||
195 | $meta->putKeyed( | ||||
196 | 'FIELD', | ||||
197 | { | ||||
198 | name => $fieldDef->{name}, | ||||
199 | title => $fieldDef->{title}, | ||||
200 | value => $value, | ||||
201 | } | ||||
202 | ); | ||||
203 | } | ||||
204 | |||||
205 | } | ||||
206 | else { | ||||
207 | |||||
208 | # We used to log a warning but it only made noise and trouble | ||||
209 | # People will not need to be warned any longer. Item1440 | ||||
210 | } | ||||
211 | return $text; | ||||
212 | } | ||||
213 | |||||
214 | #Get file attachment attributes for old html | ||||
215 | #format. | ||||
216 | sub _getOldAttachAttr { | ||||
217 | my ( $session, $atext ) = @_; | ||||
218 | my $fileName = ''; | ||||
219 | my $filePath = ''; | ||||
220 | my $fileSize = ''; | ||||
221 | my $fileDate = ''; | ||||
222 | my $fileUser = ''; | ||||
223 | my $fileComment = ''; | ||||
224 | my $before = ''; | ||||
225 | my $item = ''; | ||||
226 | my $after = ''; | ||||
227 | my $users = $session->{users}; | ||||
228 | |||||
229 | ( $before, $fileName, $after ) = split( /<(?:\/)*TwkFileName>/, $atext ); | ||||
230 | if ( !$fileName ) { $fileName = ''; } | ||||
231 | if ($fileName) { | ||||
232 | ( $before, $filePath, $after ) = | ||||
233 | split( /<(?:\/)*TwkFilePath>/, $atext ); | ||||
234 | if ( !$filePath ) { $filePath = ''; } | ||||
235 | |||||
236 | # SMELL: unchecked implicit untaint | ||||
237 | $filePath =~ s/<TwkData value="(.*)">//g; | ||||
238 | if ($1) { $filePath = $1; } | ||||
239 | else { $filePath = ''; } | ||||
240 | $filePath =~ s/\%NOP\%//gi; # delete placeholder that prevents WikiLinks | ||||
241 | ( $before, $fileSize, $after ) = | ||||
242 | split( /<(?:\/)*TwkFileSize>/, $atext ); | ||||
243 | if ( !$fileSize ) { $fileSize = '0'; } | ||||
244 | ( $before, $fileDate, $after ) = | ||||
245 | split( /<(?:\/)*TwkFileDate>/, $atext ); | ||||
246 | |||||
247 | if ( !$fileDate ) { | ||||
248 | $fileDate = ''; | ||||
249 | } | ||||
250 | else { | ||||
251 | $fileDate =~ s/ / /g; | ||||
252 | require Foswiki::Time; | ||||
253 | $fileDate = Foswiki::Time::parseTime($fileDate); | ||||
254 | } | ||||
255 | ( $before, $fileUser, $after ) = | ||||
256 | split( /<(?:\/)*TwkFileUser>/, $atext ); | ||||
257 | if ( !$fileUser ) { | ||||
258 | $fileUser = ''; | ||||
259 | } | ||||
260 | else { | ||||
261 | $fileUser = $users->getLoginName($fileUser) if $fileUser; | ||||
262 | } | ||||
263 | $fileUser ||= ''; | ||||
264 | $fileUser =~ s/ //g; | ||||
265 | ( $before, $fileComment, $after ) = | ||||
266 | split( /<(?:\/)*TwkFileComment>/, $atext ); | ||||
267 | if ( !$fileComment ) { $fileComment = ''; } | ||||
268 | } | ||||
269 | |||||
270 | return ( $fileName, $filePath, $fileSize, $fileDate, $fileUser, | ||||
271 | $fileComment ); | ||||
272 | } | ||||
273 | |||||
274 | =begin TML | ||||
275 | |||||
276 | ---++ migrateToFileAttachmentMacro ( $session, $meta, $text ) -> $text | ||||
277 | |||||
278 | Migrate old HTML format | ||||
279 | |||||
280 | =cut | ||||
281 | |||||
282 | sub migrateToFileAttachmentMacro { | ||||
283 | my ( $session, $meta, $text ) = @_; | ||||
284 | ASSERT( $meta->isa('Foswiki::Meta') ) if DEBUG; | ||||
285 | |||||
286 | my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text ); | ||||
287 | $text = $before || ''; | ||||
288 | $text .= $after if ($after); | ||||
289 | $atext = '' if ( !$atext ); | ||||
290 | |||||
291 | if ( $atext =~ m/<TwkNextItem>/ ) { | ||||
292 | my $line = ''; | ||||
293 | foreach $line ( split( /<TwkNextItem>/, $atext ) ) { | ||||
294 | my ( | ||||
295 | $fileName, $filePath, $fileSize, | ||||
296 | $fileDate, $fileUser, $fileComment | ||||
297 | ) = _getOldAttachAttr( $session, $line ); | ||||
298 | |||||
299 | if ($fileName) { | ||||
300 | $meta->putKeyed( | ||||
301 | 'FILEATTACHMENT', | ||||
302 | { | ||||
303 | name => $fileName, | ||||
304 | version => '', | ||||
305 | path => $filePath, | ||||
306 | size => $fileSize, | ||||
307 | date => $fileDate, | ||||
308 | user => $fileUser, | ||||
309 | comment => $fileComment, | ||||
310 | attr => '' | ||||
311 | } | ||||
312 | ); | ||||
313 | } | ||||
314 | } | ||||
315 | } | ||||
316 | else { | ||||
317 | |||||
318 | # Format of macro that came before META:ATTACHMENT | ||||
319 | my $line = ''; | ||||
320 | require Foswiki::Attrs; | ||||
321 | foreach $line ( split( /\r?\n/, $atext ) ) { | ||||
322 | if ( $line =~ m/%FILEATTACHMENT\{\s"([^"]*)"([^}]*)\}%/ ) { | ||||
323 | my $name = $1; | ||||
324 | my $values = new Foswiki::Attrs($2); | ||||
325 | $values->{name} = $name; | ||||
326 | $meta->putKeyed( 'FILEATTACHMENT', $values ); | ||||
327 | } | ||||
328 | } | ||||
329 | } | ||||
330 | |||||
331 | return $text; | ||||
332 | } | ||||
333 | |||||
334 | =begin TML | ||||
335 | |||||
336 | ---++ upgradeFrom1v0beta ( $session, $meta ) -> $text | ||||
337 | |||||
338 | =cut | ||||
339 | |||||
340 | sub upgradeFrom1v0beta { | ||||
341 | my ( $session, $meta ) = @_; | ||||
342 | my $users = $session->{users}; | ||||
343 | require Foswiki::Time; | ||||
344 | |||||
345 | my @attach = $meta->find('FILEATTACHMENT'); | ||||
346 | foreach my $att (@attach) { | ||||
347 | my $date = $att->{date} || 0; | ||||
348 | if ( $date =~ m/-/ ) { | ||||
349 | $date =~ s/ / /g; | ||||
350 | $date = Foswiki::Time::parseTime($date); | ||||
351 | } | ||||
352 | $att->{date} = $date; | ||||
353 | $att->{user} = $users->webDotWikiName( $att->{user} ); | ||||
354 | } | ||||
355 | } | ||||
356 | |||||
357 | # Read meta-data encoded using the discredited symmetrical encoding | ||||
358 | # method from pre 1.1 | ||||
359 | # spent 428µs (240+188) within Foswiki::Compatibility::readSymmetricallyEncodedMETA which was called 13 times, avg 33µs/call:
# 13 times (240µs+188µs) by Foswiki::Serialise::Embedded::read at line 104 of /var/www/foswikidev/core/lib/Foswiki/Serialise/Embedded.pm, avg 33µs/call | ||||
360 | 13 | 16µs | my ( $meta, $type, $args ) = @_; | ||
361 | |||||
362 | 13 | 5µs | my $keys = {}; | ||
363 | |||||
364 | 13 | 79µs | $args =~ s/\s*([^=]+)="([^"]*)"/ | ||
365 | 39 | 40µs | 39 | 128µs | _symmetricalDataDecode( $1, $2, $keys )/ge; # spent 128µs making 39 calls to Foswiki::Compatibility::_symmetricalDataDecode, avg 3µs/call |
366 | |||||
367 | 13 | 18µs | 13 | 60µs | if ( defined( $keys->{name} ) ) { # spent 60µs making 13 calls to Foswiki::Meta::putKeyed, avg 5µs/call |
368 | |||||
369 | # don't attempt to save it keyed unless it has a name | ||||
370 | $meta->putKeyed( $type, $keys ); | ||||
371 | } | ||||
372 | else { | ||||
373 | $meta->put( $type, $keys ); | ||||
374 | } | ||||
375 | 13 | 26µs | return 1; | ||
376 | } | ||||
377 | |||||
378 | # spent 128µs within Foswiki::Compatibility::_symmetricalDataDecode which was called 39 times, avg 3µs/call:
# 39 times (128µs+0s) by Foswiki::Compatibility::readSymmetricallyEncodedMETA at line 365, avg 3µs/call | ||||
379 | 39 | 37µs | my ( $key, $value, $res ) = @_; | ||
380 | |||||
381 | # Old decoding retained for backward compatibility. | ||||
382 | # This encoding is badly broken, because the encoded | ||||
383 | # symbols are symmetrical, and use an encoded symbol (%). | ||||
384 | 39 | 11µs | $value =~ s/%_N_%/\n/g; | ||
385 | 39 | 6µs | $value =~ s/%_Q_%/\"/g; | ||
386 | 39 | 6µs | $value =~ s/%_P_%/%/g; | ||
387 | |||||
388 | 39 | 30µs | $res->{$key} = $value; | ||
389 | |||||
390 | 39 | 90µs | return ''; | ||
391 | } | ||||
392 | |||||
393 | # IF cfg{RequireCompatibleAnchors} | ||||
394 | |||||
395 | # Return a list of alternative anchor names generated using old generations | ||||
396 | # of anchor name generator | ||||
397 | sub makeCompatibleAnchors { | ||||
398 | my ($text) = @_; | ||||
399 | my @anchors; | ||||
400 | |||||
401 | # Use the old algorithm to generate the old style, non-unique, anchor | ||||
402 | # target. | ||||
403 | my $badAnchor = _makeBadAnchorName( $text, 0 ); | ||||
404 | push( @anchors, $badAnchor ), | ||||
405 | |||||
406 | # There's an even older algorithm we have to allow for | ||||
407 | my $worseAnchor = _makeBadAnchorName( $text, 1 ); | ||||
408 | if ( $worseAnchor ne $badAnchor ) { | ||||
409 | push( @anchors, $worseAnchor ),; | ||||
410 | } | ||||
411 | |||||
412 | return @anchors; | ||||
413 | } | ||||
414 | |||||
415 | # Make an anchor name using the seriously flawed (tm)Wiki anchor generation | ||||
416 | # algorithm(s). This code is taken verbatim from Foswiki 1.0.4. | ||||
417 | sub _makeBadAnchorName { | ||||
418 | my ( $anchorName, $compatibilityMode ) = @_; | ||||
419 | if ( !$compatibilityMode | ||||
420 | && $anchorName =~ m/^$Foswiki::regex{anchorRegex}$/ ) | ||||
421 | { | ||||
422 | |||||
423 | # accept, already valid -- just remove leading # | ||||
424 | return substr( $anchorName, 1 ); | ||||
425 | } | ||||
426 | |||||
427 | # strip out potential links so they don't get rendered. | ||||
428 | # remove double bracket link | ||||
429 | $anchorName =~ s/\[(?:\[.*?\])?\[(.*?)\]\s*\]/$1/g; | ||||
430 | |||||
431 | # add an _ before bare WikiWords | ||||
432 | $anchorName =~ s/($Foswiki::regex{wikiWordRegex})/_$1/g; | ||||
433 | |||||
434 | if ($compatibilityMode) { | ||||
435 | |||||
436 | # remove leading/trailing underscores first, allowing them to be | ||||
437 | # reintroduced | ||||
438 | $anchorName =~ s/^[\s#_]*//; | ||||
439 | $anchorName =~ s/[\s_]*$//; | ||||
440 | } | ||||
441 | $anchorName =~ s/<\/?[a-zA-Z][^>]*>//gi; # remove HTML tags | ||||
442 | $anchorName =~ s/&#?[a-zA-Z0-9]+;//g; # remove HTML entities | ||||
443 | $anchorName =~ s/&//g; # remove & | ||||
444 | # filter TOC excludes if not at beginning | ||||
445 | $anchorName =~ s/^(.+?)\s*$Foswiki::regex{headerPatternNoTOC}.*/$1/; | ||||
446 | |||||
447 | # filter '!!', '%NOTOC%' | ||||
448 | $anchorName =~ s/$Foswiki::regex{headerPatternNoTOC}//; | ||||
449 | |||||
450 | # No matter what character set we use, the HTML standard does not allow | ||||
451 | # anything else than English alphanum characters in anchors | ||||
452 | # So we convert anything non A-Za-z0-9_ to underscores | ||||
453 | # and limit the number consecutive of underscores to 1 | ||||
454 | # This means that pure non-English anchors will become A, A_AN1, A_AN2, ... | ||||
455 | # We accept anchors starting with 0-9. It is non RFC but it works and it | ||||
456 | # is very important for compatibility | ||||
457 | $anchorName =~ s/[^A-Za-z0-9]+/_/g; | ||||
458 | $anchorName =~ s/__+/_/g; # remove excessive '_' chars | ||||
459 | |||||
460 | if ( !$compatibilityMode ) { | ||||
461 | $anchorName =~ s/^[\s#_]+//; # no leading space nor '#', '_' | ||||
462 | } | ||||
463 | |||||
464 | $anchorName =~ s/^$/A/; # prevent empty anchor | ||||
465 | |||||
466 | # limit to 32 chars | ||||
467 | $anchorName =~ s/^(.{32})(.*)$/$1/; | ||||
468 | if ( !$compatibilityMode ) { | ||||
469 | $anchorName =~ s/[\s_]+$//; # no trailing space, nor '_' | ||||
470 | } | ||||
471 | return $anchorName; | ||||
472 | } | ||||
473 | |||||
474 | 1 | 2µs | 1; | ||
475 | __END__ |