| 1 |
# |
| 2 |
# -*- Perl -*- |
| 3 |
# $Id: hnf.pl,v 1.12 2001/01/14 13:31:44 kenji Exp $ |
| 4 |
# |
| 5 |
# hnf filter for Namazu 2.0 |
| 6 |
# version 0.9.14 |
| 7 |
# 2001/1/14 Kenji Suzuki <kenji@h14m.org> |
| 8 |
# |
| 9 |
# Copyright (C) 1999-2001 Kenji Suzuki, HyperNikkiSystem Project |
| 10 |
# All rights reserved. |
| 11 |
# |
| 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 |
return 'yes'; |
| 45 |
} |
| 46 |
|
| 47 |
sub recursive() { |
| 48 |
return 0; |
| 49 |
} |
| 50 |
|
| 51 |
sub pre_codeconv() { |
| 52 |
return 1; |
| 53 |
} |
| 54 |
|
| 55 |
sub post_codeconv () { |
| 56 |
return 0; |
| 57 |
} |
| 58 |
|
| 59 |
sub add_magic ($) { |
| 60 |
return; |
| 61 |
} |
| 62 |
|
| 63 |
sub filter ($$$$$) { |
| 64 |
my ($orig_cfile, $contref, $weighted_str, $headings, $fields) |
| 65 |
= @_; |
| 66 |
my $cfile = defined $orig_cfile ? $$orig_cfile : ''; |
| 67 |
|
| 68 |
util::vprint("Processing hnf file ...\n"); |
| 69 |
|
| 70 |
my $mark = "# "; |
| 71 |
my $end = "--"; |
| 72 |
$mark = "¢£" if util::islang("ja"); |
| 73 |
$end = "¢§" if util::islang("ja"); |
| 74 |
|
| 75 |
get_uri($cfile, $fields); |
| 76 |
hnf_filter($contref, $weighted_str, $fields, $headings, $cfile, |
| 77 |
$mark, $end); |
| 78 |
html::html_filter($contref, $weighted_str, $fields, $headings); |
| 79 |
$fields->{'summary'} = |
| 80 |
make_summary($contref, $headings, $cfile, $mark, $end); |
| 81 |
|
| 82 |
gfilter::line_adjust_filter($contref); |
| 83 |
gfilter::line_adjust_filter($weighted_str); |
| 84 |
gfilter::white_space_adjust_filter($contref); |
| 85 |
gfilter::show_filter_debug_info($contref, $weighted_str, |
| 86 |
$fields, $headings); |
| 87 |
return undef; |
| 88 |
} |
| 89 |
|
| 90 |
sub hnf_filter ($$$$$$$) { |
| 91 |
my ($contref, $weighted_str, $fields, $headings, $cfile, $mark, $end) = @_; |
| 92 |
|
| 93 |
$$contref =~ s/</</g; |
| 94 |
$$contref =~ s/>/>/g; |
| 95 |
|
| 96 |
# has OK? |
| 97 |
if ($$contref =~ /^OK$/m) { |
| 98 |
# has correct User Variable? |
| 99 |
my @tmp = split ("OK\n", $$contref); |
| 100 |
my $header = $tmp[0]; |
| 101 |
|
| 102 |
# illeagel hnf header means having no OK |
| 103 |
if ($header =~ /\nCAT |\nNEW\s|\nLNEW |\nRLNEW /) { |
| 104 |
$$contref = "\ncommand_NG\n"; # NG is a pseudo-command |
| 105 |
} |
| 106 |
else { |
| 107 |
$tmp[0] = ""; |
| 108 |
$$contref = join("OK\n", @tmp); |
| 109 |
$$contref =~ s/OK\n//; |
| 110 |
$$contref .= "\ncommand_OK\n" . $header; |
| 111 |
} |
| 112 |
} |
| 113 |
# has no OK |
| 114 |
else { |
| 115 |
$$contref = "\ncommand_NG\n"; # NG is a pseudo-command |
| 116 |
} |
| 117 |
|
| 118 |
# Title & Date string (YYYYMMDD) |
| 119 |
my $title = $cfile; |
| 120 |
$title =~ s/(.*)\/d(\d{8,})\.hnf/$2/; |
| 121 |
my $date = $title; |
| 122 |
$title =~ s/(\d{4,})(\d\d)(\d\d)/$1\/$2\/$3/; |
| 123 |
$$contref = "<title>$title</title>\n" . $$contref; |
| 124 |
|
| 125 |
# ~ |
| 126 |
$$contref =~ s/~\n/\n/g; |
| 127 |
|
| 128 |
# command |
| 129 |
$$contref =~ s/^GRP (.*)/command_GRP $1/gm; |
| 130 |
$$contref =~ s/^CAT (.*)/command_CAT CAT $1/gm; |
| 131 |
$$contref =~ s/^NEW\s(.*)/command_NEW <h1>$mark$1<\/h1>/gm; |
| 132 |
$$contref =~ |
| 133 |
s/^LNEW (.*?) (.*)/command_LNEW <h1>$mark<a href=\"$1\">$2<\/a><\/h1>/gm; |
| 134 |
$$contref =~ |
| 135 |
s/^RLNEW (.*?) (.*?) (.*)/command_RLNEW <h1>$mark<a href=\"$1 $2\">$3<\/a><\/h1>/gm; |
| 136 |
$$contref =~ s/command_GRP (.*)\n/command_GRP $1 /gm; |
| 137 |
$$contref =~ s/command_CAT (.*)\n/command_CAT $1 /gm; |
| 138 |
|
| 139 |
# hiding GRP section |
| 140 |
$$contref =~ s/^command_GRP (.*)<h1>(.*)<\/h1>/command_GRP $1 $2/gm |
| 141 |
if $hnf::grp_hide; |
| 142 |
|
| 143 |
$$contref =~ s/^SUB (.*)/ |
| 144 |
command_SUB <strong>$1<\/strong>/gm; |
| 145 |
$$contref =~ s/^LSUB (.*?) (.*)/ |
| 146 |
command_LSUB <strong><a href=\"$1\">$2<\/a><\/strong>/gm; |
| 147 |
$$contref =~ s/^RLSUB (.*?) (.*?) (.*)/ |
| 148 |
command_RLSUB <strong><a href=\"$1 $2\">$3<\/a><\/strong>/gm; |
| 149 |
|
| 150 |
$$contref =~ s/^LINK (.*?) (.*)/ |
| 151 |
command_LINK <a href=\"$1\">$2<\/a>/gm; |
| 152 |
$$contref =~ s/^URL (.*?) (.*)/ |
| 153 |
command_URL <a href=\"$1\">$2<\/a>/gm; |
| 154 |
$$contref =~ s/^RLINK (.*?) (.*?) (.*)/ |
| 155 |
command_RLINK <a href=\"$1 $2\">$3<\/a>/gm; |
| 156 |
|
| 157 |
$$contref =~ s/^FONT (.*?) (.*?) (.*)/ |
| 158 |
command_FONT $1 $2 $3/gm; |
| 159 |
$$contref =~ s/^SPAN (.*?) (.*)/ |
| 160 |
command_SPAN $1 $2/gm; |
| 161 |
$$contref =~ s/^DIV\s(.*)/ |
| 162 |
command_DIV $1/gm; |
| 163 |
|
| 164 |
$$contref =~ s/^PRE\s$/ |
| 165 |
command_PRE/gm; |
| 166 |
$$contref =~ s/^P\s$/ |
| 167 |
command_P/gm; |
| 168 |
$$contref =~ s/^CITE\s(.*)/ |
| 169 |
command_CITE $1/gm; |
| 170 |
|
| 171 |
$$contref =~ s/\nFN\n/ |
| 172 |
command_FN\n/g; |
| 173 |
|
| 174 |
$$contref =~ s/^UL$/ |
| 175 |
command_UL/gm; |
| 176 |
$$contref =~ s/^OL$/ |
| 177 |
command_OL/gm; |
| 178 |
$$contref =~ s/^DL$/ |
| 179 |
command_DL/gm; |
| 180 |
|
| 181 |
$$contref =~ s/^\/([A-Z]+)$//gm; |
| 182 |
|
| 183 |
$$contref =~ s/^LI\s(.*)$/$1/gm; |
| 184 |
$$contref =~ s/^DT\s(.*)$/$1/gm; |
| 185 |
$$contref =~ s/^DD\s(.*)$/$1/gm; |
| 186 |
|
| 187 |
$$contref =~ s/^STRIKE (.*)/ |
| 188 |
command_STRIKE <strike>$1<\/strike>/gm; |
| 189 |
$$contref =~ s/^LSTRIKE (.*?) (.*)/ |
| 190 |
command_LSTRIKE <strike><a href=\"$1\">$2<\/a><\/strike>/gm; |
| 191 |
|
| 192 |
$$contref =~ s/^STRONG (.*)/ |
| 193 |
command_STRONG <strong>$1<\/strong>/gm; |
| 194 |
|
| 195 |
$$contref =~ s/^IMG (.*?) (.*?) (.*)/ |
| 196 |
command_IMG $1 $2 $3/gm; |
| 197 |
$$contref =~ s/^LIMG (.*?) (.*?) (.*?) (.*)/ |
| 198 |
command_LIMG $1 $2 $3 $4/gm; |
| 199 |
|
| 200 |
$$contref =~ s/^MARK (.*)/ |
| 201 |
command_MARK $1/gm; |
| 202 |
|
| 203 |
if ($$contref =~ /^ALIAS (.*)/m) { |
| 204 |
read_alias_file() unless $hnf::alias{$1}; |
| 205 |
} |
| 206 |
$$contref =~ s/^ALIAS (.*)/ |
| 207 |
command_ALIAS $hnf::alias{$1}/gm; |
| 208 |
|
| 209 |
$$contref .= "<h1>$end</h1>"; |
| 210 |
$$contref .= $date; |
| 211 |
} |
| 212 |
|
| 213 |
sub get_uri ($$) { |
| 214 |
my ($cfile, $fields) = @_; |
| 215 |
|
| 216 |
my ($uri); |
| 217 |
my (%param); |
| 218 |
if ($cfile =~ /^(.*)\/d(\d\d\d\d*)([0-1]\d)([0-3])(\d)\.hnf$/) { |
| 219 |
$param{'year'} = $2; |
| 220 |
$param{'month'} = $3; |
| 221 |
$param{'day'} = $4 . $5; |
| 222 |
$param{'hiday'} = $4; |
| 223 |
if ($param{'day'} < 11) { |
| 224 |
$param{'abc'} = "a"; |
| 225 |
} |
| 226 |
elsif ($param{'day'} < 21) { |
| 227 |
$param{'abc'} = "b"; |
| 228 |
} |
| 229 |
else { |
| 230 |
$param{'abc'} = "c"; |
| 231 |
} |
| 232 |
if ($hnf::link_templ) { |
| 233 |
$uri = $hnf::link_templ; |
| 234 |
} |
| 235 |
elsif ($hnf::hns_version >= 2) { |
| 236 |
$uri = '?%year%month%abc#%year%month%day0'; # for hns-2.00 or later |
| 237 |
} |
| 238 |
else { |
| 239 |
$uri = '?%year%month%hiday#%year%month%day0'; # for hns-1.x |
| 240 |
} |
| 241 |
$uri =~ s/%%/\34/g; |
| 242 |
$uri =~ s/%{?([a-z]+)}?/$param{$1}/g; |
| 243 |
$uri =~ s/\34/%/g; |
| 244 |
$uri = $hnf::diary_uri . $uri; |
| 245 |
$uri =~ s/%7E/~/i; |
| 246 |
} |
| 247 |
$fields->{'uri'} = $uri; |
| 248 |
$fields->{'author'} = $hnf::author; |
| 249 |
} |
| 250 |
|
| 251 |
sub make_summary ($$$$$) { |
| 252 |
my ($contref, $headings, $cfile, $mark, $end) = @_; |
| 253 |
|
| 254 |
# pick up $conf::MAX_FIELD_LENGTH bytes string |
| 255 |
my $tmp = ""; |
| 256 |
if ($$headings ne "") { |
| 257 |
$$headings =~ s/^\s+//; |
| 258 |
$$headings =~ s/\s+/ /g; |
| 259 |
$tmp = $$headings; |
| 260 |
$tmp = "" if $tmp eq "$end "; # for no OK hnf |
| 261 |
} else { |
| 262 |
$tmp = ""; |
| 263 |
} |
| 264 |
|
| 265 |
my $offset = 0; |
| 266 |
my $tmplen = 0; |
| 267 |
my $tmp2 = $$contref; |
| 268 |
|
| 269 |
# hiding GRP section |
| 270 |
if ($hnf::grp_hide) { |
| 271 |
while ($tmp2 =~ /\ncommand_GRP /) { |
| 272 |
$tmp2 =~ s/\ncommand_GRP .*?\ncommand_/\ncommand_/gs; |
| 273 |
} |
| 274 |
} |
| 275 |
|
| 276 |
$tmp2 =~ s/\ncommand_OK\n.*//s; # remove below of command_OK |
| 277 |
$tmp2 =~ s/\ncommand_NG\n.*//s; # remove below of command_NG |
| 278 |
$tmp2 =~ s/command_CAT CAT .*//gm; |
| 279 |
$tmp2 =~ s/command_[A-Z]+//g; |
| 280 |
$tmp2 =~ s/^! .*$//gm; |
| 281 |
$tmp2 =~ s/^!# .*$//gm; |
| 282 |
|
| 283 |
while (($tmplen = $conf::MAX_FIELD_LENGTH + 1 - length($tmp)) > 0 |
| 284 |
&& $offset < length($tmp2)) |
| 285 |
{ |
| 286 |
$tmp .= substr $tmp2, $offset, $tmplen; |
| 287 |
$offset += $tmplen; |
| 288 |
$tmp =~ s/(([\xa1-\xfe]).)/$2 eq "\xa8" ? '': $1/ge; |
| 289 |
$tmp =~ s/([-=*\#])\1{2,}/$1$1/g; |
| 290 |
} |
| 291 |
|
| 292 |
my $summary = substr $tmp, 0, $conf::MAX_FIELD_LENGTH; |
| 293 |
my $kanji = $summary =~ tr/\xa1-\xfe/\xa1-\xfe/; |
| 294 |
$summary .= substr($tmp, $conf::MAX_FIELD_LENGTH, 1) if $kanji %2; |
| 295 |
$summary =~ s/^\s+//; |
| 296 |
$summary =~ s/\s+/ /g; # normalize white spaces |
| 297 |
|
| 298 |
return $summary; |
| 299 |
} |
| 300 |
|
| 301 |
sub read_alias_file () { |
| 302 |
if (-f $hnf::alias_file) { |
| 303 |
my $def = util::readfile($hnf::alias_file); |
| 304 |
my @aliases = split("\n", $def); |
| 305 |
foreach (@aliases) { |
| 306 |
if ($_ =~ /(\S+) (.*)/) { |
| 307 |
$hnf::alias{$1} = $2; |
| 308 |
util::vprint("alias: $1 $2\n"); |
| 309 |
} |
| 310 |
} |
| 311 |
} |
| 312 |
} |
| 313 |
|
| 314 |
1; |
Parent Directory
| 
Revision Log