hnf.pl

namazu. 虽然是日语的,也适用于文件中单词索引后全文检索.

#
# -*- Perl -*-
# $Id: hnf.pl,v 1.9.4.1 2001/11/29 09:31:43 kenji Exp $
#
# hnf filter for Namazu 2.0
# version 0.9.15
# 2001/9/15  Kenji Suzuki <[e-mail]>
#
# Copyright (C) 1999-2001  Kenji Suzuki, HyperNikkiSystem Project
# All rights reserved.
#
#     This is free software with ABSOLUTELY NO WARRANTY.
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either versions 2, or (at your option)
#  any later version.
# 
#  This program is distributed in the hope that it will be useful
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
#  02111-1307, USA
#
#  This file must be encoded in EUC-JP encoding
#

package hnf;
use strict;
require 'util.pl';
require 'gfilter.pl';
require 'html.pl';


sub mediatype() {
    return ('text/hnf');
}

sub status() {
    return 'yes';
}

sub recursive() {
    return 0;
}

sub pre_codeconv() {
    return 1;
}

sub post_codeconv () {
    return 0;
}

sub add_magic ($) {
    return;
}

sub filter ($$$$$) {
    my ($orig_cfile, $contref, $weighted_str, $headings, $fields)
      = @_;
    my $cfile = defined $orig_cfile ? $$orig_cfile : '';

    util::vprint("Processing hnf file ...\n");

    my $mark = "# ";
    my $end  = "--";
    $mark = "ⅲ" if util::islang("ja");
    $end  = "ⅶ" if util::islang("ja");

    get_uri($cfile, $fields);
    hnf_filter($contref, $weighted_str, $fields, $headings, $cfile, 
	$mark, $end);
    html::html_filter($contref, $weighted_str, $fields, $headings);
    $fields->{'summary'} = 
	make_summary($contref, $headings, $cfile, $mark, $end);

    gfilter::line_adjust_filter($contref);
    gfilter::line_adjust_filter($weighted_str);
    gfilter::white_space_adjust_filter($contref);
    gfilter::show_filter_debug_info($contref, $weighted_str,
			   $fields, $headings);
    return undef;
}

sub hnf_filter ($$$$$$$) {
    my ($contref, $weighted_str, $fields, $headings, $cfile, $mark, $end) = @_;

    $$contref =~ s/</&lt;/g;
    $$contref =~ s/>/&gt;/g;

    # has OK?
    if ($$contref =~ /^OK$/m) {
        # has correct User Variable?
        my @tmp = split ("OK\n", $$contref);
        my $header = $tmp[0];

        # illeagel hnf header means having no OK
        if ($header =~ /\nCAT |\nNEW\s|\nLNEW |\nRLNEW /) {
            $$contref = "\ncommand_NG\n";	# NG is a pseudo-command
        }
        else {
          $tmp[0] = "";
          $$contref = join("OK\n", @tmp);
          $$contref =~ s/OK\n//;
          $$contref .= "\ncommand_OK\n" . $header;
        }
    }
    # has no OK
    else {
        $$contref = "\ncommand_NG\n";	# NG is a pseudo-command
    }

    # Title & Date string (YYYYMMDD)
    my $title = $cfile;
    $title =~ s/(.*)\/d(\d{8,})\.hnf/$2/;
    my $date = $title;
    $title =~ s/(\d{4,})(\d\d)(\d\d)/$1\/$2\/$3/;
    $$contref = "<title>$title</title>\n" . $$contref;

    # ~
    $$contref =~ s/~\n/\n/g;

    # command
    $$contref =~ s/^GRP (.*)/command_GRP $1/gm;
    $$contref =~ s/^CAT (.*)/command_CAT CAT $1/gm;
    $$contref =~ s/^NEW\s(.*)/command_NEW <h1>$mark$1<\/h1>/gm;
    $$contref =~ 
	s/^LNEW (.*?) (.*)/command_LNEW <h1>$mark<a href=\"$1\">$2<\/a><\/h1>/gm;
    $$contref =~ 
	s/^RLNEW (.*?) (.*?) (.*)/command_RLNEW <h1>$mark<a href=\"$1 $2\">$3<\/a><\/h1>/gm;
    $$contref =~ s/command_GRP (.*)\n/command_GRP $1 /gm;
    $$contref =~ s/command_CAT (.*)\n/command_CAT $1 /gm;

    # hiding GRP section 
    $$contref =~ s/^command_GRP (.*)<h1>(.*)<\/h1>/command_GRP $1 $2/gm
	if $hnf::grp_hide;

    $$contref =~ s/^SUB\s(.*)/
	command_SUB <strong>$1<\/strong>/gm;
    $$contref =~ s/^LSUB (.*?) (.*)/
	command_LSUB <strong><a href=\"$1\">$2<\/a><\/strong>/gm;
    $$contref =~ s/^RLSUB (.*?) (.*?) (.*)/
        command_RLSUB <strong><a href=\"$1 $2\">$3<\/a><\/strong>/gm;
 
    $$contref =~ s/^LINK (.*?) (.*)/
	command_LINK <a href=\"$1\">$2<\/a>/gm;
    $$contref =~ s/^URL (.*?) (.*)/
	command_URL <a href=\"$1\">$2<\/a>/gm;
    $$contref =~ s/^RLINK (.*?) (.*?) (.*)/
	command_RLINK <a href=\"$1 $2\">$3<\/a>/gm;

    $$contref =~ s/^FONT (.*?) (.*?) (.*)/
	command_FONT $1 $2 $3/gm;
    $$contref =~ s/^SPAN (.*?) (.*)/
	command_SPAN $1 $2/gm;
    $$contref =~ s/^DIV\s(.*)/
	command_DIV $1/gm;

    $$contref =~ s/^PRE\s*$/
	command_PRE/gm;
    $$contref =~ s/^P\s*$/
	command_P/gm;
    $$contref =~ s/^CITE\s(.*)/
	command_CITE $1/gm;
    $$contref =~ s/^RT\s*$/
	command_RT/gm;

    $$contref =~ s/\nFN\n/
	command_FN\n/g;

    $$contref =~ s/^UL$/
	command_UL/gm;
    $$contref =~ s/^OL$/
	command_OL/gm;
    $$contref =~ s/^DL$/
	command_DL/gm;

    $$contref =~ s/^\/([A-Z]+)$//gm;

    $$contref =~ s/^LI\s(.*)$/$1/gm;
    $$contref =~ s/^DT\s(.*)$/$1/gm;
    $$contref =~ s/^DD\s(.*)$/$1/gm;

    $$contref =~ s/^STRIKE (.*)/
	command_STRIKE <strike>$1<\/strike>/gm;
    $$contref =~ s/^LSTRIKE (.*?) (.*)/
        command_LSTRIKE <strike><a href=\"$1\">$2<\/a><\/strike>/gm;

    $$contref =~ s/^STRONG (.*)/
	command_STRONG <strong>$1<\/strong>/gm;

    $$contref =~ s/^IMG (.*?) (.*?) (.*)/
	command_IMG $1 $2 $3/gm;
    $$contref =~ s/^LIMG (.*?) (.*?) (.*?) (.*)/
	command_LIMG $1 $2 $3 $4/gm;

    $$contref =~ s/^MARK (.*)/
	command_MARK $1/gm;

    if ($$contref =~ /^ALIAS (.*)/m) {
        read_alias_file() unless $hnf::alias{$1};
    }
    $$contref =~ s/^ALIAS (.*)/
	command_ALIAS $hnf::alias{$1}/gm;

    $$contref .= "<h1>$end</h1>";
    $$contref .= $date;
}

sub get_uri ($$) {
    my ($cfile, $fields) = @_;

    my ($uri);
    my (%param);
    if ($cfile =~ /^(.*)\/d(\d\d\d\d*)([0-1]\d)([0-3])(\d)\.hnf$/) {
      $param{'year'} = $2;
      $param{'month'} = $3;
      $param{'day'} = $4 . $5;
      $param{'hiday'} = $4;
      if ($param{'day'} < 11) {
        $param{'abc'} = "a";
      }
      elsif ($param{'day'} < 21) {
        $param{'abc'} = "b";
      }
      else {
        $param{'abc'} = "c";
      }
      if ($hnf::link_templ) {
	$uri = $hnf::link_templ;
      }
      elsif ($hnf::hns_version >= 2) {
        $uri = '?%year%month%abc#%year%month%day0'; # for hns-2.00 or later
      }
      else {
        $uri = '?%year%month%hiday#%year%month%day0'; # for hns-1.x
      }
      $uri =~ s/%%/\34/g;
      $uri =~ s/%{?([a-z]+)}?/$param{$1}/g;
      $uri =~ s/\34/%/g;
      $uri = $hnf::diary_uri . $uri;
      $uri =~ s/%7E/~/i;
    }
    $fields->{'uri'} = $uri;
    $fields->{'author'} = $hnf::author;
}

sub make_summary ($$$$$) {
    my ($contref, $headings, $cfile, $mark, $end) = @_;

    # pick up $conf::MAX_FIELD_LENGTH bytes string
    my $tmp = "";
    if ($$headings ne "") {
        $$headings =~ s/^\s+//;
        $$headings =~ s/\s+/ /g;
        $tmp = $$headings;
	$tmp = "" if $tmp eq "$end ";	# for no OK hnf
    } else {
        $tmp = "";
    }

    my $offset = 0;
    my $tmplen = 0;
    my $tmp2 = $$contref;

    # hiding GRP section
    if ($hnf::grp_hide) {
        while ($tmp2 =~ /\ncommand_GRP /) {
            $tmp2 =~ s/\ncommand_GRP .*?\ncommand_/\ncommand_/gs;
        }
    }

    $tmp2 =~ s/\ncommand_OK\n.*//s;	# remove below of command_OK
    $tmp2 =~ s/\ncommand_NG\n.*//s;	# remove below of command_NG
    $tmp2 =~ s/command_CAT CAT .*//gm;
    $tmp2 =~ s/command_[A-Z]+//g;
    $tmp2 =~ s/^! .*$//gm;
    $tmp2 =~ s/^!# .*$//gm;

    while (($tmplen = $conf::MAX_FIELD_LENGTH + 1 - length($tmp)) > 0
           && $offset < length($tmp2))
    {
        $tmp .= substr $tmp2, $offset, $tmplen;
        $offset += $tmplen;
        $tmp =~ s/(([\xa1-\xfe]).)/$2 eq "\xa8" ? '': $1/ge;
        $tmp =~ s/([-=*\#])\1{2,}/$1$1/g;
    }

    my $summary = substr $tmp, 0, $conf::MAX_FIELD_LENGTH;
    my $kanji = $summary =~ tr/\xa1-\xfe/\xa1-\xfe/;
    $summary .= substr($tmp, $conf::MAX_FIELD_LENGTH, 1) if $kanji %2;
    $summary =~ s/^\s+//;
    $summary =~ s/\s+/ /g;   # normalize white spaces

    return $summary;
}

sub read_alias_file () {
    if (-f $hnf::alias_file) {
        my $def = util::readfile($hnf::alias_file);
        my @aliases = split("\n", $def);
        foreach (@aliases) {
            if ($_ =~ /(\S+) (.*)/) {
                $hnf::alias{$1} = $2;
                util::vprint("alias: $1 $2\n");
            }
        }
    }
}

1;