#!/usr/local/bin/perl
# $Header: /e/u/j/local-repository/htdocs/www/software/.auto-index/20011103,v 1.1.1.1 2008/03/12 10:52:26 makoto Exp $
# use strict; # 簡単に出来ない理由は sub init で宣言している変数が多いから
## -------------------------------------
##      list of current subroutines
## -------------------------------------
## sub copy_html {
## sub show_doc {
## sub find_file {  # 数字を指定しなくても、それ以外の情報から探す
## sub get_mtime {
## sub cache_is_old {
## sub show_menu {
## sub leading_space {
## sub get_cache {
## sub header {
## sub init {
## -------------------------------------
## $main::DEBUG = 1;
init();  #  see bottom
# -------------------------------------------------
#     C H D I R  and  G E T  F I L E   L I S T
# -------------------------------------------------

$LN = $ACCEPT_LANG[0]; # pickup the first candidate only ( with comma(.), .ja etc)
push(@errors, "**(12) \$LN($LN)<br>\n") if  $main::DEBUG;
push(@errors, "**(26) ACCEPT_LANG: ". join(';',@ACCEPT_LANG)."<br>\n") if  $main::DEBUG;
chdir $DOC_DIR;

opendir(DIR,'.') || push(@errors," ** problem opening dir". `pwd` . "<br>\n");
@list = grep /^[1-8].*$SUFFIX\...$/, readdir(DIR);
closedir(DIR);

push(@errors, '* getting file list'."SUFFIX($SUFFIX)LN($LN)<br>\n") if $main::DEBUG;
push(@errors, '@list: '. join(' ',@list)."<br>\n") if $main::DEBUG;

$mtime      = get_mtime(@list);
# -------------------------------------------------
#     U P D A T E   $mtime for $0 $HEAD $FOOT
#                    (mtime の値に正確を期す)
# -------------------------------------------------
foreach ( $0, $HEAD, $FOOT, '.' ) {
    my $mmm = (stat($_))[9];
    if ( $mmm > $mtime ) { $mtime = $mmm;}}
$mtime_str  = scalar(localtime($mtime));
# -------------------------------------------------
#     T A K E   C A R E   C A C H E 
#                   ( 必要に応じて Cache を作り直す)
# -------------------------------------------------
if  ( -f '00.head'.$SUFFIX.$LN ) {
    $HEAD                 = '00.head'.$SUFFIX.$LN;}
else {
    $HEAD                 = '00.head'.$SUFFIX;}
if ( -f '00.foot'.$SUFFIX.$LN ) {
    $FOOT                 = '00.foot'.$SUFFIX.$LN ;}
else {
    $FOOT                 = '00.foot'.$SUFFIX ;  }

$CACHE                = '/tmp/.' . $my_name. '.yy';
push(@errors, "LN($LN) suffix($SUFFIX) files:\n ".join(' ', @list)."<br>\n") if $main::DEBUG;

my @cache;
# get cache info onto @cache AND $CACHE  (sync @cache and $CACHE
if ( cache_is_old($mtime,$CACHE,@list)) {
    @cache = get_cache($CACHE,@list);
    open(CACHE,">$CACHE") || push(@errors, " ** problem open to write CACHE($CACHE): $!<br>\n");
    print CACHE   @cache;
    close(CACHE);}
else {
    open(CACHE,$CACHE) || push(@errors, " ** problem open to reading CACHE($CACHE): $!<br>\n");
    @cache = <CACHE>;
    close(CACHE);}

# -------------------------------------------------
#               ここから印刷開始
# -------------------------------------------------
open(STDOUT,"|$NKF -j") || push(@errors, " problem opening STDOUT: ". $!."<br>\n");
print 'Last-modified: '. $mtime_str . "\n";
print "Content-Type: text/html; charset=iso-2022-jp\n\n";

$KEYWORD = '00.keyword';
if ( -f $KEYWORD ) {
    open(KEYWORD);
    $keywords = <KEYWORD>;  # one line only
    chomp($keywords);  # assuming one line only
    close(KEYWORD);}
my $PATH_INFO_short =  $PATH_INFO;
$PATH_INFO_short =~ s/\.html$//;
header($base_name . $PATH_INFO_short, $keywords);
push(@errors, "**(61) PATH_INFO($PATH_INFO) \$LN($LN)<br>\n")  if  $main::DEBUG;
####if ( $PATH_INFO ne '' ) {
# -------------------------------------------------
#  PATH_INFO に指定がある時にはその文書を表示
# -------------------------------------------------
    show_doc($PATH_INFO,@ACCEPT_LANG);
#### }
#### else {
# -------------------------------------------------
#  PATH_INFO に指定のない時には既定値を表示
# -------------------------------------------------
#-#   print "<p align=\"right\"><font size=-1>Last update: ". $mtime_str. "</font></p>\n";
#-#   copy_html($HEAD);
#-#   show_menu($PATH_INFO,$base_name.'/');  # to add base_name on link
#-#   copy_html($FOOT);}
####    show_doc('purpose'.$SUFFIX,$LN);} # fixed initial file, in this case
print @errors;

exit;
# --------------------------------------------------------------
#                 S U B  R O U T I N E S
# --------------------------------------------------------------
  
sub copy_html {
    local($FILE) = shift;
    if ( -f $FILE ) {
	open(FILE,$FILE) || push (@errors, 
	 " ** copy_html:  problem opening FILE($FILE) to copy: $!<br>\n");
	print <FILE>;
	close(FILE);}}

sub show_doc {
    my ($file) = shift;  # based on PATH_INFO
    my (@Accept_lang) = @_;

#   push(@errors, "**(124) Accept_lang: ". join(';',@Accept_lang)."<br>\n");
    my ($entry_name) = 'purpose'; # default;
    my ($base) = '';
    if    ( $file eq '/' ) {
	$file = $entry_name;
    }
    elsif ( $file eq '' ) {
	$file = $entry_name;
	$base = $SCRIPT_NAME .'/';  # to adjust menu URL
    }
    else  { $file =~ s|^/||;
	}	
    print "<table cellspacing=0 cellpadding=5 border=0>\n";
    if ($conf::OHP_mode) {
	print "<tr><td bgcolor=\"$MENU_BG\" valign=\"bottom\" width=$left_width height=$body_height>\n";
    }
    else {
	    print "<tr><td bgcolor=\"$MENU_BG\" valign=\"top\" width=$left_width>\n";  # be carefull navigator support
	}
    # ------------
    #   M E N U 
    # ------------
    push(@errors, "** show_doc (98) file($file) \$LN($LN)<br>\n") if  $main::DEBUG;
    my @lang_selection_of_this = show_menu($file,$base,@Accept_lang);
    if ($conf::OHP_mode) {
	print "</td>\n<td width=$right_width height=$body_height valign=\"top\" >\n";
    } else {
	print "</td>\n<td width=$right_width valign=\"top\">\n";
    }
    # ------------
    #   B O D Y
    # ------------
    # check if the other lang is available. (info from menu processing)
#     print 'lang: ', join(',',@lang),'file: ', $file,'@Accept_lang: ', join(','),@Accept_lang,"<br>\n";
    my $other_file = '()'; my $other_list = '';
    if ( $#lang_selection_of_this >0 )  {
	foreach my $l (@lang_selection_of_this) {
	    $other_list .= "<a href=\"$file.$l\">$l</a> | ";}
	print 'Other lanugage: ', $other_list,"<br>\n";}
    my ($next,$next_link);
    if (($FILE,$next) = find_file_x($file,@Accept_lang)) {  # accept_lang ?
	open(FILE) || push(@errors, 
    " ** show_doc: problem opening file($FILE): ".$!." DOC_DIR($DOC_DIR)<br>\n");
	print <FILE>;
	close(FILE);}
    else {
	print 
	    "(93)** show_doc: DOC_DIR($DOC_DIR),file($file) not found<br>\n";}
    if ($conf::OHP_mode) {
	print "</td>\n";
	print "</td><td width=$left_width></td></tr>\n";
# --------------------
#  Footer
# --------------------
	print "<tr><td colspan=2>\n";
    }
    else {
	print 
	"<p align=\"right\"><span class=\"small\">Last update: ". $mtime_str. "</span></p>\n";
    }
    copy_html($FOOT);
    print "</td></tr></table>\n";

	$next_link = $next;
	$next_link =~ s|^\d+\.||; # remove digits
	$next_link =~ s|\...$||; # remove lang part
        $next_link =~ s|\s+||;
    if ( $next_link ) {
	if ( $URI =~ m|$base_name/$| ) { # requested with slash 
	    print "<a href=\"$next_link\">next($next_link)</a>\n";}

	elsif ( $URI =~ m|$my_name$| ) { # OHP.cgi  etc only
	    print "<a href=\"$my_name/$next_link\">next($next_link)\n";}
	elsif ( $URI =~ m|$my_name| ) { # OHP.cgi/purpose  etc only
	    print "<a href=\"$next_link\">next($next_link)</a>\n";}
	else {
	    print "<a href=\"$base_name/$next_link\">next($next_link)</a>\n";}
	print "<p align=\"right\"><span class=\"small\">$rcsid</span></p>\n";  }
}
sub find_file_x {  # 数字を指定しなくても、それ以外の情報から探す
    my ($PATH) = shift;
    my (@Accept_lang) = @_; 
#    push(@errors, "**(212) Accept_lang: ". join(';',@Accept_lang)."<br>\n");
    my (@cache_copy) = @cache; # make copy, global variable
    my $this  = '';
    my $next  = undef();
    my $found = 0;

    while( $_ = shift(@cache_copy)) {
	if ( $found ) { # if found, preserve next page and exit
	    $next = filename($_,@Accept_lang); if ($next) {last}}
#	elsif (/^File;;.*\.$PATH\./) {
	elsif (/\.$PATH/) {   # - in filename problem 20011031
	    $this = filename($_,@Accept_lang); $found++}}
    push(@errors,"(224) find_file_x: this($this) next($next)PATH($PATH) ($_)<br>") if  $main::DEBUG;
    ($this,$next);
}
sub filename  {
    my $line = shift ;
    my @Accept_lang = @_;
#    push(@errors,"filename($line)<br>\n");
    my @languages = split($LL,$line);  # $LL: line separator
    my $File =  shift @languages;      # The first argument is
       $File =~ s/^File;;(.*)/$1/;     # This type of line, i.e, name

    my ($num,$file,$lang) =  ();
    foreach  my $al (@Accept_lang) { # use the first one
	$al =~ s|^\.||;
	my @found = grep /LANG\($al\)/,@languages ;
	push(@errors,"(212) filename: al($al) found(",join('+',@found),"<br>\n") if  $main::DEBUG;

	push(@errors,"(214) filename: al ($al) this($this) num($num) file($file) lang($lang) <br>\n") if  $main::DEBUG;
	push(@errors,"(215) filename: File($File) filename($line)<br>\n") if  $main::DEBUG;
	$this = $File.'.'.$al;
	my $pwd =`pwd`; chomp ($pwd);
	push(@errors,"(217) this($this) pwd($pwd) <br>\n") if  $main::DEBUG;
	if ( -f $this) { last }   }
    if ( ! -f $this ) { $this =  $File.'.en'};
    if ( ! -f $this ) { $this =  $File.'.ja'};
    $this;
}
sub get_mtime {
    my @list = @_;
    my $file;
    my $time = 0 ;
    foreach $file (@list) {
	my $mtime = (stat($file))[9];
	if ( $mtime > $time ) { $time = $mtime ;}} ## finding max $mtime
    return $time ;}

sub cache_is_old {
    my $mtime = shift;
    my $CACHE = shift;
    if ( (stat($CACHE))[9] < $mtime ) {
	return 1; }
    return 0; }

sub show_menu {
    # 専ら CACHE から読む
    my($this_file) = shift;  # 
    my($base)      = shift;  # higher level of URL
    my(@Accept_lang) = @_ ;  # in case of explicit URL is being requested.
#   my($LN)        = shift;  # in case of explicit URL is being requested.
    push(@errors, " ** show_menu: (161). \$LN($LN)<br>\n") if  $main::DEBUG;
    my($file,$line);
    my($T_BG); # target background color
    my($BG) = $DARK;
    my(@heads);
    my @langs;   # #filename ; by lang; ....
    print " <table cellspacing=0 cellpadding=0 border=0>\n";
#    $BG = $DARK;
    # $lines[0] = File;;filename $LL
    # $lines[1] = LANG(..)$RRdigit;; header$RR digit;; header .... $LL
    # $lines[2] = LANG(..)$RRdigit;; header$RR digit;; header .... $LL
    # ....for example ...
    #  LANG(en) $RR 1 ;; NetBSD/iBook $RR 4;; More disk $LL
    my(@tmp_cache) = @cache; # work on copy of global @array, not on original
    my $yes_this_file = 0; my @return = ();  # just to get multiple lang info for this page
    while ($_ = shift @tmp_cache) {  # line per file;
	chomp;
        # ------------
        # split by $LL  (L = Lang, i.e. for each LANG
	@langs = split(/$LL/,$_); # $RR は 一行の中の record 区切子 
	# -------------------------------
	$file = shift @langs;     	# the first record has filename;
	$file =~ s/File;;(\d+)\.(.*)//;      # Magic 文字列を消して
	$num  = $1;	$file = $2;
	push(@errors, " ** (187) file($file) this_file($this_file)<br>\n") if $main::DEBUG;
	# --------------------------------
	if ( $file eq $this_file) { # 背景を変化させるので、自分かどうか見る
	            $yes_this_file++;    $T_BG = $THIS_BG;}
	else {	    $yes_this_file = 0;  $T_BG = $BG;}
	if ($conf::OHP_mode) {
	    print
		" <tr><td bgcolor=\"$T_BG\" width=$left_width> <a href=\"";
	}
	else {
	    print   " <tr><td bgcolor=\"$T_BG\"><a href=\"";
	}
	print $base. $file, "\" $STYLE>",$menu_font_b ;
	foreach $lang ( @langs ) {  # of this (cache) line
	    # ------------
	    # split by $RR (R = Record)
	    my (@heads) = split(/$RR/,$lang) ; # split further to each header
	    my $LANG = shift @heads; # first line (of splitted by $RR) has LANG info
	    push(@errors, "** (212) \$LANG($LANG)<br>\n")if  $main::DEBUG;
	    $LANG =~ /LANG\((..)\)/;  # pick up en or ja etc for this particular line
	    $LANG = $1;
	    push(@errors, "** (215) \$LANG($LANG)<br>\n") if  $main::DEBUG;
	    #
            # read @heads one by one, accumulate on $MULE{$LANG}
	    foreach $head (@heads) {   # ここでどの LANG を表示すればいいか分っているので、
		                        # 本来ならそちらだけを表示すればいい ?
		if ( $MULE{$LANG} ) {     # continuing
		    $MULE{$LANG} .= $RR. $head  }
		else {                    # the very first entry, $RR is not required
		    $MULE{$LANG} = $head }}} # accumulate menu info in this hash

# ここで どの lang を(主として)表示すればいいか判断してしまう
	push(@errors, " (310)",join(':',@Accept_lang,"<br>\n")) if  $main::DEBUG;	
	foreach my $LN ( @Accept_lang) {
	    $LN =~ s/^\.//; # strip .en to en etc
	    push(@errors, " (313): LN($LN) MULE($MULE{$LN})<br>\n") if  $main::DEBUG;

	    if ( $LN && $MULE{$LN} ) { $head = $MULE{$LN}  }  # preferenced passed to this routine,
#	    else                     { $head = $MULE{'en'} }  # else default, should take $Default_LN XXX
	    # above logic won't show Japanes only menu
	}
        #  -----------------------------------------------------
        #  prepare  HTML for headers (actually printing
	#  show header for each section
	my $count = 0;
	foreach my $h (  split($RR,$head) ) {
	    ($level,$head) = split(/$DD/,$h);
	    if ( $count++ ) {print "<br>";} # need separator between headers
	    leading_space($level);
	    push(@errors, " (230): LN($LN) L($level) head($head)<br>\n") if  $main::DEBUG;
	    if ( $level == 2 || $level == 1 ) {
		print "<span class=\"h2\">$head</span>" ;}
	    else {
		print "$head" ;}
	    print "\n"; } # foreach my $h
	
	print 	"$menu_font_e</a></td></tr>\n";
	if ($BG eq $DARK) { $BG = $LIGHT }
	else              { $BG = $DARK } 
	# 
	if ( $yes_this_file ) {
	    push(@errors,"(336) while: $_<br>\n") if $mail::DEBUG;
	    @return = keys %MULE;
	    push(@errors, '(339) while: this_file('.$this_file.') debug: '.join(':', @return)."<br>\n") if $mail::DEBUG;
	    $yes_this_file = 0;
	     }
	%MULE=();    } # end while ($_ = shift
    print " </table>"; # \n を付けると右側が空く ? no
    push(@errors, '(343) show_menu: '.join(':', @return)."<br>\n") if $mail::DEBUG;
    @return; } # to notify the language selection on this page


sub leading_space {
    my($level) = shift;
    $level -= 2;  # 2 is baseline
    while ( $level-- > 0 ) {
	print '&nbsp;&nbsp;&nbsp;';}}

sub get_cache {
    # generate CACHE -- format is: one line per file,
    # $RR := record delimiter
    # File;;filename$RR(level);;(title)$RR(level);;(title)\n"
    # ---is to be read as ----------------------
    #        (old)                 (new)
    # File;;filename         File;;filename(lang)
    # (level);;(title)      (level);;(title)
    # (level);;(title)      (level);;(title)
    # --------------------------------------------------------
    #  from 2001/02/03 on, the new format is:
    # File;;filename$LL LANG(lang)$RR(level);;(title)$RR(level);;(title)\n"

    # 番号(数字の部分)が同じだったら縮退させる
    my $CACHE = shift;
    my @list = @_;

    my $file;
    my @headings;
    my $line;
    foreach $FILE (sort @list) {
	push(@errors," (196) ** updating cache: $FILE<br>\n") if $main::DEBUG;
	my $pwd = `pwd`; chomp($pwd);
	my $nkf_command = "$NKF -e $FILE";
	open(FILE,"$nkf_command |") || push(@headings, " ** problem doing $nkf_command: $!<br>\n");
	my $count = 0;
	$title = '';
	$FILE =~ s/$SUFFIX\.(..)$//;
        my $lang = $1;		    
	$FILE =~ /(\d+)\.(\w+)/ ;
	my $num  = $1;
	my $name = $2;
	$line = 'LANG('.$lang.')'.$RR;
		while(<FILE>) {
	    chomp;
	    if ( m|<h(.*)>(.*)</h\1>|i ) {
		$level  = $1;
		$title  = $2;
		$count++; 
		$line .= "$level$DD$title$RR";}}
	close(FILE);
	$HEADING{$num}    .= $LL.$line ;
	$FILENAME{$num}    = 'File'.$DD.$num.'.'. $name . $SUFFIX ;
    }
    my @lines =();
    foreach (sort keys %HEADING ) {
	push(@lines, $FILENAME{$_}.$HEADING{$_},"\n")}
    @lines;
}
sub header {
    my $title = shift;
    my $keywords   = shift;
    if ( $keywords ne '' ) { $KEY = 
"<meta 
   name=\"Keywords\"
content=\"$keywords\"
>
";}
    print <<HEAD;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML  4.01//EN">
<HTML lang="ja">
<HEAD>
$CSS_LINK
<TITLE>$title</TITLE>
$KEY
</HEAD>
<BODY BGCOLOR="$MAIN_BG">
HEAD
}
# -------------------------------------------------------------------------
#                              I N I T 
# -------------------------------------------------------------------------
sub init {
  $rcsid = q$Id: 20011103,v 1.1.1.1 2008/03/12 10:52:26 makoto Exp $;
  $rcsid =~ s/Id: .*,v //;
  $rcsid =~ s| \d+:\d+:\d+ .*||;

$my_name = $0; $my_name =~ s#(.*)/##;
$my_path = $0; $my_path =~ s|/[^/]+$||;

$base_name = $my_name;
$base_name =~ s/\.cgi$//;

#---------------------
push(@INC,$my_path);
require 'cgi-lib.pl';
  $SUFFIX = '.html';

$conf::OHP_mode = 1;
ReadParse();
$URI                  = $ENV{'REQUEST_URI'};
$HTTP_HOST            = $ENV{'HTTP_HOST'};
$SCRIPT_NAME          = $ENV{'SCRIPT_NAME'};
$SCRIPT_NAME          =~ s|.*/([^/]+)$|$1|;  # /software/auto-index2 -> auto-index2

$DOC_DIR              = $my_path.'/.'.$base_name;
  if ( ! -d $DOC_DIR ) {  # if exist, take it, else try find with no digit
      $DOC_DIR              =~ s/\d$//;   }
      # remove rightmost digit, namazu-doc2.cgi -> namazu-doc
      # to run test version with the old document directory

$HTTP_ACCEPT_LANGUAGE = $ENV{'HTTP_ACCEPT_LANGUAGE'};

  if (defined($HTTP_ACCEPT_LANGUAGE)) {
      # if this env variable defined, try with -en -ja etc first,
#      push(@errors, \[1," HTTP_ACCEPT_LANGUAGE($HTTP_ACCEPT_LANGUAGE)"]) if $main::DEBUG }
  push(@errors, " HTTP_ACCEPT_LANGUAGE($HTTP_ACCEPT_LANGUAGE)<br>\n") if $main::DEBUG;
  @ACCEPT_LANG = split(',',$HTTP_ACCEPT_LANGUAGE); 
  @ACCEPT_LANG = map { $_ =~ s/ //; $_ = '.'.$_ ; s/\-us//; s|\;q=[\d\.]+||; $_} @ACCEPT_LANG ; # add '.' before name, say ( ja -> .ja, en -> .en)
#  push(@ACCEPT_LANG,''); # add null string for non-lang-suffix, say (*.ja *.en *)
}

$PATH_INFO            = $ENV{'PATH_INFO'};
## $PATH_INFO            =~ s|^/||;   # strip the very first slash(/)
  # strip .en, .ja and keep themselves into @ACCEPT_LANG variable
  if ( $PATH_INFO =~ s|(\.en)$||  ||    
       $PATH_INFO =~ s|(\.ja)$|| 
       ) {
#      my $lang = $1; $lang =~ s/^\.//;
      unshift @ACCEPT_LANG,$1 ; } # put them on top of Language Preference,
  push(@errors,"init: (317)PATH_INFO($PATH_INFO)LN($ACCEPT_LANG[0])<br>\n") if $main::DEBUG;

  $NKF                  = '/usr/local/bin/nkf';
  if ( $PATH_INFO eq '')  { # ends with / or nothing
    push(@errors,'REQUEST_URI('.$ENV{'REQUEST_URI'}."<br>\n") if $main::DEBUG;
    if ( $ENV{'REQUEST_URI'} =~ m|/$| ) {
	# 更に / で終っている時。... そのままで良い
	push(@errors, "** with /<br>\n") if $main::DEBUG; }
    else {
	# / が付いていない時には参照 URL に /iBook2/ を付けておく  20010106
	# href を設定しているのは 2 + 1 (css) か所
	$href_adjust = '/'.$base_name;
	push(@errors, "** without / href_adjust($href_adjust)<br>\n")  if $main::DEBUG; }}
  $CSS                  = '00.css';
  $CSS_REAL             = $DOC_DIR.'/'.$CSS;   # .iBook2/
  push(@errors, "CSS_REAL($CSS_REAL)<br>\n") if  $main::DEBUG;
  if ( -e $CSS_REAL ) {
      # / で終っている時 $href_adjust = 空           css = ../.iBook2/00.css
      # / がない時       $href_adjust = '/iBook2';   css =    .iBook2/00.css
      $css_adjust = '';
      if ( $href_adjust eq '') {
	  $css_adjust = '../' }
      push(@errors, " href_adjust($href_adjust), css_adjust($css_adjust)<br>\n")  if $main::DEBUG;
      push(@errors, "reading ($CSS_REAL)<br>\n") if  $main::DEBUG;
     $CSS_LINK = "<link rel=stylesheet href=\"$css_adjust.$base_name/$CSS\">";}
#      $CSS_LINK = "<link rel=stylesheet href=\".$base_name/$CSS\">";}
   # this depends from where....

$left_width           = '20%';
$right_width          = '80%';

  if ($conf::OHP_mode) {
$left_width           = '80';
$right_width          = '1200';
$body_height          = '550';
}

$menu_font_b          = '<span class=menu>';
$menu_font_e          = '</span>';

$MENU_BG              = '#ffffff';
  if ($conf::OHP_mode) {
      $MENU_BG              = '#ffffff';  }
  else {
      $MENU_BG              = '#c0c0c0';  }
$MAIN_BG              = $MENU_BG ;

$DARK                 = '#b0b0b0';
$LIGHT                = '#d0d0d0';

# this file back ground
$THIS_BG   = '#e0c080';

$DD     = ';;';    #  delimter in the record
$RR     = "\001";  #  delimter for record
$LL     = "\002";  #  delimter for language, File;;filename;;number$LLja;;$LLen;;

$STYLE  = '';
$STYLE  = "style=\"text-decoration:none\"";
}
__END__
# $Log: 20011103,v $
# Revision 1.1.1.1  2008/03/12 10:52:26  makoto
# initial
#
# Revision 1.14  2001/11/03 05:29:52  makoto
# fix next problem
#
# Revision 1.11  2001/10/31 04:46:41  makoto
# OHP_mode
#
# Revision 1.10  2001/10/31 04:40:49  makoto
# .hu had no menu
#
# Revision 1.9  2001/10/31 02:54:57  makoto
# .hu guy had a problem
#
# Revision 1.2  2001/10/31 02:53:27  makoto
# *** empty log message ***
#
# Revision 1.1  2001/10/29 06:16:26  makoto
# Initial revision
#
# Revision 1.8  2001/10/08 07:50:58  makoto
# nbsp and <br> has wrong order
#
# Revision 1.7  2001/10/08 07:49:03  makoto
# *** empty log message ***
#
# Revision 1.6  2001/10/08 05:29:31  makoto
# Accept Lang problem fixed anyway, but next_link has problem still
#
# Revision 1.5  2001/10/08 00:57:30  makoto
# *** empty log message ***
#
# Revision 1.8  2001/10/06 06:00:27  makoto
# Seems greate
#
# Revision 1.7  2001/10/06 05:56:31  makoto
# debugging but seems bi-lingual OK
#
# Revision 1.6  2001/10/06 03:03:32  makoto
# still debugging, get en+ja info from menu so far
#
# Revision 1.5  2001/10/06 02:38:50  makoto
# debugging en page link
#
# Revision 1.4  2001/10/05 13:08:17  makoto
# *** empty log message ***
#
# Revision 1.1  2001/10/04 06:12:56  makoto
# Initial revision
#
# Revision 1.1  2001/10/04 04:28:14  makoto
# Initial revision
#
# Revision 1.3  2001/02/12 07:17:40  makoto
# remove debug messages
#
# Revision 1.2  2001/02/12 07:17:01  makoto
# fix problem 20010210 - when / is missing
#
# Revision 1.1  2001/02/12 06:52:54  makoto
# Initial revision
#
# Revision 1.4  2001/02/10 06:58:01  makoto
# when .fr is added and not found, it will use .*
#
# Revision 1.3  2001/02/10 06:45:02  makoto
# fairy good, but i have problem if '.fr' added.
#
# Revision 1.2  2001/01/06 05:26:24  makoto
# CSS was adjusted before href_adjust initialized
#
# Revision 1.1  2001/01/06 05:20:15  makoto
# Initial revision
#
# Revision 1.1  2000/11/25 07:26:44  makoto
# Initial revision
#
# Revision 1.4  2000/10/08 06:58:12  makoto
# add title
#
# Revision 1.3  2000/10/08 06:53:54  makoto
# fairly good before menu leveling
#
# Revision 1.2  2000/10/08 03:22:55  makoto
# temp
#
# Revision 1.1  2000/10/08 02:20:50  makoto
# Initial revision
                                                                              
###  if (defined($HTTP_ACCEPT_LANGUAGE)) {
###      # if this env variable defined, try with -en -ja etc first,
### #      push(@errors, \[1," HTTP_ACCEPT_LANGUAGE($HTTP_ACCEPT_LANGUAGE)"]) if $main::DEBUG;
###       push(@errors, " HTTP_ACCEPT_LANGUAGE($HTTP_ACCEPT_LANGUAGE)<br>\n") if $main::DEBUG;
###       my @LANG = split(',',$HTTP_ACCEPT_LANGUAGE);
###       foreach $lang (@LANG) {
### 	  my ($cand) = $DOC_DIR.'-'.$lang;
### 	  push(@errors, " looking cand($cand)<br>\n") if $main::DEBUG;
### 	  if ( -d $cand ) {
### 	      push(@errors, " ($cand) found.<br>\n") if $main::DEBUG;
### 	      push(@DOC_DIR,$cand);}}
###       # if directory found, take the first candidate, fix later with XXX
###       if ( $#DOC_DIR > -1 ) {
### 	  push(@errors, 'DOC_DIR: '. join('+',@DOC_DIR)."<br>\n");
### 	  $DOC_DIR = $DOC_DIR[0]; # the first try is use prioritized one.
###       }}
###   push(@errors, " Now: DOC_DIR($DOC_DIR) is fixed.<br>\n") if $main::DEBUG;

2000/11/25 ja,en の人が 明示的に .en と来た時の link が正しくない。
           purpose.pml.en と来る
           その時には menu に全て .en を付けておく必要がある。