1 |
# -*- Perl -*- |
2 |
# TDF Filter for Namazu 2.0 |
3 |
# version 0.1.1 |
4 |
# 2001/02/05 TANAKA Yoji as Osakana <osakana@dive-in.to> |
5 |
# 2001/02/06 TANAKA Tomonari <tom@morito.mgmt.waseda.ac.jp> |
6 |
# |
7 |
# This is free software with ABSOLUTELY NO WARRANTY. |
8 |
# |
9 |
# This program is free software; you can redistribute it and/or modify |
10 |
# it under the terms of the GNU General Public License as published by |
11 |
# the Free Software Foundation; either versions 2, or (at your option) |
12 |
# any later version. |
13 |
# |
14 |
# This program is distributed in the hope that it will be useful |
15 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
17 |
# GNU General Public License for more details. |
18 |
# |
19 |
# You should have received a copy of the GNU General Public License |
20 |
# along with this program; if not, write to the Free Software |
21 |
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
22 |
# 02111-1307, USA |
23 |
# |
24 |
# This file must be encoded in EUC-JP encoding |
25 |
# |
26 |
################################################################ |
27 |
|
28 |
package tdf; |
29 |
no strict; |
30 |
require 'util.pl'; |
31 |
require 'gfilter.pl'; |
32 |
require 'html.pl'; |
33 |
|
34 |
sub mediatype() { |
35 |
return ('text/plain; x-type=tdf'); |
36 |
} |
37 |
|
38 |
sub status() { |
39 |
return 'yes'; |
40 |
} |
41 |
|
42 |
sub recursive() { |
43 |
return 0; |
44 |
} |
45 |
|
46 |
sub pre_codeconv() { |
47 |
return 1; |
48 |
} |
49 |
|
50 |
sub post_codeconv () { |
51 |
return 0; |
52 |
} |
53 |
|
54 |
sub add_magic ($) { |
55 |
my ($magic) = @_; |
56 |
$magic->addFileExts('\\.tdf$', 'text/plain; x-type=tdf'); |
57 |
$magic->addFileExts('\\.h2h$', 'text/plain; x-type=tdf'); |
58 |
$magic->addFileExts('\\.hnf$', 'text/plain; x-type=tdf'); |
59 |
return; |
60 |
} |
61 |
|
62 |
sub filter ($$$$$) { |
63 |
my ($orig_cfile, $contref, $weighted_str, $headings, $fields) |
64 |
= @_; |
65 |
my $cfile = defined $orig_cfile ? $$orig_cfile : ''; |
66 |
|
67 |
my %mark; # topic mark |
68 |
|
69 |
if (util::islang("ja")){ |
70 |
$mark{'new'} = $tdf::mark->{ja}->{'new'} || "¡û"; # NEW |
71 |
$mark{'sub'} = $tdf::mark->{ja}->{'sub'} || "¡÷"; # SUB |
72 |
$mark{'end'} = $tdf::mark->{ja}->{'end'} || "¢§"; # end of topic summary |
73 |
} else { |
74 |
$mark{'new'} = $tdf::mark->{en}->{'new'} || "# "; |
75 |
$mark{'sub'} = $tdf::mark->{en}->{'sub'} || "@ "; |
76 |
$mark{'end'} = $tdf::mark->{en}->{'end'} || "--"; |
77 |
} |
78 |
# start |
79 |
util::vprint("Processing tdf file ...\n"); |
80 |
|
81 |
get_uri($cfile, $fields); |
82 |
tdf_filter($contref, $fields, $cfile, %mark); |
83 |
html::html_filter($contref, $weighted_str, $fields, $headings); |
84 |
$fields->{'summary'} = |
85 |
make_summary($contref, $headings); |
86 |
|
87 |
gfilter::line_adjust_filter($contref); |
88 |
gfilter::line_adjust_filter($weighted_str); |
89 |
gfilter::white_space_adjust_filter($contref); |
90 |
gfilter::show_filter_debug_info($contref, $weighted_str, |
91 |
$fields, $headings); |
92 |
return undef; |
93 |
} |
94 |
|
95 |
sub tdf_filter ($$$$) |
96 |
{ |
97 |
my ($contref, $fields, $cfile, %mark) = @_; |
98 |
|
99 |
$$contref =~ s/</</g; |
100 |
$$contref =~ s/>/>/g; |
101 |
|
102 |
# convert filename to title (pickup as date) |
103 |
my $title; |
104 |
$title = $fields->{'title'}; |
105 |
$$contref = "<title>$title</title>\n" . ($$contref) if $$contref; |
106 |
# /~$/ |
107 |
$$contref =~ s/~\n/\n/g; |
108 |
|
109 |
# hide secret part |
110 |
my @lines = split("\n", $$contref); |
111 |
my $l = ""; |
112 |
for (@lines){ |
113 |
next if /^#/; |
114 |
next if /^HIDE/.../^\/HIDE/; |
115 |
next if /^SECRET/.../^\/SECRET/; |
116 |
next if /^COMMENT/.../^\/COMMENT/; |
117 |
|
118 |
if (/^SNEW/.../^NEW/){ |
119 |
next unless /^NEW/; |
120 |
} |
121 |
if (/^SSUB/.../^(NEW|SUB)/){ |
122 |
next unless /^(NEW|SUB)/; |
123 |
} |
124 |
$l .= "$_\n"; |
125 |
} |
126 |
$$contref = $l; |
127 |
|
128 |
# command transform |
129 |
$$contref =~ s!^NEW (.*)!<h1>$mark{'new'}$1</h1>$mark{'new'}$1!gm; |
130 |
$$contref =~ s!^SUB (.*)!<h1>$mark{'sub'}$1</h1>$mark{'sub'}$1!gm; |
131 |
$$contref =~ s/^CAT (.*)/\[$1\]/gm; |
132 |
|
133 |
# footer |
134 |
$$contref .= "<h1>$mark{'end'}</h1>" if $$contref; |
135 |
# $$contref .= $cfile; |
136 |
} |
137 |
|
138 |
sub make_summary ($$) { |
139 |
my ($contref, $headings) = @_; |
140 |
|
141 |
# pick up $conf::MAX_FIELD_LENGTH bytes string |
142 |
my $tmp = ""; |
143 |
if ($$headings ne "") { |
144 |
$$headings =~ s/^\s+//; |
145 |
$$headings =~ s/\s+/ /g; |
146 |
$tmp = $$headings; |
147 |
} |
148 |
|
149 |
my $offset = 0; |
150 |
my $tmplen = 0; |
151 |
my $tmp2 = $$contref; |
152 |
|
153 |
while (($tmplen = $conf::MAX_FIELD_LENGTH + 1 - length($tmp)) > 0 |
154 |
&& $offset < length($tmp2)) |
155 |
{ |
156 |
$tmp .= substr $tmp2, $offset, $tmplen; |
157 |
$offset += $tmplen; |
158 |
$tmp =~ s/(([\xa1-\xfe]).)/$2 eq "\xa8" ? '': $1/ge; |
159 |
$tmp =~ s/([-=*\#])\1{2,}/$1$1/g; |
160 |
} |
161 |
|
162 |
my $summary = substr $tmp, 0, $conf::MAX_FIELD_LENGTH; |
163 |
my $kanji = $summary =~ tr/\xa1-\xfe/\xa1-\xfe/; |
164 |
$kanji ||= 0; |
165 |
$summary .= substr($tmp, $conf::MAX_FIELD_LENGTH, 1) if $kanji %2; |
166 |
$summary =~ s/^\s+//; |
167 |
$summary =~ s/\s+/ /g; # normalize white spaces |
168 |
|
169 |
return $summary; |
170 |
|
171 |
return $$headings; |
172 |
} |
173 |
|
174 |
sub get_uri ($$) |
175 |
{ |
176 |
my ($cfile, $fields) = @_; |
177 |
|
178 |
if ($cfile =~ /^(.*)(\d{4,})\/(\d\d)\/(\d\d)\.tdf$/) { |
179 |
my $year = $2; |
180 |
my $month = $3; |
181 |
my $day = $4; |
182 |
my $part = ""; |
183 |
if ($day < 10) { |
184 |
$part = "a"; |
185 |
} elsif ($day < 20) { |
186 |
$part = "b"; |
187 |
} else { |
188 |
$part = "c"; |
189 |
} |
190 |
my $uri; |
191 |
if ($tdf::mode eq 'static'){ # static |
192 |
$uri = "d$year$month$part.html#$day"; |
193 |
} else { |
194 |
$uri = "?$year$month$day#$day"; |
195 |
# $uri = "?$year$month$part#$day"; # partly |
196 |
} |
197 |
$uri = $tdf::diary_url . $uri; |
198 |
$uri =~ s/%7E/~/i; |
199 |
$fields->{'uri'} = $uri; |
200 |
$fields->{'title'} = "$year/$month/$day"; |
201 |
$fields->{'author'} = $tdf::author; |
202 |
} |
203 |
} |
204 |
1; |
205 |
|
206 |
# ChangeLog |
207 |
# 2001/02/06 TANAKA Tomonari <tom@morito.mgmt.waseda.ac.jp> |
208 |
# * revise tdf_filter() |
209 |
|