Develop and Download Open Source Software

Browse CVS Repository

Contents of /h14m/namazu_for_hns/hnf.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.15 - (show annotations) (download) (as text)
Wed May 23 01:36:58 2007 UTC (16 years, 11 months ago) by kenji
Branch: MAIN
CVS Tags: HEAD
Changes since 1.14: +13 -5 lines
File MIME type: text/x-perl
fix GRPed summary disclosure and some fixes as namazu filter

1 #
2 # -*- Perl -*-
3 # $Id: hnf.pl,v 1.9.4.3 2005/06/06 06:13:35 opengl2772 Exp $
4 #
5 # hnf filter for Namazu 2.0
6 # version 0.9.16
7 # 2007/5/23 Kenji Suzuki <kenji@h14m.org>
8 #
9 # Copyright (C) 1999-2007 Kenji Suzuki, HyperNikkiSystem Project
10 # All rights reserved.
11 # Copyright (C) 2005 Namazu Project All rights reserved ,
12 # This is free software with ABSOLUTELY NO WARRANTY.
13 #
14 # This program is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either versions 2, or (at your option)
17 # any later version.
18 #
19 # This program is distributed in the hope that it will be useful
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
27 # 02111-1307, USA
28 #
29 # This file must be encoded in EUC-JP encoding
30 #
31
32 package hnf;
33 use strict;
34 require 'util.pl';
35 require 'gfilter.pl';
36 require 'html.pl';
37
38
39 sub mediatype() {
40 return ('text/hnf');
41 }
42
43 sub status() {
44 # The check of a dependence filter.
45 return 'no' if (html::status() ne 'yes');
46
47 return 'yes';
48 }
49
50 sub recursive() {
51 return 0;
52 }
53
54 sub pre_codeconv() {
55 return 1;
56 }
57
58 sub post_codeconv () {
59 return 0;
60 }
61
62 sub add_magic ($) {
63 return;
64 }
65
66 sub filter ($$$$$) {
67 my ($orig_cfile, $contref, $weighted_str, $headings, $fields)
68 = @_;
69 my $cfile = defined $orig_cfile ? $$orig_cfile : '';
70
71 util::vprint("Processing hnf file ...\n");
72
73 my $mark = "# ";
74 my $end = "--";
75 $mark = "��" if util::islang("ja");
76 $end = "��" if util::islang("ja");
77
78 get_uri($cfile, $fields);
79 hnf_filter($contref, $weighted_str, $fields, $headings, $cfile,
80 $mark, $end);
81 html::html_filter($contref, $weighted_str, $fields, $headings);
82 $fields->{'summary'} =
83 make_summary($contref, $headings, $cfile, $mark, $end);
84
85 gfilter::line_adjust_filter($contref);
86 gfilter::line_adjust_filter($weighted_str);
87 gfilter::white_space_adjust_filter($contref);
88 gfilter::show_filter_debug_info($contref, $weighted_str,
89 $fields, $headings);
90 return undef;
91 }
92
93 sub hnf_filter ($$$$$$$) {
94 my ($contref, $weighted_str, $fields, $headings, $cfile, $mark, $end) = @_;
95
96 $$contref =~ s/</&lt;/g;
97 $$contref =~ s/>/&gt;/g;
98
99 # has OK?
100 if ($$contref =~ /^OK$/m) {
101 # has correct User Variable?
102 my @tmp = split ("OK\n", $$contref);
103 my $header = $tmp[0];
104
105 # illeagel hnf header means having no OK
106 if ($header =~ /\nCAT |\nNEW\s|\nLNEW |\nRLNEW /) {
107 $$contref = "\ncommand_NG\n"; # NG is a pseudo-command
108 }
109 else {
110 $tmp[0] = "";
111 $$contref = join("OK\n", @tmp);
112 $$contref =~ s/OK\n//;
113 $$contref .= "\ncommand_OK\n" . $header;
114 }
115 }
116 # has no OK
117 else {
118 $$contref = "\ncommand_NG\n"; # NG is a pseudo-command
119 }
120
121 # Title & Date string (YYYYMMDD)
122 my $title = $cfile;
123 $title =~ s/(.*)\/d(\d{8,})\.hnf/$2/;
124 my $date = $title;
125 $title =~ s/(\d{4,})(\d\d)(\d\d)/$1\/$2\/$3/;
126 $$contref = "<title>$title</title>\n" . $$contref;
127
128 # ~
129 $$contref =~ s/~\n/\n/g;
130
131 # command
132 $$contref =~ s/^GRP (.*)/command_GRP $1/gm;
133 $$contref =~ s/^CAT (.*)/command_CAT CAT $1/gm;
134 $$contref =~ s/^NEW\s(.*)/command_NEW <h1>$mark$1<\/h1>/gm;
135 $$contref =~
136 s/^LNEW (.*?) (.*)/command_LNEW <h1>$mark<a href=\"$1\">$2<\/a><\/h1>/gm;
137 $$contref =~
138 s/^RLNEW (.*?) (.*?) (.*)/command_RLNEW <h1>$mark<a href=\"$1 $2\">$3<\/a><\/h1>/gm;
139 $$contref =~ s/command_GRP (.*)\n/command_GRP $1 /gm;
140 $$contref =~ s/command_CAT (.*)\n/command_CAT $1 /gm;
141
142 # hiding GRP section
143 $$contref =~ s/^command_GRP (.*)<h1>(.*)<\/h1>/command_GRP $1 $2/gm
144 if $hnf::grp_hide;
145
146 $$contref =~ s/^SUB\s(.*)/
147 command_SUB <strong>$1<\/strong>/gm;
148 $$contref =~ s/^LSUB (.*?) (.*)/
149 command_LSUB <strong><a href=\"$1\">$2<\/a><\/strong>/gm;
150 $$contref =~ s/^RLSUB (.*?) (.*?) (.*)/
151 command_RLSUB <strong><a href=\"$1 $2\">$3<\/a><\/strong>/gm;
152
153 $$contref =~ s/^LINK (.*?) (.*)/
154 command_LINK <a href=\"$1\">$2<\/a>/gm;
155 $$contref =~ s/^URL (.*?) (.*)/
156 command_URL <a href=\"$1\">$2<\/a>/gm;
157 $$contref =~ s/^RLINK (.*?) (.*?) (.*)/
158 command_RLINK <a href=\"$1 $2\">$3<\/a>/gm;
159
160 $$contref =~ s/^FONT (.*?) (.*?) (.*)/
161 command_FONT $1 $2 $3/gm;
162 $$contref =~ s/^SPAN (.*?) (.*)/
163 command_SPAN $1 $2/gm;
164 $$contref =~ s/^DIV\s(.*)/
165 command_DIV $1/gm;
166
167 $$contref =~ s/^PRE\s*$/
168 command_PRE/gm;
169 $$contref =~ s/^P\s*$/
170 command_P/gm;
171 $$contref =~ s/^CITE\s(.*)/
172 command_CITE $1/gm;
173 $$contref =~ s/^RT\s*$/
174 command_RT/gm;
175
176 $$contref =~ s/\nFN\n/
177 command_FN\n/g;
178
179 $$contref =~ s/^UL$/
180 command_UL/gm;
181 $$contref =~ s/^OL$/
182 command_OL/gm;
183 $$contref =~ s/^DL$/
184 command_DL/gm;
185
186 $$contref =~ s/^\/([A-Z]+)$//gm;
187
188 $$contref =~ s/^LI\s(.*)$/$1/gm;
189 $$contref =~ s/^DT\s(.*)$/$1/gm;
190 $$contref =~ s/^DD\s(.*)$/$1/gm;
191
192 $$contref =~ s/^STRIKE (.*)/
193 command_STRIKE <strike>$1<\/strike>/gm;
194 $$contref =~ s/^LSTRIKE (.*?) (.*)/
195 command_LSTRIKE <strike><a href=\"$1\">$2<\/a><\/strike>/gm;
196
197 $$contref =~ s/^STRONG (.*)/
198 command_STRONG <strong>$1<\/strong>/gm;
199
200 $$contref =~ s/^IMG (.*?) (.*?) (.*)/
201 command_IMG $1 $2 $3/gm;
202 $$contref =~ s/^LIMG (.*?) (.*?) (.*?) (.*)/
203 command_LIMG $1 $2 $3 $4/gm;
204
205 $$contref =~ s/^MARK (.*)/
206 command_MARK $1/gm;
207
208 if ($$contref =~ /^ALIAS (.*)/m) {
209 read_alias_file() unless $hnf::alias{$1};
210 }
211 $$contref =~ s/^ALIAS (.*)/
212 command_ALIAS $hnf::alias{$1}/gm;
213
214 $$contref .= "<h1>$end</h1>";
215 $$contref .= $date;
216 }
217
218 sub get_uri ($$) {
219 my ($cfile, $fields) = @_;
220
221 my ($uri);
222 my (%param);
223 if ($cfile =~ /^(.*)\/d(\d\d\d\d*)([0-1]\d)([0-3])(\d)\.hnf$/) {
224 $param{'year'} = $2;
225 $param{'month'} = $3;
226 $param{'day'} = $4 . $5;
227 $param{'hiday'} = $4;
228 if ($param{'day'} < 11) {
229 $param{'abc'} = "a";
230 }
231 elsif ($param{'day'} < 21) {
232 $param{'abc'} = "b";
233 }
234 else {
235 $param{'abc'} = "c";
236 }
237 if ($hnf::link_templ) {
238 $uri = $hnf::link_templ;
239 }
240 elsif ($hnf::hns_version >= 2) {
241 $uri = '?%year%month%abc#%year%month%day0'; # for hns-2.00 or later
242 }
243 else {
244 $uri = '?%year%month%hiday#%year%month%day0'; # for hns-1.x
245 }
246 $uri =~ s/%%/\34/g;
247 $uri =~ s/%{?([a-z]+)}?/$param{$1}/g;
248 $uri =~ s/\34/%/g;
249 $uri = $hnf::diary_uri . $uri;
250 $uri =~ s/%7E/~/i;
251 }
252 $fields->{'uri'} = $uri;
253 $fields->{'author'} = $hnf::author;
254 }
255
256 sub make_summary ($$$$$) {
257 my ($contref, $headings, $cfile, $mark, $end) = @_;
258
259 # pick up $conf::MAX_FIELD_LENGTH bytes string
260 my $tmp = "";
261 if ($$headings ne "") {
262 $$headings =~ s/^\s+//;
263 $$headings =~ s/\s+/ /g;
264 $tmp = $$headings;
265 $tmp = "" if $tmp eq "$end "; # for no OK hnf
266 } else {
267 $tmp = "";
268 }
269
270 my $offset = 0;
271 my $tmplen = 0;
272 my $tmp2 = $$contref;
273
274 # hiding GRP section
275 if ($hnf::grp_hide) {
276 while ($tmp2 =~ /\ncommand_GRP /) {
277 $tmp2 =~ s/\ncommand_GRP .*?\ncommand_/\ncommand_/gs;
278 }
279 }
280
281 $tmp2 =~ s/\ncommand_OK\n.*//s; # remove below of command_OK
282 $tmp2 =~ s/\ncommand_NG\n.*//s; # remove below of command_NG
283 $tmp2 =~ s/command_CAT CAT .*//gm;
284 $tmp2 =~ s/command_[A-Z]+//g;
285 $tmp2 =~ s/^! .*$//gm;
286 $tmp2 =~ s/^!# .*$//gm;
287
288 while (($tmplen = $conf::MAX_FIELD_LENGTH + 1 - length($tmp)) > 0
289 && $offset < length($tmp2))
290 {
291 $tmp .= substr $tmp2, $offset, $tmplen;
292 $offset += $tmplen;
293 $tmp =~ s/(([\xa1-\xfe]).)/$2 eq "\xa8" ? '': $1/ge;
294 $tmp =~ s/([-=*\#])\1{2,}/$1$1/g;
295 }
296
297 my $summary = substr $tmp, 0, $conf::MAX_FIELD_LENGTH;
298 my $kanji = $summary =~ tr/\xa1-\xfe/\xa1-\xfe/;
299 $summary .= substr($tmp, $conf::MAX_FIELD_LENGTH, 1) if $kanji %2;
300 $summary =~ s/^\s+//;
301 $summary =~ s/\s+/ /g; # normalize white spaces
302
303 if ($summary eq "") { # for GRPed section
304 $summary = "n/a";
305 }
306
307 return $summary;
308 }
309
310 sub read_alias_file () {
311 if (-f $hnf::alias_file) {
312 my $def = util::readfile($hnf::alias_file);
313 codeconv::normalize_document(\$def);
314 my @aliases = split("\n", $def);
315 foreach (@aliases) {
316 if ($_ =~ /(\S+) (.*)/) {
317 $hnf::alias{$1} = $2;
318 util::vprint("alias: $1 $2\n");
319 }
320 }
321 }
322 }
323
324 1;

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26