/[suikacvs]/www/namazu/filter/tdf.pl
Suika

Contents of /www/namazu/filter/tdf.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Fri Nov 30 07:56:45 2001 UTC (22 years, 5 months ago) by wakaba
Branch: MAIN, wakaba
CVS Tags: initial, HEAD
Changes since 1.1: +0 -0 lines
File MIME type: text/plain

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/</&lt;/g;
100 $$contref =~ s/>/&gt;/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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24