/[swish]/trunk/spider/filter.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/spider/filter.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 57 - (show annotations)
Sun Jan 25 16:49:50 2004 UTC (20 years, 2 months ago) by dpavlin
File size: 3144 byte(s)
various fixes

1 sub filter {
2 my $contents = shift || return;
3
4 # my $verbose = 1;
5
6 # if you don't want content to be indexed, include it in
7 # <noindex> foobar </noindex> tags or surround it with comments
8 # <!-- noindex --> foobar <!-- /noindex -->
9 # <!-- noindex --> foobar <!-- index --> (also supported by swish)
10 $contents =~ s,<noindex>.+?</noindex>,,isg;
11 $contents =~ s,<!--\s*noindex\s*-->.+?<!--\s*/noindex\s*-->,,isg;
12 $contents =~ s,<!--\s*noindex\s*-->.+?<!--\s*index\s*-->,,isg;
13 # this will remove all script from indexing content
14 $contents =~ s,<script[^>]*>.+?</script>,,isg;
15 # remap Windows charset to ISO-8859-2
16 $contents =~ tr/šðžèæŠÐŽÈÆ/¹ð¾èæ©Ð®ÈÆ/; # 1250 -> iso8859-2
17 # this will fix badly formatted html in form:
18 # <head><title>some text</title
19 # ></head>
20 # which will confuse indexer (or libxml2?)
21 $contents =~ s/[\n\r]^(>)/$1\n/msg;
22 # remove comments between <html> and <head> texi2html inserts them
23 # there and swish can't find document title then (libxml or swish bug?)
24 while ($contents =~ s/(<html>.*)<!--.*?-->(.*<head>)/$1$2/msi) { };
25
26 # remote TPJ left column
27 if ($contents =~ s,<!-- BEGIN LEFT SIDE BAR CELL -->.+?<!-- END LEFT SIDE BAR CELL -->,,isg) {
28 my $title;
29 # extract title and add to title
30 if ($contents =~ m,<!-- the article goes here -->\s*<h2[^>]*>(.+?)</h2>,si) {
31 $title = $1;
32 } elsif ($contents =~ m,<h1[^>]*>(.+?)</h1>,is) {
33 $title = $1;
34 } elsif ($contents =~ m,<h2[^>]*>(.+?)</h2>,is) {
35 $title = $1;
36 } else {
37 $title = "no detail title";
38 }
39 $contents =~ s,(<title>)([^<]+)(</title>),$1$2: $title$3,gsi if ($title);
40
41 }
42
43 # is second argument collection?
44 my $collection = shift || return $contents;
45
46 # construct new title (from various parts of DocBook if available)
47 my $new_title;
48
49 if ($contents =~ m,<!--SafTocEntry="([^"]+)"-->,is) {
50 $new_title = $1;
51 } elsif ($contents =~ m,<h\d\sclass="docPartTitle"[^>]*>([^<]+)</h\d>,is) {
52 $new_title = $1;
53 } elsif ($contents =~ m,<h\d\sclass="docChapterTitle"[^>]*>([^<]+)</h\d>,is) {
54 $new_title = $1;
55 } elsif ($contents =~ m,<h\d\sclass="docSection1Title"[^>]*>([^<]+)</h\d>,is) {
56 $new_title = $1;
57 } else {
58 if ($contents =~ m,<title>([^<]+)</title>,is) {
59 $new_title = $1;
60 } elsif ($contents =~ m,<h\d[^>]*>([^<]+)</h\d>,is) {
61 $new_title = $1;
62 }
63 }
64
65 if ($new_title) {
66 # check if new title is same as collection name
67 my ($a,$b) = ($new_title,$collection);
68 $a =~ s/([^a-zA-Z])+/ /gs;
69 $b =~ s/([^a-zA-Z])+/ /gs;
70 if ($a =~ m/$b/i) {
71 $new_title = $collection;
72 } else {
73 $new_title = "$collection :: $new_title";
74 }
75 } else {
76 # fall-back to collection title
77 $new_title = $collection;
78 }
79
80 $new_title =~ s/\s\s+/ /g;
81
82 if ($contents =~ s,<title>(.*)</title>,<title>$new_title</title>,is) {
83 print STDERR "replace title '$1' with '$new_title'\n" if ($verbose);
84 } elsif (
85 # try to insert after <head>, <html> or at top
86 $contents =~ s,(<head>),$1<title>$new_title</title>,is ||
87 $contents =~ s,(<html>),$1<title>$new_title</title>,is ||
88 $contents =~ s,^,<title>$new_title</title>, ) {
89 print STDERR "adding new title '$new_title'\n" if ($verbose);
90 }
91
92 return $contents;
93 }
94
95 1;

Properties

Name Value
cvs2svn:cvs-rev 1.4

  ViewVC Help
Powered by ViewVC 1.1.26