/[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 61 - (show annotations)
Thu Jan 29 18:26:19 2004 UTC (16 years, 9 months ago) by dpavlin
File size: 3405 byte(s)
better extracting of titles

1 sub filter {
2 my $contents = shift || return;
3
4 my $verbose = 0;
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 } elsif ($contents =~ m,<h\d\sclass="chapter"[^>]*>(.+?)</h\d>,is) {
58 $new_title = $1;
59 } elsif ($contents =~ m,<h\d\sclass="sect1"[^>]*>(.+?)</h\d>,is) {
60 $new_title = $1;
61 } else {
62 if ($contents =~ m,<title>([^<]+)</title>,is) {
63 $new_title = $1;
64 } elsif ($contents =~ m,<h\d[^>]*>([^<]+)</h\d>,is) {
65 $new_title = $1;
66 }
67 }
68
69 if ($new_title) {
70 # nuke html in title
71 $new_title =~ s/<br>\s+/: /gs;
72 $new_title =~ s/<\/*[^>]+>//gs;
73
74 # check if new title is same as collection name
75 my ($a,$b) = ($new_title,$collection);
76 $a =~ s/([^a-zA-Z])+/ /gs;
77 $b =~ s/([^a-zA-Z])+/ /gs;
78 if ($a =~ m/$b/i) {
79 $new_title = $collection;
80 } else {
81 $new_title = "$collection :: $new_title";
82 }
83 } else {
84 # fall-back to collection title
85 $new_title = $collection;
86 }
87
88 $new_title =~ s/\s\s+/ /g;
89
90 if ($contents =~ s,<title>(.*)</title>,<title>$new_title</title>,is) {
91 print STDERR "replace title '$1' with '$new_title'\n" if ($verbose);
92 } elsif (
93 # try to insert after <head>, <html> or at top
94 $contents =~ s,(<head>),$1<title>$new_title</title>,is ||
95 $contents =~ s,(<html>),$1<title>$new_title</title>,is ||
96 $contents =~ s,^,<title>$new_title</title>, ) {
97 print STDERR "adding new title '$new_title'\n" if ($verbose);
98 }
99
100 return $contents;
101 }
102
103 1;

Properties

Name Value
cvs2svn:cvs-rev 1.5

  ViewVC Help
Powered by ViewVC 1.1.26