";
$rep_end = "<\/td><\/tr><\/table>";
$text =~ s/\<\/th\>\ | \<\/th\>\<\/tr\>/\<\/th\>\<\/tr\>/g; #00/03/03追加
$text =~ s/\<\/td\>\ | \<\/td\>\<\/tr\>/\<\/td\>\<\/tr\>/g; #00/03/03追加
$text =~ s/$GSOURCE_START\ /$rep_start/g; #02/01/23 Maekawa
$text =~ s/$GSOURCE_END\ /$rep_end/g; #02/01/23 Maekawa
$text =~ s/$GSOURCE_START\/$rep_start\ /g; #02/01/23 Maekawa
$text =~ s/$GSOURCE_END\ /$rep_end\ /g; #02/01/23 Maekawa
if ($GFILTERING eq "on")
{
$max = @GFILTER1; $max--;
for ($i = 0; $i <= $max; $i++)
{
$text =~ s/$GFILTER1[$i]/$GFILTER2[$i]/g;
}
}
#else #00/03/03追加 #02/01/23elseブロック削除
$text
}
#################################################
sub replace_stylesheet #** スタイルシート部分置換
#################################################
{
my ($line, $obj, $attrib, $value) = @_;
my (@strs, $str, $newstr, $this);
$line =~ s/\n/___/g;
$line =~ s/\:/ \: /g;
#$line =~ s/[A-Z]/[a-z]/g;
$_ = $line;
if (m/$obj(.+)/i)
{
$str = $1;
@strs = split (/\;/, $str);
$newstr = "";
foreach $this (@strs)
{
#print "$this\n";
$this =~ s/ $attrib(.+)/ $attrib: $value/i;
$newstr .= "$this;";
}
if ($newstr ne ";")
{
chop $newstr;
}
$_ =~ s/$str/$newstr/g;
}
$line = $_;
$line =~ s/___/\n/g;
$line;
}
#################################################
sub get_file_info #** ファイル情報取得 99/10/14追加
#################################################
{
my ($file, $item) = @_;
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks, $return);
($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime,
$mtime, $ctime, $blksize, $blocks) = stat ($file);
if (-e $file)
{
if ($item eq "dev") { $return = $dev; }
if ($item eq "ino") { $return = $ino; }
if ($item eq "mode") { $return = $mode; }
if ($item eq "nlink") { $return = $nlink; }
if ($item eq "uid") { $return = $uid; }
if ($item eq "gid") { $return = $gid; }
if ($item eq "rdev") { $return = $rdev; }
if ($item eq "size") { $return = $size; }
if ($item eq "atime") { $return = $atime; }
if ($item eq "mtime") { $return = $mtime; }
if ($item eq "ctime") { $return = $ctime; }
if ($item eq "blksize") { $return = $blksize; }
if ($item eq "blocks") { $return = $blocks; }
}
else
{
$return = "";
}
$return
}
#################################################
sub conv_size #** バイト数変換 99/10/14追加
#################################################
{
#$kmg : "Bytes", "KB", "MB", "GB", "TB", ""(最適単位)
my ($size, $kmg) = @_;
my ($return, $n1, $n2, $n3);
last if ($size eq "");
if ($kmg eq "Bytes") { $size = $size; }
if ($kmg eq "KB") { $size = $size/(10**3); }
if ($kmg eq "MB") { $size = $size/(10**6); }
if ($kmg eq "GB") { $size = $size/(10**9); }
if ($kmg eq "TB") { $size = $size/(10**12); }
if ($kmg eq "")
{
if ($size < (10**3))
{
$kmg = "Bytes";
}
else
{
if ($size < (10**6))
{
$size = $size/(10**3);
$kmg = "KB";
}
else
{
if ($size < (10**9))
{
$size = $size/(10**6);
$kmg = "MB";
}
else
{
$size = $size/(10**9);
$kmg = "GB";
}
}
}
}
($n1, $n2) = split (/\./,$size);
($n2, $n3) = substr($n2, 0,1);
$n1 = &num_comma ($n1);
if ($kmg ne "Bytes" && $kmg ne "KB")
{
$n1 .= "\." . $n2;
}
if ($kmg eq "Bytes")
{
$kmg = " Bytes";
}
$return = $n1 . $kmg;
$return
}
#################################################
sub imageview_win #** 画像ウィンドウ表示JavaScript返却 #2004/01/27, #2004/04/29 scrolling, resizableに変更
#################################################
{
return "var new1,win1p;\nfunction imageview (img,xv,yv)\n{\n\tif (win1p==\"on\")\n\t{\n\t\tif (new1.closed) {}\n\t\telse {new1.close();}\n\t}\n\twin1p = \"on\";\n\txw=xv+50;\n\tyw=yv+80;\n\tnew1=window.open(\"\", \"imgv\", \"resizable=1,scrollbars=1,width=\"+xw+\",height=\"+yw+\"\");\n\tif(navigator.appVersion.charAt(0)>=3){new1.focus()};\n\tnew1.document.clear();\n\tnew1.document.write(\" Image Viewer\");\n\tnew1.document.write(\" | \");\n\tnew1.document.write(\"\")\n\tnew1.document.write(\"\");\n\tnew1.document.close();\n}\n";
}
#==================================================================
#** Part 3:日付処理サブルーチン
#==================================================================
#################################################
sub getdate #** 現在日付取得 形式:Jan. 19, 1997
#################################################
{
my ($return,%mon_list,$sec,$min,$hour,$mday,$month,$year,$mon);
%mon_list = (1,"Jan.",2,"Feb.",3,"Mar.",4,"Apr.",5,"May",6,"June",
7,"July",8,"Aug.",9,"Sep.",10,"Oct.",11,"Nov.",12,"Dec.");
($sec,$min,$hour,$mday,$month,$year) = localtime(time);
$year = $year + 1900; #00/01/05修正
$month += 1;
$mon = $mon_list {$month};
"$mon $mday, $year";
}
#################################################
sub getdate2 #** 現在日付取得・デリミタ指定可
### デフォルト:970122 getdate2("/")→"97/01/22"
#################################################
{
my ($dlmt) = @_;
my ($sec,$min,$hour,$mday,$month,$year,$mon);
($sec,$min,$hour,$mday,$month,$year) = localtime(time);
$year = $year + 1900; #00/01/05修正
$month += 1;
if ($month < 10)
{
$month = "0" . $month;
}
if ($mday < 10)
{
$mday = "0" . $mday;
}
"$year$dlmt$month$dlmt$mday"
}
#################################################
sub getdatetime #** 現在日付時刻取得 #02/09/01追加 NANDRA
### 形式:2002/07/06 13:30:00
#################################################
{
my ($sec,$min,$hour,$mday,$month,$year,$mon);
($sec,$min,$hour,$mday,$month,$year) = localtime(time);
$year = $year + 1900;
$month += 1;
if ($month < 10)
{
$month = "0" . $month;
}
if ($mday < 10)
{
$mday = "0" . $mday;
}
"$year/$month/$mday $hour:$min:$sec"
}
#################################################
sub conv_date #** 2000年問題対応:西暦4桁変換 #98/02/27追加
### conv_date ("97/01/22")→"1997/01/22"
#################################################
{
my ($date, $form) = @_;
my ($conv_date, $yyyy, $yy, $mm, $dd, $chars);
$date =~ s/\n//g;
$date =~ s/\t//g;
$date =~ s/ //g;
if ($date eq "")
{
$date = "0000/00/00";
}
$date =~ s/0/0/g;
$date =~ s/1/1/g;
$date =~ s/2/2/g;
$date =~ s/3/3/g;
$date =~ s/4/4/g;
$date =~ s/5/5/g;
$date =~ s/6/6/g;
$date =~ s/7/7/g;
$date =~ s/8/8/g;
$date =~ s/9/9/g;
$date =~ s///\//g;
($yy, $mm, $dd) = split (/\//, $date);
$dd = substr ($dd, 0, 2);
if ($dd < 0 || $dd > 31)
{
$dd = "00";
}
if ($mm < 0 || $mm > 12)
{
$mm = "00";
}
$mm = &conv_num ($mm, 2);
$dd = &conv_num ($dd, 2);
if ($yy <= 99 && $yy != 00)
{
if ($yy >= 50)
{
$yyyy = 1900 + $yy;
}
else
{
$yyyy = 2000 + $yy;
}
}
else
{
if ($yy == 00 && $mm >= 01 && $mm <= 12)
{
$yyyy = 2000;
}
else
{ #00/01/05修正
$yyyy = $yy;
}
}
if ($form eq "mmdd")
{
$conv_date = "$mm/$dd";
}
else
{
if ($form eq "yymm")
{
$conv_date = "$yyyy/$mm";
}
else
{
$conv_date = "$yyyy/$mm/$dd";
}
}
if ($conv_date eq "//")
{
$conv_date = "";
}
if ($conv_date eq "0000/00/00")
{
$conv_date = "";
}
$chars = substr ($dd, 0,3); #99/03/19修正
if ($chars eq "NAN")
{
$conv_date = "";
}
$conv_date
}
#################################################
sub gettime #** 現在時刻取得 形式:20:50:30
#################################################
{
my (%mon_list,$sec,$min,$hour,$mday,$month,$year,$mon);
%mon_list = (1,"Jan.",2,"Feb.",3,"Mar.",4,"Apr.",5,"May",6,"June",
7,"July",8,"Aug.",9,"Sep.",10,"Oct.",11,"Nov.",12,"Dec.");
$year += 1900; #99/12/04追加
($sec,$min,$hour,$mday,$month,$year) = localtime(time);
"$hour:$min:$sec"
}
#################################################
sub getolddate #** New表示のための2週前日付取得
#################################################
{
my (@day_list,$sec,$min,$hour,$mday,$month,$year,$mon);
@day_list = (0,31,28,31,30,31,30,31,31,30,31,30,31);
($sec,$min,$hour,$mday,$month,$year) = localtime(time);
$year = $year + 1900; #00/01/05修正
$month += 1;
if ($GNEW_DAYS eq "")
{
$GNEW_DAYS = 14;
} #00/04/24
if ($mday > 14)
{
$mday = $mday - $GNEW_DAYS;
}
elsif ($month == 1)
{
$year -= 1; $month = 12;
$mday = $day_list[$month] - ($GNEW_DAYS - $mday);
}
else
{
$month -= 1;
$mday = $day_list[$month] - ($GNEW_DAYS - $mday);
}
#if ($year < 10) { $year = "0" . $year; }
if ($month < 10)
{
$month = "0" . $month;
}
if ($mday < 10)
{
$mday = "0" . $mday;
}
"$year/$month/$mday"
}
#################################################
sub year_month #** 年月返却 96/08/10 → 1996年8月
# 2001/11(NANDRA) 多言語対応 MM/DD/YYYYやDD/MM/YYYYにも対応
#################################################
{
my ($date, $option) = @_;
my ($year, $month, $day, $zero, $return, $yhead);
$date =~ s/\n//g;
$date =~ s/\t//g;
$date =~ s/ //g;
($year, $month, $day) = split (/\//, $date);
$zero = substr ($month, 0, 1);
if ($zero eq "0")
{
$month = substr ($month, 1, 1);
}
$zero = substr ($day, 0, 1);
if ($zero eq "0")
{
$day = substr ($day, 1, 1);
}
if ($year <= 99 && $year != 0)
{
if ($year >= 50)
{
$year = 1900 + $year;
}
else
{
$year = 2000 + $year;
}
}
if ($year == 00 && $month >= 01 && $month <= 12)
{
$year = 2000;
} #00/01/05修正
if ($year eq "00" || $year eq "0000")
{
$return = "";
return( $return );
}
if ($month eq "0")
{
if ($GLANGUAGE eq "")
{ # 2001/11 NANDRA
$return = "$year年";
}
else
{
$return = ":-Year-P-:$year:-Year-S-:";
}
return( $return );
}
if ($option eq "by-date")
{
if ($GLANGUAGE eq "")
{
if ($day ne "0")
{
$return = "$year年$month月$day日";
}
else
{
$return = "$year年$month月";
}
}
else
{
if ($day ne "0")
{
# 年月日書式編集 2001/11 NANDRA
if ($GDATEFORMAT eq "M/D/Y")
{
$return = ":-Date-P-:$GMONTHNAME[$month]:-Date-1-:" .
"$day:-Date-2-:$year:-Date-S-:";
}
elsif ($GDATEFORMAT eq "D/M/Y")
{
$return = ":-Date-P-:$day:-Date-1-:$GMONTHNAME[$month]" .
":-Date-2-:$year:-Date-S-:";
}
else
{ # Y/M/D
$return = ":-Date-P-:$year:-Date-1-:$GMONTHNAME[$month]" .
":-Date-2-:$day:-Date-S-:";
}
}
else
{
# 年月書式編集 2001/11 NANDRA
if ($GMONTHFORMAT eq "M/Y")
{
$return = ":-Month-P-:$GMONTHNAME[$month]:-Month-1-:" .
"$year:-Month-S-:";
}
else
{ # Y/M
$return = ":-Month-P-:$year:-Month-1-:$GMONTHNAME[$month]" .
":-Month-S-:";
}
}
}
}
else
{
if ($GLANGUAGE eq "")
{ # 2001/11 NANDRA
if ($day ne "0")
{
$return = "$year年$month月";
}
else
{
$return = "$year年";
}
}
else
{
if ($day ne "0")
{
# 年月書式編集 2001/11 NANDRA
if ($GMONTHFORMAT eq "M/Y")
{
$return = ":-Month-P-:$GMONTHNAME[$month]:-Month-1-:" .
"$year:-Month-S-:";
}
else
{ # Y/M
$return = ":-Month-P-:$year:-Month-1-:$GMONTHNAME[$month]" .
":-Month-S-:";
}
}
else
{
$return = ":-Year-P-:$year:-Year-S-:";
}
}
}
$return
}
#################################################
sub get_clip_date #** 映像クリップ撮影日取得 97/06/21追加
#################################################
#(例) print &get_clip_date ("mmdb:kasumigaura-x:ml:920815.ml",
# "920815/c-006.jpg") . "\n";
{
my ($file_in, $file_top) = @_;
my ($char, $flag, $file_mime, $date, $place, $title, $comment,
$return, $dummy, $file_html, $file_html2, $num, $num_c);
$num = 1;
$file_in =~ s/\//$GDELIMITER/g; #00/01/15
open (FCLIP, $file_in) || return ""; #2003/04/17 Maekawa
while ($_ = )
{
($file_mime) = split (/\t/, $_);
if ($file_top eq $file_mime && $file_top ne "")
{
$flag = "yes";
last;
}
if ($file_top eq "" && $file_mime ne "")
{
$flag = "yes";
last;
}
}
if ($flag eq "yes")
{
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment) = split (/\t/, $_);
}
$date
}
#################################################
sub p_time #** 時刻差返却 #99/03/15追加
### p_time ("01:33:55", "01:23:59") → "00:10:04"
#################################################
{
my ($time1, $time2) = @_;
my ($hh1, $hh2, $mm1, $mm2, $ss1, $ss2, $ss3, $hh, $mm, $ss);
($hh1, $mm1, $ss1) = split (/\:/, $time1);
($hh2, $mm2, $ss2) = split (/\:/, $time2);
if ($hh1 > $hh2)
{
$hh2 += 24;
}
$ss1 = $ss1 + $mm1*60 + $hh1*3600;
$ss2 = $ss2 + $mm2*60 + $hh2*3600;
$ss3 = $ss2 - $ss1;
$ss = $ss3 % 60;
$mm = (($ss3 - $ss) % 3600) / 60 ;
$hh = ($ss3 - $ss - $mm*60) / 3600;
if ($ss < 10)
{
$ss = "0" . $ss;
}
if ($mm < 10)
{
$mm = "0" . $mm;
}
"$hh:$mm:$ss"
}
#==================================================================
#** Part 4:マクロタグ処理サブルーチン
#==================================================================
#################################################
sub tag_chk #** マクロタグチェック 97/04/27追加
#################################################
{
my ($tag) = @_;
my ($return, $str);
$return = "no";
$str = substr ($tag, 0, 6);
if ($tag eq "gmapxy") { $return = "yes"; }
if ($tag eq "headline") { $return = "yes"; }
if ($tag eq "email") { $return = "yes"; }
if ($tag eq "subtitle") { $return = "yes"; }
if ($tag eq "tablequote") { $return = "yes"; }
if ($tag eq "quote") { $return = "yes"; }
if ($tag eq "link") { $return = "yes"; }
if ($tag eq "link2") { $return = "yes"; }
if ($tag eq "folder") { $return = "yes"; }
if ($tag eq "imageclip") { $return = "yes"; }
if ($tag eq "title_image") { $return = "yes"; }
if ($str eq "_clip_") { $return = "pass"; } #画像なしクリップの場合
if ($tag eq "compose_start") { $return = "yes"; }
if ($tag eq "compose_end") { $return = "yes"; }
if ($tag eq "xref") { $return = "yes"; } #2001/09/15 Maekawa
if ($tag eq "text") { $return = "yes"; }
if ($tag eq "author") { $return = "yes"; } #02/04/10 Maekawa
if ($tag eq "copyright") { $return = "yes"; } #02/04/10 Maekawa
if ($tag eq "contact") { $return = "yes"; } #02/04/10 Maekawa
if ($tag eq "hr") { $return = "yes"; } # 2004/02/24 insert PopCorn WG
if ($tag eq "set_vod") { $return = "yes"; } # 2004/09/26 insert Maekawa
$return
}
#################################################
sub add_xref #** マクロタグ処理 クロスリファレンスDBソース生成 #2001/09/15追加 Maekawa
#################################################
#$GDB_EXPORT(他サイト)にメタDBソースをエキスポートする
#$GDB_XREF(自サイト)にメタDBソースをリフレクトする
{
my ($index, $this_page_dir, $date, $page, $catg, $region,
$url, $title, $yomi, $comment, $update, $ext) = @_;
my ($today, $txt_ex, $txt_ref, $idx_dir, @list, $this_index,
$url_ex, $url_ref, $idx, $pg);
$txt_ex = $txt_ref = "";
$today = &getdate2("/");
@list = split (/\,/, $index);
foreach $this_index (@list)
{
($idx, $pg) = split (/\=/, $this_index);
if ($pg ne "")
{
$title = $pg;
}
if ($GPATH_EXPORT eq "")
{
$url_ex = "$GURL$this_page_dir/$url.html";
}
else
{
$url_ex = "$GPATH_EXPORT$this_page_dir/$url.html";
}
$txt_ex .= "■$page\n$idx\n$region\t\n" . $url_ex .
"\n$title\n$yomi\n$date\nheadline\t$page($today更新)\n\n";
}
foreach $this_index (@list)
{
($idx, $pg) = split (/\=/, $this_index);
if ($pg ne "")
{
$title = $pg;
}
if ($GPATH_XREF eq "")
{
$url_ref = "$GURL$this_page_dir/$url.html";
}
else
{
$url_ref = "$GPATH_XREF$this_page_dir/$url.html";
}
$txt_ref .= "■$page\n$idx\n$region\t\n" . $url_ref .
"\n$title\n$yomi\n$date\n\n";
}
if ($GDB_EXPORT ne "")
{
open (FDB_EXPORT, ">>$GDB_EXPORT");
print FDB_EXPORT $txt_ex;
close (FDB_EXPORT);
}
if ($GDB_XREF ne "")
{
open (FDB_XREF, ">>$GDB_XREF");
print FDB_XREF $txt_ref;
close (FDB_XREF);
}
}
#################################################
sub edit_link #** マクロタグ処理 リンク設定 97/05/13追加
#################################################
{
my ($file_in, $date, $rgn, $title, $caption, $option) = @_;
my ($return, $dummy, $mime, $file, $char, $protocol, $txt_suspend);
my ($machine, $delimiter, $fpath, $frpath, $opt_path, $tmp_path);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加 (03/03/12)
$site = $GSITE;
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
$return = "";
$mime = &get_mime($file_in);
$char = substr ($file_in, 0, 1);
$date = &conv_date ($date);
if ($option ne "")
{
$option = " " . $option;
}
if ($mime ne "")
{
$protocol = &check_protocol ($file_in);
if ($protocol eq "yes" || $char eq "/")
{
$file = "$file_in";
}
else
{
if ($mime eq "html")
{
$file = "$file_in";
}
else
{
# (2003/02/20)
$file = "$frpath/$mime/$file_in";
}
}
}
else
{
$file = "$file_in";
}
if ($GLINE ne "on")
{
if ($title ne "")
{
$return = "[$date] $title\";
}
else
{
$return = "[$date] $file_in\";
}
if ($caption ne "")
{
$return .= " $caption";
}
$return .= " \n";
}
else
{
if ($title eq "このページの$GTXTE"
|| $title eq "このページの$GTXTD")
{
$return = "\n";
}
else
{ #00/05/03
$return = "\n";
}
if ($file_in eq "head")
{
$txt_suspend = "\@1\@日付\@2\@ | \@1\@ページ・タイトル\@2\@ | \n";
if ($GTEXT_COLOR_HEAD eq "")
{
$txt_suspend =~ s/\@1\@//g;
$txt_suspend =~ s/\@2\@//g;
}
else
{
$txt_suspend =~ s/\@1\@/\/g;
$txt_suspend =~ s/\@2\@/\<\/font\>/g;
}
}
else
{
if ($title ne "")
{
$txt_suspend .= "$date\ | " .
"" .
"$title\ | \n";
}
else
{
$txt_suspend .= "$date\ | " .
"" .
"$file_in\ | \n";
}
}
$return .= $txt_suspend;
$return .= " \n";
}
$return =~ s/\[\]//g;
$return
}
#################################################
sub edit_link2 #** マクロタグ処理2 リンク設定→別ウィンドウ表示 98/07/17追加, 98/12/20修正
#################################################
{
my ($file_in, $date, $rgn, $title, $caption) = @_;
my ($return, $dummy, $mime, $file, $char, $protocol, $option);
$option = " target=\"page_win\"";
$return = &edit_link ($file_in, $date, $rgn, $title, $caption, $option);
$return
}
#################################################
sub edit_tablequote #** マクロタグ処理 tablequote設定 97/07/02本体から分離,98/03/08修正,00/01/05修正
#################################################
{
my ($comment, $compose_mode) = @_;
my ($text, $td_tag, $this_width);
if ($compose_mode eq "on")
{
$this_width = "";
}
else
{
if ($GTQ_WIDTH ne "")
{ #99/12/12追加
$this_width = $GTQ_WIDTH;
}
else
{
if ($GWIDTH ne "")
{ #99/12/12追加
if ($GWIDTH >= 600)
{
$this_width = $GWIDTH - 24;
}
else
{
$this_width = $GWIDTH;
}
}
}
}
if ($this_width ne "")
{
if ($GTQ_COLOR eq "")
{
$td_tag = "";
}
else
{
$td_tag = " | ";
}
}
else
{
if ($GTQ_COLOR eq "")
{
$td_tag = " | ";
}
else
{
$td_tag = " | ";
}
}
$text = "";
if ($GCENTER eq "yes" || $GCENTER eq "on" || $GCENTER eq "")
{
$text .= "\n";
}
if ($this_width ne "")
{
$text .= "\n";
}
else
{ #99/12/12追加
$text .= "\n";
} #99/12/12追加, 00/11/20
$text .= "\n$td_tag\n \n";
if ($GTQ_COLOR_TEXT ne "")
{
$text .= "";
} #01/04/23追加
$text .= $comment;
if ($GTQ_COLOR_TEXT ne "")
{
$text .= "";
} #01/04/23追加
$text .="\n";
if ($GLANGUAGE eq "")
{
$text .= "\n \n";
}
else
{
$text .= "\n \n";
}
$text .= "\n\n \n \n";
if ($GCENTER eq "yes" || $GCENTER eq "on" || $GCENTER eq "")
{
$text .= "\n";
}
$text
}
#################################################
sub edit_quote #** マクロタグ処理 quote設定 98/02/24追加
#################################################
{
my ($comment) = @_;
my ($text, $td_tag);
$text = "";
$text .= "\n$comment\n \n \n";
$text
}
#################################################
sub edit_hr #** マクロタグ処理 区切り線設定 2004/02/24 insert PopCorn WG
#################################################
{
my ($comment) = @_;
my ($text, $td_tag);
($width_hr,$size_hr) = split (/,/, $comment);
$text = "";
$text .= " \n \n";
$text
}
#################################################
sub edit_vod_list #** マクロタグ処理 VODクリップリスト編集 2004/10/02 Maekawa
#マクロタグset_vodに対応したテキストファイル等のクリップファイルを作成する
#################################################
{
my ($module);
foreach $module (@_)
{
}
}
#################################################
sub edit_set_vod #** マクロタグ処理 VODブロック編集 2004/09/26 Maekawa, 2004/10/02, 2005/01/10修正
#ビデオオンデマンド用のデータ一式を所定形式に整形し返却する
#(例) folder/sample.wmv が指定されていれば、以下のとおり照合させ処理する。
# s/folder/sample.jpg をサムネール
# s/folder/sample.wmv を低速ムービー(Sサイズ)
# folder/sample.wmv を中速ムービー(Mサイズ)
# l/folder/sample.wmv を高速ムービー(Lサイズ)
# folder/sample.txt をテキスト全文
# meta/folder/sample.txt をメタ(属性)データ
# folder/sample_連番.jpg を関連画像(複数)
# folder/sample_連番.txt を関連テキスト(複数)
# テキスト全文、メタデータ、関連画像、関連テキストはクリップファイルに展開する
#################################################
{
my ($comment, $title) = @_;
my ($text, $td_tag);
($movie) = split (/,/, $comment);
($movie) = split (/\t/, $movie);
$mime = &get_mime ($movie);
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ対応
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
$site = $GSITE;
$tmp_path = "$path" . "files";
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter";
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
#ムービーのローカルパス設定
$path_movie = "$GPATH_LOCAL$fpath$mime/$movie";
$path_movie = &conv_path($path_movie);
$url_movie = "$frpath/$mime/$movie";
#ムービー(Sサイズ:低速)のローカルパスとURL(相対パス)設定
$path_movie_s = "$GPATH_LOCAL$fpath$mime/s/$movie";
$path_movie_s = &conv_path($path_movie_s);
$url_movie_s = "$frpath/$mime/s/$movie";
#ムービー(Lサイズ:高速)のローカルパスとURL(相対パス)設定
$path_movie_l = "$GPATH_LOCAL$fpath$mime/l/$movie";
$path_movie_l = &conv_path($path_movie_l);
$url_movie_l = "$frpath/$mime/l/$movie";
#静止画サムネール(Sサイズ)のローカルパスとURL(相対パス)設定
$icon_jpg = $movie;
$icon_jpg=~ s/\.$mime/\.jpg/;
$path_jpg_s = "$GPATH_LOCAL$fpath" . "jpg/s/" . "$icon_jpg";
$path_jpg_s = &conv_path($path_jpg_s);
$url_jpg_s = "$frpath/jpg/s/$icon_jpg";
#Lサイズ画像のローカルパスとURL(相対パス)設定
$path_jpg_l = "$GPATH_LOCAL$fpath" . "jpg/$GDIR_LSIZE/" . "$icon_jpg";
$path_jpg_l = &conv_path($path_jpg_l);
$url_jpg_l = "$frpath/jpg/$GDIR_LSIZE/$icon_jpg";
#メタデータのローカルパスとURL(相対パス)設定
$meta = $movie;
$meta=~ s/\.$mime/\.txt/;
$meta = "$GPATH_LOCAL$fpath" . "txt/meta/" . "$meta";
$meta = &conv_path($meta);
$url_meta = "$frpath/txt/meta/$meta";
#テキスト全文のローカルパスとURL(相対パス)設定
$fulltext = $movie;
$fulltext=~ s/\.$mime/\.txt/;
$clip_fulltext = $fulltext;
$fulltext = "$GPATH_LOCAL$fpath" . "txt/" . "$fulltext";
$fulltext = &conv_path($fulltext);
#テキスト全文展開のHTMLファイルとURL(相対パス)設定
$html = $movie;
$html=~ s/\.$mime/\.html/;
$html =~ s/\//\-/g;
$url_html = "../page2/$html";
#メタデータ取得
if ($title ne "") { $m_title ="$title"; }
else { $m_title ="$movie"; }
$m_abstract ="データはありません。";
$m_person ="";
$m_source ="";
$m_link ="";
$m_link_url ="";
if (-e $meta)
{
open (META, $meta);
while ()
{
chomp;
if (/【タイトル】/) { ($mtag, $m_title) = split (/\t/, $_); }
if (/【アブストラクト】/) { ($mtag, $m_abstract) = split (/\t/, $_); }
if (/【出演者】/) { ($mtag, $m_person) = split (/\t/, $_); }
if (/【リンク】/) { ($mtag, $m_link, $m_link_url) = split (/\t/, $_); }
if (/【出典】/) { ($mtag, $m_source) = split (/\t/, $_); }
}
close (META);
}
#出力データ生成
$text = "";
$text .= "\n\n";
$text .= "\n";
$text .= "$m_title [ ";
$text .= "動画再生 | ";
if (-e $fulltext)
{
$text .= "全文\表\示 | ";
}
else
{
$text .= "全文\表\示 | ";
}
$text .= "詳細情報 | ";
if (-e $path_jpg_l) { $text .= "画像拡大 | "; }
$text .= " ] | \n";
$text .= " \n";
$text .= "\n";
$text .= "\n";
$text .= "\n";
$text .= " \n";
$text .= " | \n";
$text .= "\n";
$text .= "";
if ($m_person ne "") { $text .= "$m_person\n \n"; }
$text .= "$m_abstract";
if ($m_link ne "" && $m_link_url ne "") { $text .= " $m_link\n"; }
$text .= "\n";
$text .= " | \n";
$text .= " \n";
$text .= " \n";
$text =~ s/\| \]/ \]/g;
$text
}
#################################################
sub edit_imageclip_page1 #** マクロタグ処理(imageclip) 映像クリップ(画像配列)一覧作成 98/10/25
#################################################
{
my ($this_clip_dir, $file_in, $file_top, $file_bottom, $catg,
$in_option, $page_title) = @_;
my ($char, $flag, $file_mime, $file_img, $date, $place, $title,
$comment, $option, $star, $return, $return1, $return2,
$dummy, $file_html, $file_html2, $num, $num_c, $mime,
$no_blk, $delimiter, $file_img_s1, $file_img_s,
$local_file_img, $clip_mark, $len_dir, $len_str, $chr_dir,
$path_l, $len_l, $path_this, $len_this, $file_mime_m);
my ($machine, $path, $fpath, $frpath, $opt_path, $icon_jpg,
$local_icon, $tmp_path);
# アイコン存在チェック用
my ($icon_path, $icon_flag);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
if ($machine eq "mac" || $machine eq "win")
{
$path = $GPATH_LOCAL;
}
else
{
$path = $GPATH_SERVER;
}
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
#$tmp_path = "$path$delimiter" . "files";
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter";
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
#機種を取得
&machine;
$delimiter = $GDELIMITER;
$star = "★";
$G_CLIP_LIST = "";
if ($GCLIP_MARK ne "")
{
$clip_mark = $GCLIP_MARK;
}
else
{
$clip_mark = "\#";
}
$file_in =~ s/\//$GDELIMITER/g; #00/01/15
$len_dir = length ($GDIR_LSIZE); #00/04/16
$len_dir++;
$return1 = $return2 = "";
#クリップファイルを取得
open (FIMAGECLIP, $file_in)
# || output_msg("POP-E007", "sub:edit_imageclip_page1 $file_in");
|| return ""; #2003/04/17暫定処置
#2002/05/06 NANDRA "$file_inをオープンできませんでした。
while ($_ = )
{
($file_mime) = split (/\t/, $_);
if ($file_top eq $file_mime && $file_top ne "")
{
$flag = "yes";
last;
}
if ($file_top eq "" && $file_mime ne "")
{
$flag = "yes";
last;
}
}
#フラグがyesだったら。
if ($flag eq "yes")
{
$num = 0;
$G_GET_CLIP_DATE = $date;
if ($GWIDTH ne "")
{
$return = "\n";
}
else
{
$return = "\n";
}
$no_blk = 0;
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option)
= split (/\t/, $_);
unless (/^#/ || $title eq "−"
|| $title eq "--" || $title eq "-")
{
$date = &conv_date ($date);
($file_html, $mime) = split (/\./, $file_mime);
$file_img_s1 = $file_mime;
$chr_dir = substr ($file_img_s1, 0, $len_dir); #00/04/16
if ($chr_dir eq "$GDIR_LSIZE\/")
{ #00/04/16
$len_str = length ($file_img_s1);
$file_img_s1 = substr ($file_img_s1,
$len_dir, $len_str - $len_dir);
}
#02/03/26Lサイズ画像パスの時、
#Mサイズパスに読み替え、後続処理でSサイズパスに変換
$path_l = "$GDIR_LSIZE/";
$len_l = length ($path_l);
$path_this = substr ($file_mime, 0, $len_l);
### 追加 2003/02/06
### 画像ファイル以外は、アイコン画像表示にする。
$icon_flag = 1;
#if ($mime ne "jpg" && $GENHANCED ne "")
if ($mime ne "jpg" &&
$mime ne "JPG" &&
$mime ne "jpeg" &&
$mime ne "JPEG" &&
$mime ne "gif" &&
$mime ne "GIF" &&
$mime ne "png" &&
$mime ne "PNG" )
{
$icon_jpg = $file_mime;
$icon_jpg =~ s/$mime/jpg/;
$local_icon = "$fpath" . "jpg/$GDIR_SSIZE/$icon_jpg";
$local_icon =~ s/\:/$delimiter/g;
$local_icon =~ s/\//$delimiter/g;
if (-e $local_icon)
{
$file_img = "$frpath/jpg/$GDIR_SSIZE/$icon_jpg";
}
else
{
$file_img = "../icon/$mime" . "_icon.jpg";
$icon_path = "$path/icon/$mime" . "_icon.jpg";
$icon_path =~ s/\:/$delimiter/g;
$icon_path =~ s/\//$delimiter/g;
if(-e $icon_path)
{
$icon_flag = 1;
}
else
{
$icon_flag = 0;
}
}
}
elsif ($path_l eq $path_this)
{
###
$len_this = length ($file_mime);
$len_this -= $len_l;
$file_mime_m = substr ($file_mime,
$len_l, $len_this);
# (2003/02/20)
$file_img = "$frpath/$mime/$GDIR_SSIZE/$file_mime_m";
}
else
{
# (2003/02/20)
$file_img = "$frpath/$mime/$GDIR_SSIZE/$file_mime";
}
# (2003/02/20)
$file_img_s = "$frpath/$mime/$GDIR_SSIZE/$file_img_s1";
# (2003/02/20)
$local_file_img = "$fpath" .
"$mime/$GDIR_SSIZE/$file_img_s1";
$local_file_img =~ s/\:/$delimiter/g;
$local_file_img =~ s/\//$delimiter/g;
if (-e $local_file_img)
{
$file_img = $file_img_s;
}
#02/04/24 Maekawa
$file_html2 = &get_clip_fname ($file_html, "chk");
$file_html = "../$this_clip_dir/$file_html2";
$num++;
$num_c = &conv_num($num,2);
$date = &conv_date ($date);
if ($GSTAR ne "")
{
$title =~ s/$star/$GSTAR/g;
}
$no_blk++;
if ($title eq "")
{
if ($GCLIP_TITLE_SETTING eq "on")
{
if ($GCLIP_SEQNO eq "on")
{
$title = "$page_title#$num_c";
}
else
{
$title = "$page_title";
} #02/04/24 Maekawa
}
else
{
$title = $file_html2;
}
}
if ($GLINE eq "on" && $GLINE_COLOR ne "")
{
if ($GIMAGECLIP_LINK eq "off")
{ #99/12/04追加
if ($in_option eq "link_on")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
#アイコン無し 03/03/05
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
else
{
if ($in_option eq "link_off")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
}
else
{
if ($GIMAGECLIP_LINK eq "off")
{ #99/12/04追加
if ($in_option eq "link_on")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
else
{
if ($in_option eq "link_off")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
}
$G_CLIP_LIST .= "$_$GSPR_CODE";
}
if ($file_bottom ne $file_mime)
{
while ()
{
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option) = split (/\t/, $_);
$date = &conv_date ($date);
last if ( ($file_bottom eq $file_mime) && (/^#/ || $title eq "−" || $title eq "--" || $title eq "-") );
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
($file_html, $mime) = split (/\./, $file_mime);
$file_img_s1 = $file_mime;
#00/04/16
$chr_dir = substr ($file_img_s1, 0, $len_dir);
if ($chr_dir eq "$GDIR_LSIZE\/")
{ #00/04/16
$len_str = length ($file_img_s1);
$file_img_s1 = substr ($file_img_s1,
$len_dir, $len_str - $len_dir);
}
#02/03/26Lサイズ画像パスの時、Mサイズ
#パスに読み替え、後続処理でSサイズパスに変換
$path_l = "$GDIR_LSIZE/";
$len_l = length ($path_l);
$path_this = substr ($file_mime, 0, $len_l);
### 追加 2003/02/06
### 画像ファイル以外は、アイコン画像表示にする。
$icon_flag = 1;
#if ($mime ne "jpg" && $GENHANCED ne "")
if ($mime ne "jpg" &&
$mime ne "JPG" &&
$mime ne "jpeg" &&
$mime ne "JPEG" &&
$mime ne "gif" &&
$mime ne "GIF" &&
$mime ne "png" &&
$mime ne "PNG" )
{
$icon_jpg = $file_mime;
$icon_jpg =~ s/$mime/jpg/;
$local_icon = "$fpath/jpg/$GDIR_SSIZE/$icon_jpg";
$local_icon =~ s/\:/$delimiter/g;
$local_icon =~ s/\//$delimiter/g;
if (-e $local_icon)
{
$file_img = "$frpath/jpg/$GDIR_SSIZE/$icon_jpg";
}
else
{
$file_img = "../icon/$mime" . "_icon.jpg";
$icon_path = "$path/icon/$mime" . "_icon.jpg";
$icon_path =~ s/\:/$delimiter/g;
$icon_path =~ s/\//$delimiter/g;
if(-e $icon_path)
{
$icon_flag = 1;
}
else
{
$icon_flag = 0;
}
}
}
elsif ($path_l eq $path_this)
{
###
$len_this = length ($file_mime);
$len_this -= $len_l;
$file_mime_m = substr ($file_mime,
$len_l, $len_this);
# (2003/02/20)
$file_img = "$frpath/$mime/$GDIR_SSIZE/$file_mime_m";
}
else
{
# (2003/02/20)
$file_img = "$frpath/$mime/$GDIR_SSIZE/$file_mime";
}
# (2003/02/20)
$file_img_s = "$frpath/$mime/$GDIR_SSIZE/$file_img_s1";
# (2003/02/20)
$local_file_img = "$fpath$mime/$GDIR_SSIZE/$file_img_s1";
$local_file_img =~ s/\:/$delimiter/g;
$local_file_img =~ s/\//$delimiter/g;
if (-e $local_file_img)
{
$file_img = $file_img_s;
}
#02/04/24 Maekawa
$file_html2 = &get_clip_fname ($file_html, "chk");
$file_html = "../$this_clip_dir/$file_html2";
$num++;
$num_c = &conv_num($num,2);
$date = &conv_date ($date);
if ($GSTAR ne "")
{
$title =~ s/$star/$GSTAR/g;
}
$no_blk++;
if ($title eq "")
{
if ($GCLIP_TITLE_SETTING eq "on")
{
if ($GCLIP_SEQNO eq "on")
{
$title = "$page_title#$num_c";
}
else
{
$title = "$page_title";
} #02/04/24 Maekawa
}
else
{
$title = $file_html2;
}
}
if ($GLINE eq "on" && $GLINE_COLOR ne "")
{
if ($GIMAGECLIP_LINK eq "off")
{ #99/12/04追加
if ($in_option eq "link_on")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
else
{
if ($in_option eq "link_off")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
}
else
{
if ($GIMAGECLIP_LINK eq "off")
{ #99/12/04追加
if ($in_option eq "link_on")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
else
{
if ($in_option eq "link_off")
{ #00/01/16追加
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
else
{
$return1 .= "$clip_mark$num_c $title | \n";
if($icon_flag)
{
$return2 .= " | \n";
}
else
{
$return2 .= " | \n";
}
}
}
}
if ($no_blk == $GIMAGECLIP_NUM)
{
$return .= "\n$return1 \n\n$return2 \n"; $no_blk = 0;
$return1 = $return2 = "";
}
$G_CLIP_LIST .= "$_$GSPR_CODE";
last if ($file_bottom eq $file_mime);
}
}
}
if ($no_blk >= 1)
{
$return .= "\n$return1 \n\n$return2 \n";
$no_blk = 0;
$return1 = $return2 = "";
} #00/04/23
$return .= " \n";
$return1 = "\n\n\n($GTXT1P$num$GTXT1S)" .
" | \n \n \n"; #99/12/12追加 # 2001/11 NANDRA
if ($GCENTER_IMAGECLIP eq "yes" || $GCENTER_IMAGECLIP eq "on"
|| $GCENTER_IMAGECLIP eq "")
{
$return1 .= "\\n";
} #99/12/04追加
$return = $return1 . $return;
if ($GCENTER_IMAGECLIP eq "yes" || $GCENTER_IMAGECLIP eq "on"
|| $GCENTER_IMAGECLIP eq "")
{
$return .= "\<\/center\>\n";
} #99/12/04追加
$return =~ s/\[\] //g;
$return =~ s/\[\/\/\] //g;
$return .= " \n";
if ($num eq "" || $num == 0)
{
$return = "";
} #02/10/03 Maekawa
$return
}
#################################################
#最上川フォーラムコンテンツ作成(地図連携対応)
sub edit_gmapIN
#新規作成
#################################################
{
#変数宣言@
my($str2,$str3,$wi) = @_;
$Gmaptext[$wi] = "AddGMarker(map,$str2,\"$str3\");\n";
}
#################################################
#最上川フォーラムコンテンツ作成(地図連携対応)
sub edit_gmapOUT
#新規作成
#################################################
{
#変数宣言@
# my ($path, $keyitem, $this_page_dir, $this_clip_dir,
# $date, $page, $catg, $region, $xy, $url, $title,
# $yomi, $comment, $date2, $gmap_xy) = @_;
my ($path, $this_page_dir, $url, $title, $gmap_xy) = @_;
#変数宣言A
my ($delimiter, $machine, $site, $fpath, $frpath, $opt_path, $tmp_path,
$file, $file_page, $site, $map_html_fnm, $idx, $gmap_key);
my ($url_path , $out_path, $gmap_page );
$gmap_key = $GMAPKEY;
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
$site = $GSITE;
$tmp_path = "$path" . "files";
if ($GENHANCED ne "" || -e $tmp_path) {
$fpath = "$path" . "files$delimiter";
$frpath = "../files";
$opt_path = "$delimiter$site";
} else {
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
$tag_date_chk = "";
($title) = split (/, $title);
$dir = $path . "$this_page_dir";
&check_dir ($dir);
$file_page = $path . "$this_page_dir" . $delimiter . $url . "map.html";
open (GMAP_FILE, ">$file_page");
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE "Google Maps JavaScript API Example - simple\n";
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE "\n";
print GMAP_FILE " \n";
print GMAP_FILE "\n";
close (GMAP_FILE);
if ( $G_PUB_FLG eq "on" ) {
$url_path = $G_URL_PUB;
} else {
$url_path = $G_URL;
}
$gmap_page = $url_path . $delimiter . $this_page_dir . $delimiter . $url . "map.html";
return $gmap_page;
}
#==================================================================
#** Part 5:MIME/拡張MIME処理サブルーチン
#==================================================================
#################################################
sub edit_imagelink #** インライン画像タグ編集 99/11/01追加
#################################################
{
my ($path, $mime, $file_mime) = @_;
my ($file, $img, $filename, $ext, $filename2,
$filename3, $mmod, $lsize, $len1, $len2, $len, $filepath, $text, $text2);
my ($machine, $delimiter, $fpath, $frpath, $opt_path, $icon_jpg,
$local_icon, $tmp_path, $ofilepath, $opath, $ofile, $ourl);
# アイコンの存在チェック用
my ($icon_path);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
#$tmp_path = "$path$delimiter" . "files";
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
($filename, $ext) = split (/\./, $file_mime);
$filename2 = $filename;
$text = "";
$protocol = &check_protocol ($file_mime); #01/03/28
if ($protocol eq "yes")
{ #01/03/28 URL指定の場合
$img = "";
$text = "$img\ ";
}
else
{
if ($GMOD_LSIZE ne "")
{
#Lサイズ版修飾子が指定されている場合、Mサイズ版画像
#からLサイズ版画像にリンクする。
if ($GMOD_MSIZE eq "")
{
$lsize = $filename . $GMOD_LSIZE . "\." . $ext;
}
else
{
$len1 = length ($GMOD_LSIZE);
$len2 = length ($filename);
$len = $len2 - $len1;
$filename3 = substr ($filename, 0, $len);
$mmod = substr ($filename, $len, $len1);
if ($GMOD_MSIZE eq $mmod)
{
$lsize = $filename3 . $GMOD_LSIZE . "\." . $ext;
}
else
{
$lsize = $filename . $GMOD_LSIZE . "\." . $ext;
}
}
# (2003/02/21)
$filepath = "$fpath$mime$GDELIMITER$lsize";
$filepath = &conv_path ($filepath);
###
### Added 2003/02/07
#if ($mime ne "jpg" && $GENHANCED ne "")
if ($mime ne "jpg" && $mime ne "JPG" && $mime ne "jpeg" && $mime ne "JPEG" && $mime ne "gif" && $mime ne "GIF" && $mime ne "png" && $mime ne "PNG" )
{
$file_mime =~ s/ /\%20/g;
$file = "$frpath/$mime/$file_mime";
$icon_jpg = $file_mime;
$icon_jpg =~ s/$mime/jpg/;
$local_icon = "$fpath/jpg/$GDIR_SSIZE/$icon_jpg";
$local_icon =~ s/\:/$delimiter/g;
$local_icon =~ s/\//$delimiter/g;
if (-e $local_icon)
{
$img = "";
$text = "$img\ "
}
else
{
$img = "";
$icon_path = "$path/icon/$mime" . "_icon.jpg";
$icon_path =~ s/\:/$delimiter/g;
$icon_path =~ s/\//$delimiter/g;
if(-e $icon_path)
{
$text = "$img\ "
}
else
{
$text = ""
}
}
;
}
elsif (-e $filepath)
{
###
$file_mime =~ s/ /\%20/g;
$lsize =~ s/ /\%20/g;
# (2003/02/20)
$file = "$frpath/$mime/$file_mime";
$img = "";
# (2003/02/20)
$text = "$img\ ";
}
else
{
$file_mime =~ s/ /\%20/g;
# (2003/02/20)
$file = "$frpath/$mime/$file_mime";
$img = "";
$text = "$img ";
}
}
else
{
#Lサイズ版修飾子が指定されていない場合、普通にMサイズ
#版を表示、さらにLサイズ版があればLサイズ画像にリンク
$file_mime =~ s/ /\%20/g;
# (2003/02/20) mod 2005/04/25 グループファイル対応
$target = "";
if ($mime ne "group"){
$file = "$frpath/$mime/$file_mime";
} else {
my @tmp_filename = split ("/", $file_mime);
open (GRP, "<$frpath/$mime/$tmp_filename[1]");
while (){
chop;
$file = "$frpath/$mine$_";
}
close GRP;
$target = " target=\"_blank\""
}
# 追加 2003/02/06
# 画像以外の場合のページ表示&リンク修正
#if ($mime eq "jpg" )
if ($mime eq "jpg" || $mime eq "JPG" || $mime eq "jpeg" || $mime eq "JPEG" || $mime eq "gif" || $mime eq "GIF" || $mime eq "png" || $mime eq "PNG" )
{
# 画像のときは従来どおり。
$img = "";
#02/01/23Lサイズ画像リンク
# (2003/02/20)
$filepath = "$fpath$mime/$GDIR_LSIZE/$file_mime"; #Lサイズ画像ローカルパス
$filepath = &conv_path ($filepath); #ローカルパスのデリミタを変換
$opath = &path_file($file_mime, 2); #パスのみ取得
($opath, $ofile) = split (/\t/, $opath);
$ofile = &path_file($file_mime, 1); #ファイル名のみ取得
($dummy, $ofile) = split (/\t/, $ofile);
$ofilepath = "$fpath$mime/$GDIR_OSIZE/$opath" . "image/jpeg/$ofile"; #2004/02/08PushCornのOサイズ画像ローカルパス
$ofilepath = &conv_path ($ofilepath); #ローカルパスのデリミタを変換
$ourl = "$frpath/$mime/$GDIR_OSIZE/$opath" . "image/jpeg/$ofile"; #IMGタグ用のURL
if (-e $ofilepath) {}
else
{
$ofilepath = "$fpath$mime/$GDIR_OSIZE/$file_mime"; #2004/02/07PopCorn用のOサイズ画像ローカルパス
$ofilepath = &conv_path ($ofilepath); #ローカルパスのデリミタを変換
$ourl = "$frpath/$mime/$GDIR_OSIZE/$file_mime";
}
$text2 = "";
if ((-e $filepath) || (-e $ofilepath))
{
$text2 .= " →画像\表\示";
}
if (-e $filepath)
{
# (2003/02/20)
#$text = "$img\ ";
#画像表示ウィンドウによるリンク #2004/01/27 Maekawa
$text = "$img\";
$text2 .= " [ Lサイズ\ ]\n";
}
else
{
$text = "$img ";
}
#2004/02/07Oサイズが存在している時にはOサイズ画像のウィンドウ表示をさらに追加
if (-e $ofilepath)
{
$text2 .= " [ オリジナル\ ]\n";
}
$text .= $text2;
}
else
{
$icon_jpg = $file_mime;
$icon_jpg =~ s/$mime/jpg/;
$local_icon = "$fpath/jpg/$GDIR_SSIZE/$icon_jpg";
$local_icon =~ s/\:/$delimiter/g;
$local_icon =~ s/\//$delimiter/g;
if (-e $local_icon)
{
$img = "";
$text = "$img\";
}
else
{
$img = "";
$icon_path = "$path/icon/$mime" . "_icon.jpg";
$icon_path =~ s/\:/$delimiter/g;
$icon_path =~ s/\//$delimiter/g;
if(-e $icon_path)
{
$text = "$img\ "
}
else
{
$text = ""
}
}
}
}
}
$text
}
#################################################
sub get_mime_from_clip #** クリップ内MIME取得 99/04/13追加
#################################################
{
my ($file_in) = @_;
my ($file_mime, $mime, $dummy, $title);
$file_in = &conv_path ($file_in);
#open (FCLIP, $file_in) || output_msg("POP-E007", "sub:get_mime_from_clip $file_in");
open (FCLIP, $file_in) || return ""; #2003/04/17returnは暫定処理
while ($_ = )
{
($file_mime, $dummy, $dummy, $title) = split (/\t/, $_);
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
$_ = $file_mime;
last if (/\./);
}
close (FCLIP);
$mime = &get_mime ($file_mime);
# print $file_mime;# . ":" . $mime; # DEBUG用 2001/8 NANDRA
$mime
}
#################################################
sub get_mime #** MIME取得 99/04/13追加 01/08/15 xxxx.html#partname という形式のファイル名に対応(by NANDRA)
#################################################
{
my ($file_mime) = @_;
my (@dir, @str, @part, $num, $mime);
$file_mime =~ s/\:/\//g;
#$file_mime =~ s/\\/\//g;
@dir = split (/\//, $file_mime);
$num = @dir;
$num--;
@str = split (/\./, $dir[$num]);
$num = @str;
$num--;
$mime = $str[$num];
$mime =~ s/ //g;
@part = split (/\#/, $mime); #01/08/15
$mime = $part[0]; #01/08/15
$mime
}
#################################################
sub html_from_file #** HTMLファイル入力(html) 00/01/05追加, 01/08/14 BODY部のみ抜き取るように修正(by NANDRA)
#################################################
{
my ($file) = @_;
my ($text, $part, @parts, $i, $n);
if (split(/\#/, $file) == 2)
{
$file = @_[0];
$part = @_[1];
}
else
{
$file = @_[0];
$part = "";
}
open (TEXTFILE, $file) || output_msg("POP-E007", "sub:html_from_file $file");
while ()
{
$text .= $_;
}
close (TEXTFILE);
if ( $part eq "" )
{
$text =~ s/<[ \t\n\r\f]*\/?body[^>]*>//gis;
if (split(//, $text) == 3)
{
$text = @_[1];
}
else
{
#2002/05/06 NANDRA
#"$fileのBODYタグが不正です。BODY部抽出処理は行なわれません
output_msg("POP-M007", $file);
}
#$text = '' . $text;
}
else
{
$text =~ s/<[ \t\n\r\f]*a name/<\/body/gis;
$n = split(//, $text);
@parts = @_;
$text = "";
for ( $i = 0 ; $i < $n ; ++$i )
{
$_ = @parts[$i];
if (/name[ \t\n\r\f]*=[ \t\n\r\f]*\"$part\"/is)
{
$text = $_;
last;
}
}
if ( $text eq "" )
{
#2002/05/06 NANDRA "$fileの中に$partという章はありませんでした
output_msg("POP-E018", $file, $part);
}
}
$text;
}
#################################################
sub text_from_file #** テキストファイル入力(txt, src) 97/04/22追加, 98/03/02 option対応, 99/10/13表組機能
#################################################
{
my ($file, $mime, $option, $file_mime) = @_;
my ($text, $num, $mode, $max, $i, @table_tmp, $rtn, $text2, $line,
$buf, @lines, $txt_tmp, $txt_tmp2, $txt_each, @table, $xtitle, $xdate, $xplace, $xoption);
$rtn = open (TEXTFILE, $file);
if ($rtn != 1)
{
# Alert! No file: $file 2002/05/06 NANDRA
$rtn = &output_msg ("POP-M005", $file); return "";
}
$num = 1;
$max = 0;
$mode = "off";
while (read TEXTFILE, $buf, 16384)
{
$text .= $buf;
} #2002/01/20 Maekawa
$text = &filter_source_code($text); #2002/01/20 Maekawa
@lines = split (/\n/, $text);
$text = "";
foreach $_ (@lines)
{
if ($num == 1 && /^#/) #2004/01/18 "pre"が無視されるバグの対応 Maekawa
{
($xtitle, $xdate, $xplace, $xoption) = split (/\t/, $_);
if ($xoption ne "") { $option = $xoption; }
}
$_ .= "\n";
unless ($num == 1 && /^#/)
{
next if (/^\/\#/); #99/12/06追加 先頭が/#はコメント行
@table = split (/\t/, $_);
$max = @table; $max--;
if ($max == 0)
{
if ($mode eq "on")
{
#02/03/27
#@table_tmpを$tmpに変換, table_from_fileの第3引数を配列で
#なくした(区切り文字は$GRET_CODE)
$txt_tmp = join ("$GRET_CODE", @table_tmp);
$text .= &table_from_file ("", "", $txt_tmp);
}
if ($option eq "" || $option eq "plain" || $option eq "set_vod")
{
#$_ =~ s/\n\n/\n/g;
$_ =~ s/\n/ \n/g;
}
$text .= $_;
$mode = "off";
}
else
{
if ($mode eq "off")
{
@table_tmp = ();
}
$mode = "on";
chop;
next if (/^#/);
next if (//);
if ($option eq "source")
{
$text .= "$_\n";
}
else
{ #00/11/19
push (@table_tmp, $_);
}
}
}
$num++;
}
close (TEXTFILE);
$txt_tmp2 = "";
#02/03/27table_from_fileの第3引数を配列でなくした
#(区切り文字は$GRET_CODE)
$txt_tmp2 = join ("$GRET_CODE", @table_tmp);
if ($txt_tmp2 ne $txt_tmp)
{
$text .= &table_from_file ("", "", $txt_tmp2);
} #02/04/15条件追加
if ($mime eq "txt")
{
if ($option eq "source")
{#00/11/19修正
#2002/01/20置換処理を関数に独立
$text = &replace_source_code ($text);
}
if ($option eq "pre")
{
$text = " \n\n" . $text . "\n\n \n\n";
}
if ($option eq "set_vod") #04/10/03VOD編集対応
{
$movie = $file_mime;
$movie =~ s/\.txt/\.wmv/g;
$text1 = &edit_set_vod($movie);
$text1 .= "全文テキスト\n";
$text = "$text1\n\n" . $text . "\n\n\n\n";
}
}
$text
}
#################################################
sub replace_source_code #** ソースコード文字列置換 #2002/01/20 Maekawa
#################################################
{
my ($text) = @_;
my ($space, $lt, $gt, $amp, $amp2, $quot, $tag_alt, $delstr);
if ($GLANGUAGE eq "japanese" || $GLANGUAGE eq "")
{
$space = ' ';
}
else
{
$space = ' ';
}
$lt = '<';
$gt = '>';
$amp = '&';
$amp2 = '_&_&_';
$quot = '"';
$tag_alt = "[TAB]";
$delstr = '\n';
$text =~ s/$delstr//g;
$text =~ s/ /$space/g;
$text =~ s/&/$amp2/g;
$text =~ s/$lt/g;
$text =~ s/>/$gt/g;
$text =~ s/"/$quot/g;
$text =~ s/\n\n//g;
$text =~ s/\n/ /g;
$text =~ s/$amp2/$amp/g;
$text =~ s/\t/$tag_alt/g;
$text
}
#################################################
sub filter_source_code #** 範囲指定ソースコード文字列置換 #2002/01/20 Maekawa
#################################################
{
my ($text) = @_;
my (@lines, $sw, $max, $i);
# フィルター前処理 #2002/01/20 Maekawa
if ($GSOURCE_START ne "")
{
@lines = split (/\n/, $text);
$sw = "off";
$max = @lines; $max--;
for ($i = 0; $i <= $max; $i++)
{
$_ = $lines[$i];
if (/$GSOURCE_START/)
{
$sw = "on"; next;
}
if ($sw eq "on")
{
if (/$GSOURCE_END/)
{
$sw = "off"; next;
}
$lines[$i] = &replace_source_code ($lines[$i]);
}
}
$text = join ("\n", @lines);
}
$text
}
#################################################
sub table_from_file #** テーブル入力(table) 97/06/08追加, 99/12/06修正
#################################################
#02/03/27table_from_fileの第3引数を配列でなくした(区切り文字は$GRET_CODE)
{
my ($file, $conf, $txt_tmp) = @_;
my ($text, $max, @line, $num, %path_conf, %conf_table, $tag, $data,
@width, $th_text, $td_text, $cnt, $switch, $i, $atom, $tmp, $char,
$len, @records, @table_tmp);
$max = 1;
@table_tmp = split (/$GRET_CODE/, $txt_tmp); #02/03/27 Maekawa
if ($file ne "")
{
open (TABLEFILE, $file) || output_msg("POP-E007", "sub:table_from_file(1) $file");
while ()
{
next if (/^#/);
next if (//);
@line = split (/\t/, $_);
$num = @line;
if ($max < $num)
{
$max = $num;
}
}
close (TABLEFILE);
}
else
{
foreach $_ (@table_tmp)
{
next if (/^#/);
next if (//);
@line = split (/\t/, $_);
$num = @line;
if ($max < $num)
{
$max = $num;
}
}
}
%conf_table = &modify_table ($conf);
if ($file ne "")
{
open (TABLEFILE, $file) || output_msg("POP-E007", "sub:table_from_file(2) $file");
@records = ();
while ()
{
chop;
next if (/^#/);
next if (//);
push (@records, $_);
}
close (TABLEFILE);
}
else
{
@records = @table_tmp;
}
if ($GCENTER_TABLE eq "yes" || $GCENTER_TABLE eq "on")
{
$text = "\n" . $conf_table{'table'};
}
else
{
$text = "$conf_table{'table'}";
}
$cnt = 0;
$switch = 2;
foreach $_ (@records)
{
@line = split (/\t/, $_);
$cnt++;
if ($switch == 1)
{
$switch = 2;
}
else
{
$switch = 1;
}
$char = substr ($_, 0,1);
if ($char eq "\/")
{ #THの処理
$text .= "$conf_table{'tr_th'}";
for ($i = 0; $i < $max; $i++)
{
$atom = $line[$i];
if ($i == 0)
{
$len = length ($atom);
$atom = substr ($atom, 1, $len);
}
$tmp = $conf_table{'th'};
$tmp =~ s/\_text\_/$conf_table{'th_text'}/g;
$tmp =~ s/\_text\_/$atom/g;
$text .= "$tmp";
}
$text .= "\n";
$switch = 2;
}
else
{ #TDの処理
if ($switch == 1)
{ #TD 奇数行目
$text .= "$conf_table{'tr_td'}";
for ($i = 0; $i < $max; $i++)
{
$atom = $line[$i];
$tmp = $conf_table{'td'};
$tmp =~ s/\_text\_/$conf_table{'td_text'}/g;
$tmp =~ s/\_text\_/$atom/g;
$text .= "$tmp";
}
$text .= "\n";
}
else
{ #TD 偶数行目
$text .= "$conf_table{'tr_td2'}";
for ($i = 0; $i < $max; $i++)
{
$atom = $line[$i];
$tmp = $conf_table{'td2'};
$tmp =~ s/\_text\_/$conf_table{'td2_text'}/g;
$tmp =~ s/\_text\_/$atom/g;
$text .= "$tmp";
}
$text .= "\n";
}
}
}
$text .= " \n";
if ($GTABLE_FRAME ne "")
{
$text .= "\n \n";
} #00/01/25追加
if ($GCENTER_TABLE eq "yes" || $GCENTER_TABLE eq "on")
{
$text .= "\n";
}
$text
}
#################################################
sub default_table #** テーブル属性初期値設定 99/12/06追加
#################################################
{
my ($table1, $table2);
%GDEFAULT_TABLE = ();
#初期値設定 #02/04/21 Maekawa
if ($GTABLE_TR_TH eq "")
{
$GTABLE_TR_TH = "bgcolor=\"gray\" align=\"left\" valign=\"top\"";
}
if ($GTABLE_TH_TEXT eq "")
{
$GTABLE_TH_TEXT = "white";
}
if ($GTABLE_TR_TD eq "")
{
$GTABLE_TR_TD = "bgcolor=\"#e4e7dd\"";
}
if ($GTABLE_TR_TD2 eq "")
{
$GTABLE_TR_TD = "bgcolor=\"#f5f8ee\"";
}
if ($GTABLE eq "")
{
$table2 = "\n";
}
else
{
$table2 = "\n";
}
#00/01/25追加 テーブルの外枠表示のための下地テーブル
if ($GTABLE_FRAME ne "")
{
$table1 = "\n";
if ($GTABLE_FRAME_COLOR eq "")
{
$table1 .= "\n";
}
else
{
$table1 .= " | \n";
}
}
$GDEFAULT_TABLE{'table'} = $table1 . $table2;
if ($GTABLE_TR_TD2 eq "")
{
$GTABLE_TR_TD2 = $GTABLE_TR_TD;
}
if ($GTABLE_TD2_TEXT eq "")
{
$GTABLE_TD2_TEXT = $GTABLE_TD_TEXT;
}
$GDEFAULT_TABLE{'width'} = $GTABLE_WIDTH;
if ($GTABLE_TH_TEXT eq "")
{
$GDEFAULT_TABLE{'th_text'} = "\_text\_";
}
else
{
$GDEFAULT_TABLE{'th_text'} = "" .
"\_text\_\<\/font>";
}
if ($GTABLE_TD_TEXT eq "")
{
$GDEFAULT_TABLE{'td_text'} = "\_text\_";
}
else
{
$GDEFAULT_TABLE{'td_text'} = "" .
"\_text\_\<\/font>";
}
if ($GTABLE_TD2_TEXT eq "")
{
$GDEFAULT_TABLE{'td2_text'} = "\_text\_";
}
else
{
$GDEFAULT_TABLE{'td2_text'} = "" .
"\_text\_\<\/font>";
}
if ($GTABLE_TR_TH eq "")
{
$GDEFAULT_TABLE{'tr_th'} = "\n";
}
else
{
$GDEFAULT_TABLE{'tr_th'} = " \n";
}
if ($GTABLE_TR_TD eq "")
{
$GDEFAULT_TABLE{'tr_td'} = " \n";
}
else
{
$GDEFAULT_TABLE{'tr_td'} = " \n";
}
if ($GTABLE_TR_TD2 eq "")
{
$GDEFAULT_TABLE{'tr_td2'} = " \n";
}
else
{
$GDEFAULT_TABLE{'tr_td2'} = " \n";
}
if ($GTABLE_TH eq "")
{
$GDEFAULT_TABLE{'th'} = "\_text\_\<\/th\>\n";
}
else
{
$GDEFAULT_TABLE{'th'} = " | \_text\_\<\/th\>\n";
}
if ($GTABLE_TD eq "")
{
$GDEFAULT_TABLE{'td'} = " | \_text\_\<\/td\>\n";
}
else
{
$GDEFAULT_TABLE{'td'} = " | \_text\_\<\/td\>\n";
}
if ($GTABLE_TD2 eq "")
{
$GDEFAULT_TABLE{'td2'} = " | \_text\_\<\/td\>\n";
}
else
{
$GDEFAULT_TABLE{'td2'} = " | \_text\_\<\/td\>\n";
}
}
#################################################
sub modify_table #** テーブル属性初期値変更 99/12/06追加
#################################################
{
my ($conf) = @_;
my ($text, $max, @line, $num, %path_conf, %conf_table, $tag, $data,
@width, $th_text, $td_text, $cnt, $switch, $i, $atom, $tmp, $char);
#テーブル初期値設定
%conf_table = %GDEFAULT_TABLE;
if ($conf eq "")
{
%conf_table = %GDEFAULT_TABLE;
}
else
{
$path_conf = $GPATH_LOCAL . "conf" . $GDELIMITER . $conf;
if (-e $path_conf)
{
open (CONF, $path_conf) || output_msg("POP-E007", "sub:modify_table $path_conf");
while ()
{
chop;
next if (/^#/);
next if (//);
($tag, $data) = split (/\t/, $_);
if ($tag ne "width" && $tag ne "th_text" && $tag ne "td_text")
{
if ($data ne "")
{
$data = " " . $data;
}
else
{
$data = "";
}
}
if ($tag eq "width")
{
$conf_table{$tag} = $data;
}
if ($tag eq "th_text")
{
if ($data eq "")
{
$conf_table{$tag} = "\_text\_";
}
else
{
$conf_table{$tag} = "" .
"\_text\_\<\/font>";
}
}
if ($tag eq "td_text")
{
if ($data eq "")
{
$conf_table{$tag} = "\_text\_";
}
else
{
$conf_table{$tag} = "" .
"\_text\_\<\/font>";
}
}
if ($tag eq "table")
{
$conf_table{$tag} = "\n";
}
if ($tag eq "tr_th")
{
$conf_table{$tag} = "\n";
}
if ($tag eq "tr_td")
{
$conf_table{$tag} = " \n";
}
if ($tag eq "tr_td2")
{
$conf_table{$tag} = " \n";
}
if ($tag eq "th")
{
$conf_table{$tag} = "\_text\_\<\/th\>\n";
}
if ($tag eq "td")
{
$conf_table{$tag} = " | \_text\_\<\/td\>\n";
}
if ($tag eq "td2")
{
$conf_table{$tag} = " | \_text\_\<\/td\>\n";
}
}
}
else
{
%conf_table = %GDEFAULT_TABLE;
}
}
close (CONF);
%conf_table
}
#################################################
sub edit_clip_page1 #** MIME処理(clip) 映像クリップ一覧作成 97/05/21追加, 98/04/11修正
#################################################
{
my ($this_clip_dir, $file_in, $file_top, $file_bottom, $catg,
$in_option, $page_title) = @_;
my ($char, $flag, $file_mime, $date, $place, $title, $comment,
$option, $star, $c, $headline_chk,
$return, $dummy, $file_html, $file_html2, $num, $num_c, $clip_mark,
$clip_link, $clip_headline);
$star = "★";
$G_CLIP_LIST = "";
$headline_chk = "no";
if ($GCLIP_MARK ne "")
{
$clip_mark = $GCLIP_MARK;
}
else
{
$clip_mark = "\#";
}
$file_in =~ s/\//$GDELIMITER/g; #00/01/15
open (FCLIP, $file_in) || output_msg("POP-E007", "sub: edit_clip_page1 $file_in");
while ($_ = )
{
last if (/^END/);
($file_mime, $date, $place, $title, $comment, $option) =
split (/\t/, $_);
next if ($file_mime eq "");
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
($file_mime) = split (/\t/, $_);
if ($file_top eq $file_mime && $file_top ne "")
{
$flag = "yes";
last;
}
if ($file_top eq "" && $file_mime ne "")
{
$flag = "yes";
last;
}
}
if ($flag eq "yes")
{
$num = 0;
$G_GET_CLIP_DATE = $date;
if ($GLINE eq "on")
{
$return = "";
}
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option,
$c, $c, $c, $c, $c, $c, $clip_headline) = split (/\t/, $_);
if (not /^#/ && $title ne "−" && $title ne "--" && $title ne "-")
{
$date = &conv_date ($date);
$file_html2 = &get_clip_fname ($file_mime, "chk"); # 2001/08 NANDRA
$file_html = "../$this_clip_dir/$file_html2"; # 2001/08 NANDRA
$num++;
$num_c = &conv_num($num,2);
$date = &conv_date ($date);
if ($GSTAR ne "")
{
$title =~ s/$star/$GSTAR/g;
}
if ($title eq "")
{
if ($GCLIP_TITLE_SETTING eq "on")
{
if ($GCLIP_SEQNO eq "on")
{
$title = "$page_title#$num_c";
}
else
{
$title = "$page_title";
} #02/04/24 Maekawa
}
else
{
$title = $file_html2;
}
}
if ($GLINE eq "on")
{
if ($GLINE_COLOR eq "")
{
$return .= "";
}
else
{
$return .= " ";
}
$return .= "$date\ | $clip_mark$num_c\ | " .
"$title\" .
" | ";
if ($clip_headline ne "")
{
$return .= "$clip_headline\ | ";
$headline_chk = "yes";
}
else
{
$return .= " | ";
}
$return .= " \n";
}
else
{
$return .= "[$date] $clip_mark$num_c $title\ \n";
}
$G_CLIP_LIST .= "$_$GSPR_CODE";
}
if ($file_bottom ne $file_mime)
{
while ($_ = )
{
last if (/^END/);
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option, $c, $c, $c, $c, $c, $c, $clip_headline) = split (/\t/, $_);
next if ($file_mime eq "");
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
$date = &conv_date ($date);
# 2001/08 NANDRA
$file_html2 = &get_clip_fname ($file_mime, "chk");
$file_html = "../$this_clip_dir/$file_html2"; # 2001/08 NANDRA
$num++;
$num_c = &conv_num($num,2);
$date = &conv_date ($date);
if ($GSTAR ne "")
{
$title =~ s/$star/$GSTAR/g;
}
if ($title eq "")
{
if ($GCLIP_TITLE_SETTING eq "on")
{
if ($GCLIP_SEQNO eq "on")
{
$title = "$page_title#$num_c";
}
else
{
$title = "$page_title";
} #02/04/24 Maekawa
}
else
{
$title = $file_html2;
}
}
if ($GLINE eq "on")
{
if ($GLINE_COLOR eq "")
{
$return .= "";
}
else
{
$return .= " ";
}
$return .= "$date\ | $clip_mark$num_c\ | " .
"$title\"
. " | ";
if ($clip_headline ne "")
{
$return .= "$clip_headline\ | ";
$headline_chk = "yes";
}
else
{
$return .= " | ";
}
$return .= " \n";
}
else
{
$return .= "[$date] $clip_mark$num_c $title\ \n";
}
$G_CLIP_LIST .= "$_$GSPR_CODE";
last if ($file_bottom eq $file_mime);
}
}
}
#削除02/01/11 Maekawa
#if ($catg ne "$GNEWINFO" && $catg ne "皆さんの書き込みがあるページ"
#&& $keyitem eq "cat")
#削除02/01/11 Maekawa
#{ $GCLIP_COUNTER = $GCLIP_COUNTER + $num; } #98/02/01修正
if ($GLINE eq "on")
{
$txt_suspend = "\n";
if ($GLINE_COLOR_HEAD eq "")
{
$txt_suspend .= "";
}
else
{
$txt_suspend .= " ";
}
$txt_suspend .= "\@1\@$GTXT7\@2\@ | \@1\@No.\@2\@ | \@1\@$GTXTC\@2\@ | ";
if ($headline_chk eq "yes")
{
$txt_suspend .= "\@1\@説 明\@2\@ | ";
}
else
{
$txt_suspend .= " | ";
}
$txt_suspend .= " \n";
if ($GTEXT_COLOR_HEAD eq "")
{
$txt_suspend =~ s/\@1\@//g;
$txt_suspend =~ s/\@2\@//g;
}
else
{
$txt_suspend =~ s/\@1\@/\/g;
$txt_suspend =~ s/\@2\@/\<\/font\>/g;
}
}
# 2001/11 NANDRA
$return = "($GTXT1P$num$GTXT1S) \n" . $txt_suspend . $return;
$return =~ s/\[\] //g;
$return =~ s/\[\/\/\] //g;
if ($GLINE eq "on")
{
$return .= " \n";
}
$return .= " \n";
$return =~ s/<\/th><\/tr>\n/\n/g; #00/11/20
$return =~ s/ | <\/td><\/tr>\n/\n/g; #00/11/20
if ($num eq "" || $num == 0)
{
$return = "";
} #02/10/03 Maekawa
$return
}
#################################################
sub edit_clip_page2 #** MIME処理(clip) 映像クリップページ一括作成 97/05/21追加, 98/04/11修正
#################################################
{
my ($this_clip_dir, $file_in, $up, $path, $path2, $text_tmp,
$page_title) = @_;
my ($data, $this, $char, $flag, $file_mime, $date, $place, $title,
$comment, $option, $dummy, $file_html, $file_html_old, $text,
$text_old, $delimiter, $star, @clip_array, $mime, $next, $prev,
$serial, $serial_c, $file_map, $local_file_map, $include_text,
$txtfile, $xref);
&machine;
$delimiter = $GDELIMITER;
unless (-d "$path$path2")
{
&check_dir ("$path$path2");
}
$file_in =~ s/\//$GDELIMITER/g; #00/01/15
# open (FCLIP, $file_in) || output_msg("POP-E007", "sub:edit_clip_page2 $file_in");
open (FCLIP, $file_in) || return ""; #203/04/17暫定処置
$return = "\@numbers\@ \n";
$serial = 0;
@clip_array = split (/$GSPR_CODE/, $G_CLIP_LIST);
foreach $data (@clip_array)
{
#2001/09/15修正 Maekawa
($file_mime, $date, $place, $title, $comment,
$option,,,,,,,,,$xref) = split (/\t/, $data);
next if ($file_mime eq "");
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
$this = &get_clip_fname ($file_mime, "get");
if ($serial == 0)
{
$serial++;
$prev = $up;
$text = &edit_clip_page3 ($file_mime, $data, $prev, $path,
$serial, $delimiter, $text_tmp, $page_title);
$this = &get_clip_fname ($file_mime, "get");
}
else
{
$serial++;
$text = &edit_clip_page3 ($file_mime, $data, $prev, $path,
$serial, $delimiter, $text_tmp, $page_title);
open (FPAGE2, ">$path$path2$prev")
|| output_msg("POP-E019", "$path$path2$prev");
$text_old =~ s/\@next\@/$this/g;
print FPAGE2 $text_old;
close (FPAGE2);
}
$text_old = $text;
$prev = $this;
#マルチインデクス対応メタDBソースへエキスポート #2001/09/15修正 Maekawa
if ($xref ne "")
{
&add_xref($xref, $this_clip_dir, $date, $page, $catg, $region,
$this, $title, $yomi, $comment, $date2, $ext);
}
}
if ($serial >= 1)
{
open (FPAGE2, ">$path$path2$this")
|| output_msg("POP-E019", "$path$path2$this");
$text_old =~ s/\@next\@/$up/g;
print FPAGE2 $text_old;
close (FPAGE2);
}
$serial
}
#################################################
sub get_clip_fname #** MIME処理(clip) 映像クリップファイル名 98/04/11追加
#################################################
{
#ユニークモード:"(値なし)"(省略値)ユニーク化しないで返却、
#"chk"ユニークチェックをし新たな枝番を付けて返却、"get"ユニーク枝番を返却、
my ($file_mime, $umode) =@_; #02/04/24$mode(ユニーク処理モード)追加
my ($this, $mime);
$file_mime =~ s/\.html\#/-/i; # HTML部分指定への対応 2001/08 NANDRA
($this, $mime) = split (/\./, $file_mime);
#MIMEファイル重複時の処理 #02/04/24 Maekawa
if ($umode eq "chk") { $this = &chk_fname_unique ($this); }
else
{
if ($umode eq "get") { $this = &get_fname_unique ($this); }
}
$this =~ s/\//\-/g;
$this =~ s/\%20/_/g;
$this =~ s/ /_/g;
$this = $this . ".html";
$this;
}
#################################################
sub chk_fname_unique #** MIME処理(clip) MIMEファイル名重複チェック&枝番付加返却 #02/04/24 Maekawa
#################################################
{
my ($file_mime) =@_;
my ($protocol);
if ($GLIST_CLIP{$file_mime} eq "")
{ #MIMEファイル名の重複チェック
$GLIST_CLIP{$file_mime} = 1;
}
else
{
$protocol = &check_protocol ($file_mime);
unless ($protocol eq "yes" || $catg eq "エイリアス")
{
#ファイル名重複の時は重複数をHTMLファイル名に付加する。
$GLIST_CLIP{$file_mime} += 1;
#print "put $file_mime #$GLIST_CLIP{$file_mime}\n"; #<==
$file_mime .= "_$GLIST_CLIP{$file_mime}";
}
}
$file_mime
}
#################################################
sub get_fname_unique #** MIME処理(clip) MIMEファイル名枝番付加返却 #02/04/24 Maekawa
#################################################
{
my ($file_mime) =@_;
my ($protocol);
$protocol = &check_protocol ($file_mime);
unless ($protocol eq "yes" || $catg eq "エイリアス")
{
#ファイル名重複の時は重複数をHTMLファイル名に付加する。
#print "get $file_mime #$GLIST_CLIP{$file_mime}\n"; #<==
if ($GLIST_CLIP{$file_mime} >=2)
{
$file_mime .= "_$GLIST_CLIP{$file_mime}";
}
}
$file_mime
}
#################################################
sub edit_clip_page3 #** MIME処理(clip) 映像クリップ個別ページ編集 98/04/11モジュール分割
#################################################
# 修正 2003/02/07
{
my ($file_mime, $data, $prev, $path, $serial, $delimiter, $text_tmp,
$page_title) =@_;
my ($text, $text_old, $txtfile, $include_text, $char, $alttitle,
$file_mime_head, $date, $place, $title, $comment, $option,
$this, $mime, $form_tag, $file_map, $local_file_map, $file_html,
$serial_c, $star, $mime_chk, $clip_link, $clip_headline,
$clip_mark, $inline_img);
my ($machine, $fpath, $frpath, $opt_path, $tmp_path);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
$_ = $data;
if ($GCLIP_MARK ne "")
{
$clip_mark = $GCLIP_MARK;
}
else
{
$clip_mark = "\#";
}
$star = "★";
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option) =
split (/\t/, $_);
$date = &conv_date ($date);
#($this, $mime) = split (/\./, $file_mime);
$mime = &get_mime ($file_mime); # 2001/08 NANDRA
$this = &get_clip_fname ($file_mime, "get");
($clip_link, $clip_headline) = split (/\t/, $CLIP_OPT {$file_mime});
#97/09/15追加
$file_map = "";
# (2003/02/20)
$local_file_map = "$fpath" . "gif/map/$this" . ".gif";
$local_file_map = &conv_path ($local_file_map);
if (-e $local_file_map)
{
# (2003/02/20)
$file_map = "$frpath/gif/map/$this" . ".gif";
$file_map = "\n\n \n<\/center>\n";
}
$file_html = "$path$path2$this";
if ($GSTAR ne "")
{
$title =~ s/$star//g;
}
$text = $text_tmp;
if ($comment ne "")
{
$comment = &edit_tablequote ($comment);
}
if ($clip_link ne "")
{
$comment = $clip_link . "\n\n" . $comment;
} #99/11/07追加
$serial_c = &conv_num($serial,2);
if ($title ne "")
{
$text =~ s/\@title\@/$title/g;
}
else
{
if ($GCLIP_TITLE_SETTING eq "on")
{
if ($GCLIP_SEQNO eq "on")
{
$alttitle = "$page_title". "#" . "$serial_c";
$text =~ s/\@title\@/$alttitle/g;
}
else
{
$alttitle = "$page_title";
$text =~ s/\@title\@/$alttitle/g;
}
}
else
{
$text =~ s/\@title\@/$file_mime/g;
}
}
$mime_chk = "";
if ($mime eq "txt")
{
$mime_chk = "done";
# (2003/02/20)
$txtfile = "$fpath$mime$delimiter$file_mime";
$txtfile = &conv_path ($txtfile);
$include_text = &text_from_file ($txtfile, $mime, $option);
#$text =~
# s/\@include_data\@/ \ \\n\n$include_text\n\n\ | \<\/table\>\n/g;
#####=======================================
$text =~
s/\@include_data\@/ \\\\n\n$include_text\n\n\<\/td\>\<\/tr\>\<\/table\>\n/g;
}
if ($mime eq "html")
{
$mime_chk = "done";
# (2003/02/20)
$txtfile = "$fpath$mime$delimiter$file_mime";
$txtfile = &conv_path ($txtfile);
$include_text = &html_from_file ($txtfile, $mime, $option);
$text =~
s/\@include_data\@/ \\\n\n$include_text\n\n\ | \<\/table\>\n/g;
}
if ($mime eq "table")
{
$mime_chk = "done";
# ASWINODW (2003/02/20)
$txtfile = "$fpath$mime$delimiter$file_mime";
$txtfile = &conv_path ($txtfile);
$include_text = &table_from_file ($txtfile);
$text =~ s/\@include_data\@/$include_text\n\n/g;
}
if ($mime_chk ne "done")
{
$text =~ s/\@include_data\@/\@inline_img\@\n\ $GTXT7: \@date\@ \@place\@\ \n/g;
}
$text =~ s/\@serial\@/$clip_mark$serial_c/g;
$text =~ s/\@mapfile\@/$file_map/g;
$file_mime_head = substr ($file_mime, 0, 6);
if ($file_mime_head eq "_clip_")
{
#画像ファイル名未設定の場合 #99/09/27
$text =~ s/\@inline_img\@\n\ $GTXT7: \@date\@ \@place\@//g;
}
else
{
#画像ファイル名が設定されている場合
#02/01/23$path追加
$inline_img = &edit_imagelink ($path, $mime, $file_mime);
$text =~ s/\@inline_img\@/$inline_img/g;
}
$text =~ s/\@date\@/$date/g;
if ($date eq "")
{
$text =~ s/$GTXT7: //g;
}
$text =~ s/\@place\@/$place/g;
$add_option = $GCLIP_OPT{$file_mime}; #99/11/01追加
($add_option) = split (/\t/, $add_option);
if (add_option ne "")
{
$comment = $add_option . "" . $comment;
}
$text =~ s/\@comment\@/$comment/g;
$text =~ s/\@prev\@/$prev/g;
if ($GPULLDOWN eq "on")
{
$form_tag = &form_start;
$text =~ s/\@form_start\@/$form_tag/g;
$form_tag = &form_end;
$text =~ s/\@form_end\@/$form_tag/g;
}
$text = &replace_str ($text); #99/10/13
$text;
}
#################################################
sub make_folder_clip #** MIME処理(folder) ディレクトリ→clipリスト作成 97/06/20追加, 98/04/05, 98/10/02, 99/03/12修正
#################################################
{
my ($folder, $subfolder, $file_clip, $mime, $date, $place, $title,
$catg, $opt1, $title_head, $header) = @_;
# $catg以下を追加 #2001/12/10マスタクリップ1行目データ
# の付加項目
my (@allfiles, $this_file, $num, $num_c, $this_title, $path_file,
$delimiter, $title2, $option, $mime_chk, $char2, $this_file2,
@allfiles2, $check_path);
&machine;
$header = "01ファイル 02日付 03地域 04タイトル " .
"05コメント 06オプション "; #2001/12/10 Maekawa
$header .= "07時刻 08代替タイトル 09分類 10登録年月日 " .
"11トピックID 12トピックタイトル 13ヘッドライン " .
"14代表画(●)";
$delimiter = $GDELIMITER;
if ($place eq "non")
{
$place = "";
} #2001/09/24 Maekawa
#opendir (DIR, "$folder") || die "ディレクトリ$folderがありません。$!";
opendir (DIR, "$folder")
|| &output_msg ("POP-M006", $folder); #2002/05/06 NANDRA
@allfiles = readdir (DIR);
@allfiles = sort (@allfiles); #99/10/06追加
closedir (DIR);
if ($subfolder ne "")
{
$subfolder = "$subfolder" . "/";
}
$subfolder = &conv_delimiter ($subfolder); #00/03/16修正
$file_clip = &conv_path ($file_clip); #2001/09/24 Maekawa
$check_path = &path_file($file_clip); #2001/09/24 Maekawa
($check_path) = split (/\t/, $check_path); #2001/09/24 Maekawa
unless (-e $check_path)
{
&check_dir ($check_path);
} #2001/09/24 Maekawa
open (F_CLIP, ">$file_clip")
|| output_msg("POP-E010", $file_clip); #2002/05/06 NANDRA
print F_CLIP "#$header\n"; #2001/12/10 Maekawa
#if ($title_head ne "") {
# $title = $title_head; $title_head = "";
#} #02/01/11 Maekawa
$num = 0;
foreach $this_file (@allfiles)
{
next if ($this_file eq "Icon\n"); #01/03/20 Mac対応
$char = substr ($this_file, 0, 1);
next if ($char eq "\%" || $this_file eq "\."
|| $this_file eq "\.\.");
if (-d "$folder$delimiter$this_file")
{ #フォルダが2階層の場合
opendir (DIR2, "$folder$delimiter$this_file")
|| output_msg("POP-E020", "$folder$delimiter$this_file");
#2002/05/06 NANDRA
#"ディレクトリ$folder$delimiter$this_fileがありません
@allfiles2 = readdir (DIR2);
@allfiles2 = sort (@allfiles2); #99/10/06追加
closedir (DIR2);
foreach $this_file2 (@allfiles2)
{
next if ($this_file2 eq "Icon\n"); #01/03/20 Mac対応
$this_file2 =~ s/ /\%20/g;
$char2 = substr ($this_file2, 0, 1);
next if ($char2 eq "\%" || $this_file2 eq "\."
|| $this_file2 eq "\.\.");
$num++;
if ($mime eq "txt" || $mime eq "table")
{
#クリップ対象がテキストファイルの場合、
# #で始まる先頭行を抽出
($path_file) = split (/\./, $this_file2);
$path_file = "$folder$delimiter$this_file" .
"$delimiter$path_file.$mime";
($this_title, $date, $place, $option) =
split (/\t/, &get_clipinfo_from_text(
$path_file, $num));
}
else
{ #JPEG, GIFなどの場合
($path_file) = split (/\./, $this_file2);
$path_file = "$folder$delimiter$this_file" .
"$delimiter$path_file.$mime";
$num_c = &conv_num($num);
if ($title ne "")
{
$this_title = "$title\#$num_c";
}
}
$_ = $this_file2;
next if (not /\.$mime/);
if ($num == 1)
{ #2001/12/10 Maekawa
print F_CLIP "$subfolder$this_file/$this_file2" .
"\t$date\t$place\t$this_title\t\t$opt1\t\t" .
"\t$catg\t\t\t$title_head\n";
}
else
{
print F_CLIP "$subfolder$this_file/$this_file2" .
"\t$date\t$place\t$this_title\t\t$option\n";
}
}
}
else
{ #フォルダが1階層の場合
$num++;
$this_file =~ s/ /\%20/g;
if ($mime eq "txt" || $mime eq "table")
{
#クリップ対象がテキストファイルの場合、
# #で始まる先頭行を抽出
($path_file) = split (/\./, $this_file);
$path_file = "$folder$delimiter$path_file.$mime";
($this_title, $date, $place, $option) =
split (/\t/, &get_clipinfo_from_text (
$path_file, $num));
}
else
{ #JPEG, GIFなどの場合
$num_c = &conv_num($num);
if ($title ne "")
{
$this_title = "$title\#$num_c";
}
}
$_ = $this_file;
if (/\.$mime/)
{
if ($num == 1)
{ #2001/12/10 Maekawa
print F_CLIP "$subfolder$this_file\t$date\t" .
"$place\t$this_title\t\t$opt1\t\t\t" .
"$catg\t\t\t$title_head\n";
}
else
{
print F_CLIP "$subfolder$this_file\t$date\t" .
"$place\t$this_title\t\t$option\n";
}
}
}
}
close (F_CLIP);
}
#################################################
sub get_clipinfo_from_text #** テキスト・クリップ情報取得 99/03/12
#################################################
{
my ($path_file, $num) = @_;
my ($title, $date, $place, $option, $num_c, $this_title);
open (FTXTFILE2, "$path_file") || &output_msg ("POP-M005", $path_file); #2002/05/06 NANDRA
while ()
{
if (/^#/)
{
s/^#//;
chop;
($title, $date, $place, $option) = split (/\t/, $_);
if ($title ne "")
{
$this_title = "$title";
}
else
{
$num_c = &conv_num($num);
$this_title = "$title\#$num_c";
}
}
last;
}
close (FTXTFILE2);
"$this_title\t$date\t$place\t$option";
}
#################################################
sub copy_textclipfile #** クリップテキストファイルコピー #99/04/11
#################################################
{
my ($file_mime2, $mime2, $path) = @_;
my ($dir2, @dir3, $dir3, $i, $file_from, $file_to, $dir_num, $delimiter, $rtn);
my ($site, $fpath, $frpath, $opt_path, $tmp_path);
&machine;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
# (2003/02/21)
$dir2 = $fpath . $mime2 . $delimiter . "$GDIR_LSIZE";
$dir2 =~ s/\//$delimiter/g;
&check_dir($dir2);
@dir3 = split (/\//, $file_mime2);
$dir_num = @dir3;
$dir_num--;
for ($i=0; $i < $dir_num; $i++)
{
$dir2 .= "$delimiter$dir3[$i]";
&check_dir($dir2);
}
$i++;
#ファイルをコピー
# (2003/02/21)
$file_from = $fpath . $mime2 . $delimiter . $file_mime2;
$file_from =~ s/\//$delimiter/g;
# (2003/02/21)
$file_to = $file_mime = $fpath . $mime2 . $delimiter . "$GDIR_LSIZE" . $delimiter . $file_mime2;
$file_to =~ s/\//$delimiter/g;
if (-e $file_from)
{
$rtn = open (FILE_FROM, $file_from);
if ($rtn != 1) { $rtn = &output_msg("POP-M005", $file_from); close (FILE_FROM); return ""; } #2002/05/06 NANDRA
open (FILE_TO, ">$file_to") || output_msg("POP-E014", $file_to); #2002/05/06 NANDRA "$file_toの作成に失敗しました。
while () {print FILE_TO $_; }
close (FILE_FROM);
close (FILE_TO);
}
}
#################################################
sub check_protocol #** プロトコルチェック 98/03/14追加
#################################################
{
my ($url) = @_;
my ($protocol, $return);
$return = "";
($protocol) = split (/\:/, $url);
if ($protocol eq "http") { $return = "yes"; }
if ($protocol eq "ftp") { $return = "yes"; }
if ($protocol eq "mailto") { $return = "yes"; }
if ($protocol eq "gopher") { $return = "yes"; }
if ($protocol eq "archie") { $return = "yes"; }
if ($protocol eq "nntp") { $return = "yes"; }
if ($protocol eq "telnet") { $return = "yes"; }
if ($protocol eq "file") { $return = "yes"; } #2001/09/15 Maekawa
#02/04/22以下を追加
if ($protocol eq "rtsp") { $return = "yes"; }
if ($protocol eq "nntp") { $return = "yes"; }
if ($protocol eq "https") { $return = "yes"; }
$return
}
#==================================================================
#** Part 6:初期データ作成の省力化ツール
#==================================================================
#################################################
sub make_clip_db #** 初期DBソース&クリップファイル生成 #2001/09/24 Maekawa
#################################################
# $site サイトのフォルダ名
# $site_t サイトのタイトル
# $path サイトのローカルパス
# $mime MIMEタイプ(画像形式)
# $folder MIMEファイル(画像)の格納フォルダ名
# $catg 分類インデクスキー
# $rgn 地域インデクスキー
# $title_head 生成ページの仮のタイトル先頭
# $date 撮影年月日(yyyy/mm/dd)
# $clip_num 1ページ当たりのクリップ数
# $master マスタフォルダ名
# $db_file マスタのDBソースファイル名
# $add_pattern 追加DBソースの追加パターン(省略値"add_to_bottom")
{
my ($site, $site_t, $path, $mime, $folder, $catg, $rgn, $title_head,
$date, $clip_num, $master, $db_file, $add_pattern) = @_;
my ($add_db, $imgclip_sw, $folder2, $folder3, $clipfile, $update,
$file_add, $file_db);
my ($machine, $delimiter, $fpath, $frpath, $opt_path, $tmp_path);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
if ($site ne "")
{
$GSITE = $site;
}
else
{
output_msg("POP-E021");
} #2002/05/06 NANDRA "サイトフォルダ名を指定して下さい
if ($path eq "")
{
output_msg("POP-E022");
} #2002/05/06 NANDRA "ローカルパスを指定して下さい
if ($folder eq "")
{
output_msg("POP-E023");
} #2002/05/06 NANDRA "MIME格納フォルダ名を指定して下さい
#&set_default($path);
if ($mime eq "")
{
$mime = "jpg";
}
if ($clip_num eq "")
{
$clip_num = 20;
}
if ($master eq "")
{
$master = "master";
}
if ($db_file eq "")
{
$db_file = $site . ".db";
}
if ($add_pattern eq "")
{
$add_pattern = "add_to_bottom";
}
$GPATH_LOCAL = "$path$GDELIMITER";
$add_db = "add.db";
$file_add = "$path$GDELIMITER$master$GDELIMITER$add_db";
$file_add = &conv_path($file_add);
$file_db = "$path$GDELIMITER$master$GDELIMITER$db_file";
$file_db = &conv_path($file_db);
$imgclip_sw = $GIMAGECLIP;
$GIMAGECLIP = "off";
$folder2 = "$fpath$GDELIMITER$mime$GDELIMITER$folder";
$folder2 = &conv_path($folder2);
$folder3 = &conv_path($folder);
$clipfile = "$fpath$GDELIMITER" . "clip" . $opt_path .
"$GDELIMITER$folder.clip";
$clipfile = &conv_path($clipfile);
$update = &getdate2("/");
#画像フォルダのクリップファイルを生成
&make_folder_clip ($folder2, $folder3, $clipfile, $mime, $date, $rgn, "");
#クリップファイルからDBソースを生成
&make_dbdata($clipfile, $file_add, $site_t, $catg, $rgn, $folder,
$date, $update, $title_head, $clip_num);
$GIMAGECLIP = $imgclip_sw;
#生成したDBソースをマスタのDBソースに追加
&filemerge($file_add, $file_db, $add_pattern);
}
#################################################
sub make_clip_dbdata #** クリップ&DB初期データ作成 #99/09/26
#どうもmake_clip_dbと殆ど差がないのでそのうち没にします! #2001/09/24 Maekawa
#################################################
{
my ($site, $site_t, $path, $mime, $folder, $date, $catg, $place,
$title, $num, $imageclip) = @_;
my ($clipfile, $mimefolder, $dbfile, $datafile, $update, $delimiter);
my ($fpath, $frpath, $opt_path, $tmp_path);
&machine;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
$site = $GSITE;
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter";
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
# (2003/02/20)
#$clipfile = "$fpath$delimiter" . "clip$opt_path$delimiter$folder.clip";
$clipfile = &getClipAbsPath($path, $site, "$folder.clip"); #03/07/13 Maekawa
$mimefolder = "$path$delimiter$mime$opt_path$delimiter$folder";
$dbfile = "$path$delimiter". "master$delimiter" . "add.db";
$datafile = "$path$delimiter". "master$delimiter" . "last.dat";
$clipfile = &conv_path ($clipfile); #00/03/07修正
$mimefolder = &conv_path ($mimefolder); #00/03/07修正
$dbfile = &conv_path ($dbfile); #00/03/07修正
$datafile = &conv_path ($datafile); #00/03/07修正
$update = &getdate2("/");
&make_folder_clip
($mimefolder, $folder, $clipfile, $mime, $date, $place, "");
&make_dbdata($clipfile, $dbfile,
$site_t, $catg, $place, $folder, $date, $update, $title, $num);
open (FOUT, ">$datafile")
|| output_msg("POP-E014", $datafile);
print FOUT "$clipfile\n";
print FOUT "$dbfile\n";
close FOUT;
}
#################################################
sub make_dbdata #** DB初期データ作成 #98/10/25
#################################################
{
my ($clipfile, $addfile, $site, $catg, $region, $folder, $date,
$update, $title, $num, $num_max) = @_;
my ($text);
$text = &edit_dbdata ($clipfile, $site, $catg, $region, $folder,
$date, $update, $title, $num, $num_max);
open (FADD, ">$addfile") || output_msg("POP-E014", $addfile);
print FADD "$text";
close (FADD);
}
#################################################
sub edit_dbdata #** DB初期データ編集 #98/10/25, 00/07/11修正
#################################################
{
my ($clipfile, $site, $catg, $region, $folder, $date, $update,
$title, $num, $new_label) = @_;
my ($text, $page_no, $this_img, $cnt, $cntall, $first, $numc,
$folderc, $region2);
$folder = &conv_delimiter ($folder); #00/03/16修正
$num_head = 0;
$num_bottom = $num_head + $num -1;
if ($region ne "")
{
$resion2 = $region;
}
else
{
$region = "non"; $resion2 = "";
} #2001/09/24 Maekawa
$text = "#-----------------------------------\n";
$text .= "# $catg:$title #$update\n";
$text .= "#-----------------------------------\n";
open (FCLIP, "$clipfile") || output_msg("POP-E007", "sub:edit_dbdata $clipfile");
$cntall = $page_no = 0;
while ()
{
$cnt++; $cntall++;
($this_img) = split (/\t/, $_);
if ($cnt == 1)
{
$page_no++;
$first = $this_img;
}
if ($cnt >= $num)
{
$folderc = $folder; #00/04/23
$folderc =~ s/\//\-/g; #00/04/23
$cnt = 0;
$text .= "■$site\n";
if ($new_on eq "on")
{
$text .= "$GNEWINFO,";
} #00/07/11
$text .= "$catg\n";
$text .= "$region \n";
if ($page_no < 10)
{
$numc = "0" . "$page_no";
}
else
{
$numc = "$page_no";
}
$text .= "$folderc-$numc\n";
$text .= "$title#$numc\n";
$text .= "non\n";
$text .= "$update\n";
$text .= "headline \n";
$text .= "$first $date $region2\n"; #2001/09/24 Maekawa
$text .= "tablequote \n";
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on")
{
$text .= "imageclip ";
}
$text .= "$folder.clip $first $this_img\n";
$text .= "\n";
}
}
if ($cnt >= 1)
{
$folderc = $folder; #00/04/23
$folderc =~ s/\//\-/g; #00/04/23
$text .= "■$site\n";
if ($new_on eq "on")
{
$text .= "$GNEWINFO,";
} #00/07/11
$text .= "$catg\n";
$text .= "$region \n";
if ($page_no < 10)
{
$numc = "0" . "$page_no";
}
else
{
$numc = "$page_no";
}
$text .= "$folderc-$numc\n";
$text .= "$title#$numc\n";
$text .= "non\n";
$text .= "$update\n";
$text .= "headline \n";
$text .= "$first $date $region2\n"; #2001/09/24 Maekawa
$text .= "tablequote \n";
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on")
{
$text .= "imageclip ";
}
$text .= "$folder.clip $first $this_img\n";
$text .= "\n";
}
close (FCLIP);
output_msg("UTL-A001", $clipfile, $page); #2002/05/06 NANDRA
$text
}
#################################################
sub clipmaster2clip #** マスタクリップ→クリップ生成 99/03/09追加, #01/05/03 $img_markを追加
#################################################
{
my ($clipmaster_file, $newclip_file,$interval_sec, $page_title) = @_;
my ($clippath, $delimiter, $char, $file_mime, $date, $region, $title,
$comment, $option, $time, $title_alt, $catg, $update,
$file_mime_old, $date_old, $region_old, $title_old, $comment_old,
$option_old, $time_old, $title_alt_old, $catg_old, $update_old,
$old, $num_done, $cnt_all, $tno_old, $tno_c, $ano_old, $ano_c,
$title_c, $catg_c, $add_catg, $img_mark, $img_mark_old, $page_id,
$page_id_old, $page_title_old, $clip_headline, $clip_headline_old);
$cnt_all = $num_done = $tno_old = $ano_old = 0;
open (FIN, "$clipmaster_file") || output_msg("POP-E007", "sub:clipmaster2clip $clipmaster_file");
open (FOUT, ">$newclip_file") || output_msg("POP-E010", $newclip_file);
if ($GS_VERSION_TEXT ne "")
{
$GALT_LABEL = $GS_VERSION_TEXT;
}
if ($GS_VERSION eq "on") { # Lサイズ版処理
if ( $GALT_LABEL eq "")
{
$add_catg = " $GALT_LABEL\=";
}
else
{
$add_catg = "$GALT_LABEL\=";
}
}
else
{
$add_catg = "";
}
while ()
{
last if (/^END/);
next if (/^#/); #01/05/03追加
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $region, $title, $comment,
$option, $time, $title_alt, $catg, $update, $page_id,
$page_title, $clip_headline, $img_mark) = split (/\t/, $_);
next if ($file_mime eq "");
next if ($title eq "−" || $title eq "--" || $title eq "-"); #01/05/03
$cnt_all++;
if ($cnt_all == 1)
{ #データ1件目の処理
#1件目のデータの退避
$file_mime_old = $file_mime;
$date_old = $date;
$region_old = $region;
$title_old = $title;
$comment_old = $comment;
$option_old = $option;
$time_old = $time;
$title_alt_old = $title_alt;
$catg_old = $catg;
if ($update eq "")
{
$update = &getdate2("/");
}
$update_old = $update;
$page_id_old = $page_id;
$page_title_old = $page_title;
$option_old = $option;
$clip_headline_old = $clip_headline;
$img_mark_old = $img_mark;
}
else
{ #データ2件目以降の処理
if ($date eq "")
{
$date = $date_old;
}
if ($region eq "")
{
$region = $region_old;
}
if ($title eq "")
{
$title = $title_old;
}
if ($option eq "")
{
$option = $option_old;
} #01/05/03追加
if ($update eq "")
{
$update = $update_old;
}
if ($page_title eq "")
{
$page_title = $page_title_old;
} #01/05/03追加
if ($time eq "")
{
$time = &get_next_time ($date_old, $date, $time_old, $file_mime_old, $file_mime, $interval_sec);
}
if ($catg eq "")
{
$catg = $catg_old;
}
#タイトルの設定
if ($title_alt_old ne "")
{
#代替タイトルが設定されている場合
if ($title_alt_old eq $title_alt)
{
#代替タイトルが連続している(後に続いている)場合
$ano_old++;
$ano_c = &conv_num ($ano_old);
$title_c = $title_alt_old . "#$ano_c";
}
else
{
#代替タイトルが1つ、または複数件の最後の場合
if ($title_alt_old ne $title_alt)
{
$ano_old++;
$ano_c = &conv_num ($ano_old);
if ($ano_old == 1)
{
$title_c = $title_alt_old;
}
else
{
$title_c = $title_alt_old . "#$ano_c";
}
$ano_old = 0;
}
}
}
else
{
#代替タイトルがない場合(タイトルを出力)
if ($title_old ne "")
{ #01/05/03条件追加
$ano_old = 0;
$tno_old++;
$tno_c = &conv_num ($tno_old);
$title_c = $title_old . "#$tno_c";
}
else
{ #01/05/03追加
$title_c = "";
}
}
#クリップ出力
$catg_c = "$add_catg$catg_old";
print FOUT "$file_mime_old\t$date_old $time_old\t$region_old\t" .
"$title_c\t$comment_old\t$option_old\t$time_old\t" .
"$title_alt_old\t$catg_c\t$update_old\t$page_id_old\t" .
"$page_title_old\t$clip_headline_old\t$img_mark_old\n";
if ($title_old ne $title)
{
$tno_old = 0; #タイトル連番の初期化
}
#1件前のデータの退避
$file_mime_old = $file_mime;
$date_old = $date;
$region_old = $region;
$title_old = $title;
$comment_old = $comment;
$option_old = $option;
$time_old = $time;
$title_alt_old = $title_alt;
$catg_old = $catg;
$update_old = $update;
$page_id_old = $page_id;
$page_title_old = $page_title;
$option_old = $option;
$img_mark_old = $img_mark;
$clip_headline_old = $clip_headline;
}
}
$tno_old++;
$tno_c = &conv_num ($tno_old);
if ($title_old ne "")
{
$title_c = $title_old . "#$tno_c";
}
else
{
$title_old = "";
} #01/05/03追加(バグ修正)
$catg_c = "$add_catg$catg_old";
print FOUT "$file_mime_old\t$date_old $time_old\t$region_old\t" .
"$title_c\t$comment_old\t$option_old\t$time_old\t$title_alt_old\t" .
"$catg_c\t$update_old\t$page_id_old\t$page_title_old\t" .
"$clip_headline_old\t$img_mark_old\n";
output_msg("UTL-A002", $cnt_all, $newclip_file); #2002/05/06 NANDRA
close (FIN);
close (FOUT);
}
#################################################
sub mclip2db #** マスタクリップ→新規DBソース&クリップファイル生成 #2001/12/10 Maekawa
#################################################
#【機能】
#マスタクリップからクリップファイルと新規DBソース(ファイル名add.db)を自動生成する。
#DBソースファイルが指定されている場合は新規DBソースを追加書きする。
#【引数】
# $site サイトのフォルダ名(必須)
# $site_t サイトのタイトル(省略可)=なるべく省略しないように!
# $path サイトのローカルパス(必須)
# $mclip マスタクリップファイル名(必須)
# $clipname クリップファイル名
# $clip_num 1ページ当たりのクリップ数(省略値20)
# $master マスタフォルダ名(省略値"master")
# $db_file 追加書きするマスタのDBソースファイル名(省略の場合は追加書きしない)
# $add_pattern 追加DBソースの追加パターン"add_to_top", "add_to_bottom"のいずれか(省略値"add_to_bottom")
#【返却値】なし
{
my ($site, $site_t, $path, $mclip, $clipname, $clip_num, $master,
$db_file, $add_pattern) = @_;
my ($db_add, $path_mclip, $path_clip, $path_db_add, $path_db_file);
&machine;
$db_add = "add.db";
if ($master eq "")
{
if ($GMASTER eq "")
{
$master = "master";
}
else
{
$master = "$GMASTER";
}
}
if ($clip_num eq "")
{
$clip_num = 20;
}
#$path_mclip = "$fpath" . "clip$GDELIMITER$mclip";
#$path_clip = "$path" . "clip$GDELIMITER$clipname";
#$path_mclip = "$fpath" . "clip$GDELIMITER$site$GDELIMITER$mclip";
$path_mclip = &getClipAbsPath($path, $site, "$mclip"); #03/07/13 Maekawa
#$path_clip = "$fpath" . "clip$GDELIMITER$site$GDELIMITER$clipname";
$path_clip = &getClipAbsPath($path, $site, "$clipname"); #03/07/13 Maekawa
$path_db_add = "$path$master$GDELIMITER$db_add";
$path_db_file = "$path$master$GDELIMITER$db_file";
$path_mclip = &conv_path($path_mclip);
$path_clip = &conv_path($path_clip);
$path_db_add = &conv_path($path_db_add);
$path_db_file = &conv_path($path_db_file);
$clipname = &conv_delimiter($clipname);
#print "1)$path_mclip\n 2)$path_clip\n 3)$path_db_add\n " .
# "4)$path_db_file\n 5)$clipname\n"; <==
#引数:マスタクリップ,クリップファイル
&clipmaster2clip ($path_mclip, $path_clip);
#追加するテンポラリDBソースを空っぽに
&fileinit("$path_db_add");
#クリップ→DBデータ作成
&make_dbdata_x($path_clip, $clipname, $path_db_add, $site_t, $clip_num);
if ($db_file ne "")
{
if ($add_pattern eq "")
{
$add_pattern = "add_to_bottom";
}
&filemerge($path_db_add, $path_db_file, $add_pattern);
}
}
#################################################
sub folders2mclip #** マルチフォルダ→マスタクリップ生成 #2001/12/10#03/07/13 Maekawa
#################################################
# $site サイトのフォルダ名
# $site_t サイトのタイトル
# $path サイトのローカルパス
# $mime MIMEタイプ(画像形式)
# $folders_list MIMEファイル(画像)の格納フォルダ名のリスト(カンマ区切り)
# $mclip マスタクリップファイル名
# $catg 分類インデクスキー
# $rgn 地域インデクスキー
# $opt1 オプションインデクス1キー
# $date 撮影年月日(yyyy/mm/dd)
# $title_head トピックタイトル先頭部
{
my ($site, $site_t, $path, $mime, $folders_list, $mclip, $catg, $rgn,
$opt1, $date, $title_head) = @_;
my ($clipname, $db_add, $imgclip_sw, $folder, $folder2, $folder3,
$update, $file_add, $file_db, $tmpfile, @folders, $check_path);
my ($machine, $delimiter, $fpath, $frpath, $opt_path, $tmp_path);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
# 拡張版の多階層ディレクトリ等に対応 (2003/02/20)
# $fpath は filesディレクトリを含むパス。
# $frpath は filesディレクトリを含む相対パス。(UNIX形式)
# $opt_pathはサイト毎のクリップファイル格納パス
# ディレクトリチェック追加(03/03/12)
if ($site eq "") { $site = $GSITE; } #03/07/13 Maekawa
$tmp_path = "$path" . "files"; #2003/03/15 Maekawa
if ($GENHANCED ne "" || -e $tmp_path)
{
$fpath = "$path" . "files$delimiter"; #2003/03/15 Maekawa
$frpath = "../files";
$opt_path = "$delimiter$site";
}
else
{
$fpath = "$path";
$frpath = "..";
$opt_path = "";
}
if ($site ne "")
{
$GSITE = $site;
}
else
{
#2002/05/06 NANDRA "サイトフォルダ名を指定して下さい
output_msg("POP-E021");
}
if ($path eq "")
{
#2002/05/06 NANDRA "ローカルパスを指定して下さい
output_msg("POP-E022");
}
if ($folders_list eq "")
{
#2002/05/06 NANDRA "MIME格納フォルダ名を指定して下さい
output_msg("POP-E023");
}
#&set_default($path);
if ($mime eq "")
{
$mime = "jpg";
}
if ($clip_num eq "")
{
$clip_num = 20;
}
if ($master eq "")
{
$master = "master";
}
if ($db_file eq "")
{
$db_file = $site . ".db";
}
if ($add_pattern eq "")
{
$add_pattern = "add_to_bottom";
}
$folders_list =~ s/ //g;
$folders_list =~ s/\t//g;
$folders_list =~ s/\"//g;
@folders = split (/,/,$folders_list);
$GPATH_LOCAL = "$path";
$db_add = "add.db";
$file_add = "$path$master$GDELIMITER$db_add";
$file_add = &conv_path($file_add);
$file_db = "$path$master$GDELIMITER$db_file";
$file_db = &conv_path($file_db);
# (2003/02/20)
#$tmpfile = "$fpath" . "clip" . $opt_path . "$GDELIMITER" . "add.clip";
#$tmpfile = &conv_path($tmpfile);
$tmpfile = &getClipAbsPath($path, $site, "add.clip");
$clipname = $mclip;
# (2003/02/20)
#$mclip = "$fpath" . "clip" . $opt_path . "$GDELIMITER" . "$mclip";
#$mclip = &conv_path($mclip);
$mclip = &getClipAbsPath($path, $site, "$mclip");
#生成するクリップファイルを初期化
$check_path = &path_file ($mclip, 2);
($check_path) = split (/\t/, $check_path);
&check_dir ($check_path);
&fileinit ($mclip);
$imgclip_sw = $GIMAGECLIP;
$GIMAGECLIP = "off";
$update = &getdate2("/");
#画像フォルダのクリップファイルとDBソースを生成
foreach $folder (@folders)
{
$folder2 = "$fpath$mime$GDELIMITER$folder";
$folder2 = &conv_path($folder2);
$folder3 = &conv_path($folder);
&make_folder_clip ($folder2, $folder3, $tmpfile, $mime, $date,
$rgn, "", $catg, $opt1, $title_head);
#生成したテンポラリクリップをクリップファイルに追加
&filemerge($tmpfile, $mclip, $add_pattern);
}
}
#################################################
sub folders2mclip2db #** マルチフォルダ→マスタクリップ→DBソース生成 #2002/01/04 Maekawa
#################################################
# $site サイトのフォルダ名
# $site_t サイトのタイトル
# $path サイトのローカルパス
# $mime MIMEタイプ(画像形式)
# $folders_list MIMEファイル(画像)の格納フォルダ名のリスト(カンマ区切り)
# $mclip マスタクリップファイル名
# $clipfile クリップファイル名
# $catg 分類インデクスキー
# $rgn 地域インデクスキー
# $opt1 オプションインデクス1キー
# $date 撮影年月日(yyyy/mm/dd)
# $title_head トピックタイトル先頭部
# $clip_num 1ページ当たりのクリップ数(省略値20)
# $master マスタフォルダ名(省略値"master")
# $db_file 追加書きするマスタのDBソースファイル名(省略の場合は追加書きしない)
# $add_pattern 追加DBソースの追加パターン"add_to_top", "add_to_bottom"のいずれか(省略値"add_to_bottom")
{
my ($site, $site_t, $path, $mime, $folders_list, $mclip, $clipfile,
$catg, $rgn, $opt1, $date, $title_head, $clip_num, $master,
$db_file, $add_pattern) = @_;
#マスタクリップ生成
&folders2mclip($site, $site_t, $path, $mime, $folders_list, $mclip,
$catg, $rgn, $opt1, $date, $title_head);
#マスタクリップからクリップファイル&DBソース生成
&mclip2db ($site, $site_t, $path, $mclip, $clipfile, $clip_num,
$master,$db_file, $add_pattern);
}
#################################################
sub div_clip #** クリップデータ間引き処理 99/03/10追加
#################################################
{
my ($clip_file, $new_clip_file,$num) = @_;
my ($cnt, $char, $file_mime, $date, $place, $title, $comment,
$option, $old, $num_done, $cnt_all);
open (FIN, $clip_file) || output_msg("POP-E009", $clip_file);
open (FOUT, ">$new_clip_file") || output_msg("POP-E010", $new_clip_file);
$cnt = $num_done = 0;
while ()
{
last if (/^END/);
$cnt++;
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $place, $title, $comment, $option) =
split (/\t/, $_);
next if ($file_mime eq "");
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
if ($cnt == 1)
{
print FOUT "$_\n"; $num_done++; $cnt_all++;
}
else
{
$cnt_all++;
if ($cnt == $num) { $cnt = 0; }
}
$old = $_;
}
#2002/05/06 NANDRA
output_msg("UTL-A003", $num, $num_done, $cnt_all, $new_clip_file);
close (FIN);
close (FOUT);
}
#################################################
sub make_dbdata_x #** DB初期データ作成x #99/03/10追加
#################################################
{
my ($clipfile, $clipname, $addfile, $site, $num_max, $site_title_option,
$add_idx) = @_;
my ($text);
$text = &edit_dbdata_x ($clipfile, $clipname, $site, $num_max,
$addfile, $site_title_option, $add_idx);
#2002/05/06 NANDRA "$addfileの作成に失敗しました
open (FADD, ">$addfile") || output_msg("POP-E014", $addfile);
print FADD "$text";
close (FADD);
}
#################################################
sub edit_dbdata_x #** DB初期データ編集x #99/03/10追加 99/09/09修正
#################################################
{
my ($clipfile, $clipname, $site, $num_max, $addfile, $site_title_option,
$add_idx) = @_;
my ($text, $catg_no, $this_img, $cnt, $cnt_all, $first, $numc, $file_mime,
$date, $region, $title, $comment, $option, $time, $title_alt, $catg,
$update, $file_mime_old, $date_old, $region_old, $title_old,
$update_old, $comment_old, $option_old, $time_old, $title_alt_old,
$catg_old, $catg_c,$dummy, $today, $char, $datex, $num_head,
$num_bottom, $num, $folder, $page_seq_noc, $page_seq_no,
$clip_headline, $img_mark, $sel_img, $page_id, $page_title,
$page_id_old, $page_title_old, $first_option, $first_page_id,
$first_comment);
$num_head = 0;
$num_bottom = $num_head + $num -1;
$text = "";
$today = &getdate2("/");
$clipname =~ s/\:/\//g; $clipname =~ s/\\/\//g; #01/05/03追加
($folder) = split (/\./, $clipname);
$folder =~ s/\//-/g; #01/05/03追加
open (FCLIP, "$clipfile") || output_msg("POP-E007", "sub:edit_dbdata_x $clipfile");
$cnt = $cnt_all = 0;
$catg_no = 1;
$page_seq_no = 1;
if ($site_title_option ne "")
{
$site .= $site_title_option;
}
while ()
{
last if (/^END/);
$char = chop;
if ($char ne "\n")
{
$_ = $_ . $char;
}
($file_mime, $date, $region, $title, $comment, $option, $time,
$title_alt, $catg, $update, $page_id, $page_title, $clip_headline,
$img_mark) = split (/\t/, $_);
next if ($file_mime eq "");
next if (/^#/ || $title eq "−" || $title eq "--" || $title eq "-");
($datex) = split (/ /, $date);
$cnt++; $cnt_all++;
if ($cnt_all == 1)
{ #データ1件目の処理
#1件目のデータの退避
$first = $file_mime_old = $file_mime;
$first_option = $option_old = $option;
$first_page_id = $page_id_old = $page_id;
$first_comment = $comment_old = $comment;
$date_old = $datex;
$region_old = $region;
$catg_old = $catg;
if ($update eq "")
{
$update = $today;
}
else
{
if ($update eq "\@\@today\@\@")
{
$update = $today;
}
}
$update_old = $update;
$page_title_old = $page_title;
$cnt=0;
$text .= "#-----------------------------------\n";
$text .= "# $catg:$title #$update\n";
$text .= "#-----------------------------------\n";
}
else
{#データ2件目以降の処理
if ($cnt == 1)
{
$first = $file_mime_old;
$first_option = $option_old;
$first_page_id = $page_id_old;
$first_comment = $comment_old;
}
if ($catg_old ne $catg || $region_old ne $region || $date_old ne $datex || $page_title_old ne $page_title || $cnt >= $num_max)
{
$cnt = 0;
$numc = &conv_num ($catg_no);
$page_seq_noc = &conv_num ($page_seq_no,2);
($dummy, $catg_c) = split (/\=/, $catg_old);
if ($catg_c eq "")
{
$catg_c = $dummy
}
$text .= "■$site\n";
#if ($update_old eq $today && $update_old ne "00/00/00"
#&& $update_old ne "0000/00/00") #01/05/03 条件なしに変更
#{
# $text .= "$GNEWINFO,$catg_old\n";
#}
#else
#{
if ($add_idx ne "")
{
$text .= "$add_idx,";
}
$text .= "$catg_old\n";
#}
$text .= "$region_old \n";
if ($catg_no < 10)
{
$numc = "0" . "$catg_no";
}
else
{
$numc = "$catg_no";
}
if ($first_page_id eq "")
{
$text .= "$folder-$page_seq_noc\n";
}
else
{#99/09/09修正
$text .= "$first_page_id\n";
}
if ($page_title_old eq "")
{
$text .= "$catg_c#$numc\n";
}
else
{ #99/09/09修正
$text .= "$page_title_old\n";
}
if ($first_option eq "")
{
$text .= "non\n";
}
else
{ #99/09/09修正
$text .= "$first_option\n";
}
$text .= "$update_old\n";
$text .= "headline \n";
if ($sel_img eq "")
{
$sel_img = $first;
} #01/05/03追加
$text .= "$sel_img $date_old $region_old\n";
if ($first_comment eq "")
{
$text .= "tablequote \n";
}
else
{
$text .= "tablequote $first_comment\n";
}
$first_comment = "";
if ($first ne $file_mime_old)
{
#クリップが2件以上の場合 #99/09/10修正
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on")
{
$text .= "imageclip ";
}
$text .= "$clipname $first $file_mime_old\n";
}
else
{
#クリップが1件の場合
unless ($GCLIP_GENERATE eq "no")
{
#クリップページ生成指定がnoでないなら
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on")
{
$text .= "imageclip ";
}
$text .= "$clipname $first $file_mime_old\n";
}
}
$text .= "\n";
$page_seq_no++;
if ($catg_old eq $catg)
{
$catg_no++;
}
else
{
$catg_no = 1;
}
$sel_img = ""; #01/05/03追加
}
}
#1件前のデータの退避
$file_mime_old = $file_mime;
$date_old = $datex;
$region_old = $region;
$catg_old = $catg;
$update_old = $update;
$page_id_old = $page_id;
$page_title_old = $page_title;
$option_old = $option;
if ($first_option eq "" && $option_old ne "")
{
$first_option = $option_old;
}
$comment_old = $comment;
if ($first_comment eq "" && $comment_old ne "")
{
$first_comment = $comment_old;
}
if ($img_mark ne "")
{
$sel_img = $file_mime;
} #01/05/03追加
}
if ($cnt >= 1)
{
$cnt = 0;
$numc = &conv_num ($catg_no);
$page_seq_noc = &conv_num ($page_seq_no,2);
($dummy, $catg_c) = split (/\=/, $catg_old);
if ($catg_c eq "") { $catg_c = $dummy};
$text .= "■$site\n";
#if ($update_old eq $today && $update_old ne "00/00/00"
#&& $update_old ne "0000/00/00") #01/05/03 条件なしに変更
#{
# $text .= "$GNEWINFO,$catg_old\n";
#}
#else
#{
if ($add_idx ne "")
{
$text .= "$add_idx,";
}
$text .= "$catg_old\n";
#}
$text .= "$region_old \n";
if ($catg_no < 10)
{
$numc = "0" . "$catg_no";
}
else
{
$numc = "$catg_no";
}
if ($first_page_id eq "")
{
$text .= "$folder-$page_seq_noc\n";
}
else
{
$text .= "$first_page_id\n";
}
if ($page_title_old eq "")
{
$text .= "$catg_c#$numc\n";
}
else
{ #99/09/09修正
$text .= "$page_title_old\n";
}
if ($first_option eq "")
{
$text .= "non\n";
}
else
{ #99/09/09修正
$text .= "$first_option\n";
}
$text .= "$update_old\n";
$text .= "headline \n";
if ($sel_img eq "")
{
$sel_img = $first;
} #01/05/03追加
$text .= "$sel_img $date_old $region_old\n";
if ($first_comment eq "")
{
$text .= "tablequote \n";
}
else
{
$text .= "tablequote $first_comment\n";
}
if ($first ne $file_mime_old)
{
#クリップが2件以上の場合 #99/09/10修正
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on")
{
$text .= "imageclip ";
}
$text .= "$clipname $first $file_mime_old\n";
}
else
{ #クリップが1件の場合
unless ($GCLIP_GENERATE eq "no")
{
#クリップページ生成指定がnoでないなら
#クリップページを生成する
$text .= "subtitle 映像クリップ\n";
if ($GIMAGECLIP eq "on") { $text .= "imageclip "; }
$text .= "$clipname $first $file_mime_old\n";
}
}
$text .= "\n";
}
close (FCLIP);
output_msg("UTL-A004", $page_seq_no, $cnt_all, $addfile);
$text
}
#################################################
sub get_next_time #** クリップ次時刻返却 99/03/09追加
#################################################
{ #工事中関数
my ($date_old, $date, $time_old, $file_mime_old, $file_mime,
$interval_sec) = @_;
my ($dummy, $time_data, $folder1, $folder2, $mins1, $mins2, $seqno1,
$seqno2, $hh, $mm, $ss, $nexttime);
""
}
#################################################
sub filetrans #** ファイル・文字列置換 99/01/02追加
#################################################
#使用例
# require 'popcorn.pl';
# &filetrans ("mmdb:mmy:kasumigaura:master:kasumigaura.db",
# "mmdb:mmy:kasumigaura:master:kasumi-new.db",
#"■マッピング霞ヶ浦", "■マッピング霞ヶ浦\*");
{
my ($fname1, $fname2, $word1, $word2) = @_;
if ($word1 eq "")
{
#2002/05/06 NANDRA "変換前の文字列が未設定です
output_msg("UTL-E001");
}
if ($word2 eq "")
{
#2002/05/06 NANDRA "変換後の文字列が未設定です
output_msg("UTL-E002");
}
open (FILE_FROM, $fname1) || output_msg("UTL-E003", $fname1);
open (FILE_TO, ">$fname2") || output_msg("UTL-E004", $fname2);
while ()
{
s/$word1/$word2/g;
print FILE_TO $_;
}
close (FILE_TO); close (FILE_FROM);
}
#################################################
sub arrange_metatags #** METAタグアレンジ 01/08/14追加(NANDRA)
#################################################
#第一引数:階層
# 1:トップ 2:総合インデクス 3:個別インデクス 4:ページ 5:クリップ
#第二引数:インデクス種別
# cat,region,date,update,idx_opt1のどれか
#参照するG変数
# $GVERSION:バージョン番号
# $GCHARSET:キャラクタセット(デフォルトは'Shift_JIS')
# $GROBOT_TAG:ロボット抑止タグ
# $GROBOT_EXCLUSION_LEVEL:ロボット抑止レベル
# $GROBOT_INCLUSION_*(ロボット制限を緩和)
#戻り値:METAタグの入った文字列
#現在対応しているMETAタグ:キャラクタセット、GENERATOR、ROBOT抑制
{
my ($kaiso, $idx_type) = @_;
my ($text, $robot_flg);
## キャラクタセット
$text = "\n";
}
else
{
$text .= $GCHARSET . "\">\n";
}
## GENERATORタグ
$text .= "\n";
## PAGERANKタグ(PopCorn独自:デバッグ用に作成)
#$text .= "\n";
## ROBOT抑制タグ制御(EXCLUSION)
$robot_flg = "off";
if ($GROBOT_EXCLUSION_LEVEL == 1)
{
# 全て制限
$robot_flg = "on";
}
elsif ($GROBOT_EXCLUSION_LEVEL == 2)
{
# トップページのみ対象外
if ( $kaiso > 1 )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 3)
{
# 各インデクスのトップまで対象外
if ( $kaiso > 2 )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 4)
{
# 分類インデクスまで対象外
if ( $kaiso > 3 )
{
$robot_flg = "on";
}
elsif ( $kaiso == 3 && $idx_type ne "cat" )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 5)
{
# 分類インデクス配下のページまで対象外
if ( $kaiso > 4 )
{
$robot_flg = "on"
}
elsif ( $kaiso >= 3 && $idx_type ne "cat" )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 6)
{
# 分類インデクス配下のクリップまで
if ( $kaiso > 2 && $idx_type ne "cat" )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 7)
{
# 他のインデクスまで対象外
if ( $kaiso > 3 )
{
$robot_flg = "on";
}
}
elsif ($GROBOT_EXCLUSION_LEVEL == 8)
{
# 他のインデクス配下のページまで対象外
if ( $kaiso > 4 )
{
$robot_flg = "on";
}
}
## ROBOT抑制タグ制御(INCLUSION)
if ( $kaiso == 3 )
{
# 分類インデクス
if ( $GROBOT_INCLUSION_CAT eq "on" && $idx_type eq "cat" )
{
$robot_flg = "off";
}
# 地域インデクス
if ( $GROBOT_INCLUSION_REGION eq "on" && $idx_type eq "region" )
{
$robot_flg = "off";
}
# 撮影日インデクス
if ( $GROBOT_INCLUSION_DATE eq "on" && $idx_type eq "date" )
{
$robot_flg = "off";
}
# 登録日インデクス
if ( $GROBOT_INCLUSION_UPDATE eq "on" && $idx_type eq "update" )
{
$robot_flg = "off";
}
# オプションインデクス1
if ( $GROBOT_INCLUSION_IDX_OPT1 eq "on" && $idx_type eq "idx_opt1" )
{
$robot_flg = "off";
}
}
# 分類インデクス配下のページ
if ( $GROBOT_INCLUSION_PAGE eq "on" && $kaiso == 4
&& $idx_type eq "cat" )
{
$robot_flg = "off";
}
# 全てのインデクス配下のページ
if ( $GROBOT_INCLUSION_PAGE_ALL eq "on" && $kaiso == 4 )
{
$robot_flg = "off";
}
# 分類インデクス配下のクリップ
if ( $GROBOT_INCLUSION_CLIP eq "on" && $kaiso == 5
&& $idx_type eq "cat" )
{
$robot_flg = "off";
}
# 実際にROBOTタグを挿入
if ( $robot_flg eq "on" )
{
$text .= $GROBOT_TAG . "\n";
}
$text;
}
#==================================================================
#** Part 7:デバッギング
#==================================================================
#################################################
sub debug_assoc #** 連想配列の表示 98/02/07追加
#################################################
{
my (%assoc) = @_;
foreach (sort keys %assoc)
{
print "$_=$assoc{$_}\n";
}
}
#################################################
sub debug_array #** 配列の表示 99/03/13追加
#################################################
{
my (@arr) = @_;
my ($rec);
foreach $rec (@arr)
{
print "$rec\n";
}
}
#################################################
sub conv_db_freebsd #** DBソース変換(FreeBSD対応) 00/03/10追加
#################################################
{
my ($file_in, $file_out) = @_;
my ($no);
open (IN, $file_in) || die "$file_inをオープンできませんでした。$!";
open (OUT, ">$file_out") || die "ファイル$file_outの作成に失敗しました。$!";
$no = 0;
while ()
{
last if (/^END/);
next if /^#/;
if (/^■/ || /^\*\*/)
{
#カラム1:ページ名
$no = 1;
s/\n/ \n/; print OUT $_;
}
else
{
next if /^#/;
$no = $no + 1;
if ($no == 2)
{
#カラム2:分類
s/\n/ \n/; s/\,/ \,/g; print OUT $_;
}
if ($no == 3)
{
#カラム3:地域
s/\n/ \n/; s/\,/ \,/g; s/\t/ \t/g; print OUT $_;
}
if ($no == 4)
{
#カラム4:ファイル名…
print OUT $_;
}
if ($no == 5)
{
#カラム5:タイトル
s/\n/ \n/; print OUT $_;
}
if ($no == 6)
{
#カラム6:よみ
if (/non\n/ || /\n/)
{
print OUT $_;
}
else
{
s/\n/ \n/;
print OUT $_;
}
}
if ($no == 7)
{
#カラム7:登録年月日
print OUT $_;
}
if ($no >= 8)
{
if (/^\n/)
{
#空白行がデータ1件の区切り
print OUT $_;
}
else
{
#マクロタグ+MIMEタイプに対応したDBソースの
#各データ8行目以降の扱い
if (/[a-zA-Z0-9][a-zA-Z0-9]\n/ || /\t\n/)
{
print OUT $_;
}
else
{
s/\n/ \n/;
s/\,/ \,/g;
print OUT $_;
}
}
}
}
}
close (IN); close (OUT);
}
#################################################
sub conv_key_freebsd #** インデクスキー変換(FreeBSD対応) 00/03/10追加
#################################################
{
my ($file_in, $file_out) = @_;
my ($no, $this, @list);
open (IN, $file_in) || die "$file_inをオープンできませんでした。$!";
open (OUT, ">$file_out") || die "ファイル$file_outの作成に失敗しました。$!";
while ()
{
last if (/^END/);
next if /^#/;
if (/^■/ || /^\*\*/)
{
#カラム1:ページ名
@list = split (/\t/, $_);
$no = 1;
foreach $this (@list)
{
if ($no == 1)
{
print OUT "$this ";
}
else
{
print OUT "\t$this";
}
$no++;
}
}
else
{
if (/^□/ || /^\/\//)
{
s/\n/ \n/;
print OUT $_;
}
}
}
close (IN); close (OUT);
}
#################################################
#最上川フォーラムコンテンツ作成(RSS連携対応)
sub rss_generate
#新規作成
#################################################
{
my ($path, $file_in, $sub, $keyitem, $url_disp) = @_;
my ($date, $page, $catg, $region, $xy, $url, $title,
$yomi, $comment, $date2, $ext, $this_page_dir);
my (@records, @records2, $record, $record2, $delimiter, $machine, $file_page,
$str1, $str2, $str3, $str4, $str5, $str6, $str7, $str8, $dir);
&machine;
$machine = $GMACHINE;
$delimiter = $GDELIMITER;
$site = $GSITE;
$this_page_dir = &get_atom($keyitem, "PAGE_DIR");
$dir = $path . "$this_page_dir";
&check_dir ($dir);
$file_in = $path . $GMASTER . $delimiter . $file_in;
#rss用リストファイル読み込み
open (FIN, $file_in) || output_msg("POP-E007", "sub:rss_generate $file_in");
while ($_ = ) {
push (@records, $_);
}
close (FIN);
foreach $record (@records)
{
($date, $page, $catg, $region, $xy, $url, $title, $yomi, $comment, $date2) = split (/\t/, $record);
if ($catg eq $GNEWINFO ) {
next;
}
$GL_IDX++; #add(by mogamigawa RSS)
if ($GL_IDX eq 1 ) { #add(by mogamigawa RSS)
#(分類ページTOP画面URL)
$GL_TPAGE = $delimiter."index.html"; #add(by mogamigawa RSS)
#(サイト名)
$GL_PAGE = $page; #add(by mogamigawa RSS)
$GL_PAGE =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
}
#(個別ページURL)
$GL_LINK[$GL_IDX] = $delimiter . $this_page_dir . $delimiter . "$url$ext.html"; #add(by mogamigawa RSS)
#(登録日)
$GL_DATE[$GL_IDX] = $date; #add(by mogamigawa RSS)
$GL_DATE[$GL_IDX] =~ s/\//-/g; #add(by mogamigawa RSS)
#(トピックのタイトル)
$GL_TITEL[$GL_IDX] = $title; #add(by mogamigawa RSS)
$GL_TITEL[$GL_IDX] =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
@records2 = split (/$GRET_CODE/, $comment);
foreach $record2 (@records2) {
($str1, $str2, $str3, $str4, $str5, $str6, $str7, $str8) =
split (/$GTAB_CODE/, $record2);
#*.ml, *.clip $str1:ファイル, $str2:先頭, $str3:最終, $str4,
#$str5, $str6 *.jpg/gif/au/mov $str1:ファイル, $str2:撮影日,
#$str3:場所, $str4:タイトル, $str5:ヘッドライン, $str6
#マクロタグ指定時の処理
if ($str1 eq "text") {
$GL_TEXT[$GL_IDX] = $str2; #add(by mogamigawa RSS)
$GL_TEXT[$GL_IDX] =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
}
if ($str1 eq "tablequote" && $str2 ne "") {
$GL_tablequote[$GL_IDX] = $str2; #add(by mogamigawa RSS)
$GL_tablequote[$GL_IDX] =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
}
if ($str1 eq "quote" && $str2 ne "") {
$GL_quote[$GL_IDX] = $str2; #add(by mogamigawa RSS)
$GL_quote[$GL_IDX] =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
}
if ($str1 eq "subtitle") {
$GL_subtitle[$GL_IDX] = $str2; #add(by mogamigawa RSS)
$GL_subtitle[$GL_IDX] =~ s/]]>/]]>/g; #add(by mogamigawa RSS)
}
}
}
$GL_MAX = $GL_IDX; #add(by mogamigawa RSS)
}
#################################################
#最上川フォーラムコンテンツ作成(RSS連携対応)
sub rss_write
#新規作成
#################################################
{
my ($path , $indexkey) = @_;
#変数宣言
my ($site,$delimiter,$out_file_nm,$idx,$max,$ans1);
my ($page,$link,$titel,$discription,$date,$publisher,$creater,$tpage);
my ($url_path , $out_path);
if ( $G_PUB_FLG eq "on" ) {
$url_path = $G_URL_PUB;
} else {
$url_path = $G_URL;
}
$site = $GSITE;
$delimiter = $GDELIMITER;
$tpage = $url_path . $GL_TPAGE;
$page = $GL_PAGE;
if ( $indexkey eq 'cat' ) {
$out_file_nm = "$path$site.rss.xml";
} else {
$out_file_nm = "$path$site-$indexkey.rss.xml";
}
$max = $GL_MAX+1;
#output is 10records
if ( $max > 10 ) {
$ans1 = $max - 10;
} else {
$ans1 = 1;
}
open (RPAGE, ">$out_file_nm");
print RPAGE "\n";
print RPAGE "\n";
print RPAGE "\n";
print RPAGE "$tpage\n";
print RPAGE "\n";
print RPAGE "\n";
print RPAGE "\n";
#ここはループ
for ($idx = $ans1; $idx < $max; $idx++)
{
$link = $url_path . $GL_LINK[$idx];
print RPAGE "\n";
}
print RPAGE "\n";
print RPAGE "\n";
print RPAGE "\n";
#ここはループ
for ($idx = $ans1; $idx < $max; $idx++)
{
$link = $url_path . $GL_LINK[$idx];
print RPAGE "- \n";
$titel = $GL_TITEL[$idx];
print RPAGE "\n";
$link = $url_path . $GL_LINK[$idx];
print RPAGE "$link\n";
if ( $GL_tablequote[$idx] ne "" ) {
$decscription = $GL_tablequote[$idx];
} elsif ( $GL_text[$idx] ne "" ) {
$decscription = $GL_text[$idx];
} elsif ( $GL_quote[$idx] ne "" ) {
$decscription = $GL_quote[$idx];
} elsif ( $GL_subtitle[$idx] ne "" ) {
$decscription = $GL_subtitle[$idx];
} else {
$decscription = "";
}
print RPAGE "\n";
$date = $GL_DATE[$idx];
print RPAGE "$date\n";
print RPAGE "$GPUBLISHER\n";
print RPAGE "$GPERSON\n";
print RPAGE "
\n";
}
print RPAGE "\n";
close (RPAGE);
}
#==================================================================
#** Part 8:ヒアドキュメント
#==================================================================
#################################################
sub topconf_def #** デフォルト topconf.dat 定義
# 2002/05/06 NANDRA 新規
#################################################
{
return << "END_OF_TOPCONF";
#######################################################################
# topconf.dat デフォルト(Ver2002.0506以降用) 2002/05/06
#######################################################################
#←(このように行頭が#マークになっている行はコメント行です)
##▼メインサイトへのリンク…
## ページ左上と下中央に、親サイトへのリンクを張ることができます。
## src属性を設定すればバナー画像も入ります(widthとheightでサイズ指定)
RetBtn.text=PopCorn
RetBtn.href=http://www.mmdb.net/popcorn/
#RetBtn.src=gif/banar_w.gif
#RetBtn.width=80
#RetBtn.height=23
#RetBtn.border=0
##▼トップ画像
## srcには画像ファイル名(PopCornルートフォルダからの相対パス)
## widthとheightには画像サイズ、textには説明文を設定します
## ※ レイアウト上、600*110ピクセル程度の横長画像をお勧めします
#topimage.src=jpg/600_110.jpg
#topimage.width=600
#topimage.height=110
#topimage.text=トップ画像
##▼トップ解説タイトル
## 灰色地の部分に入る文字列を指定します
welcome_msg.text=このトップページの仕上げ方法
##▼トップ解説
INFO1.text= このトップページにある各種の記述は、master フォルダにある topconf.dat ファイル(テキストファイル)で定義されています。これをテキストエディタで編集して、サイトの再生成を行なえば、その変更が反映されます。
INFO2.text=
INFO3.text=
##▼「内容に関するお問い合わせ」
INFO4.text=このサイトの構\築には、Multimedia Mapping支援/生涯学習支援ツール「PopCorn」を使用いたしました
INFO5.text=PopCornについてはこちらのサイトをご覧下さい
INFO5.href=http://www.mmdb.net/popcorn/
##▼「サイト担当者」
INFO6.text=担当者名(またはグループ名)
INFO6.bold=yes
INFO7.text=担当者の連絡先メールアドレス
INFO7.href=mailto:
END_OF_TOPCONF
}
#################################################
sub tophtml_def #** デフォルト雛形HTML定義
# 2002/05/06 NANDRA 新規
#################################################
{
return << "END_OF_TOPHTML";
END_OF_TOPHTML
}
#################################################
sub output_msg_list #** 出力メッセージリスト
# 2002/05/06 NANDRA 新規
#################################################
{
return << "END_OF_MSGLIST";
#=====================================================================
# 出力メッセージリスト(popcorn.pl中にヒアドキュメントとして記述)
#=====================================================================
# ・先頭が#マークの行は注釈行です
# ・書式は1メッセージ1行で、メッセージID[TAB]メッセージとします
# ・パラメータ付きのメッセージの場合、メッセージ本文中に%1,%2...を
# 埋め込めば、そこにパラメータ文字列が自動挿入されます
#
# ※メッセージIDのルール
# ・例 POP-E001
# ・ハイフンの前の英字3桁がPOPだとPopCornを示す
# ・ハイフン直後の英字1桁:
# E…エラー(処理途中で強制終了をひきおこすもの)
# M…問題あり(処理は継続されるもの。いわゆるWarning)
# A…案内(エラーやWarningではない、正常な案内メッセージ)
# ・6〜8桁目:連番(順不同)
# ただし、ここが999の場合は、該当メッセージ番号が無かった
# 場合のデフォルトメッセージとします
#=====================================================================
#-----「エラー」メッセージのリスト
POP-E001 ディレクトリ %1 がありません。ディレクトリの作成もできませんでした。
POP-E002 サイト名を\$GSITEに設定して下さい。
POP-E003 タイトルを\$GTITLEに設定して下さい。
POP-E004 インデクスのキーを\@GINDEX_KEYに設定して下さい。
POP-E005 当フォルダのパスを\$GPATH_LOCALに設定して下さい。
POP-E006 \$GPATH_LOCALまたは\$GPATH_SERVERが設定されていません
POP-E007 %1をオープンできませんでした。
POP-E008 リスト%1の作成に失敗しました。
POP-E009 クリップファイル%1をオープンできませんでした。
POP-E010 クリップファイル%1の作成に失敗しました。
POP-E011 入力ファイルが設定されていません。
POP-E012 HTMLソースファイル%1の作成に失敗しました。
POP-E013 HTML個別ページ%1の作成に失敗しました。
POP-E014 %1の作成に失敗しました。
POP-E015 %1の初期化に失敗しました。
POP-E016 %1への追加書きに失敗しました。
POP-E017 %1の書き込みに失敗しました。
POP-E018 テキスト(またはHTML)ファイル %1 の中に %2 という章はありませんでした。
POP-E019 HTML個別クリップページ%1の作成に失敗しました。
POP-E020 ディレクトリ %1 がありません
POP-E021 サイトフォルダ名を指定して下さい
POP-E022 ローカルパスを指定して下さい
POP-E023 MIME格納フォルダ名を指定して下さい
POP-E999 %1 は未定義のメッセージIDです(プログラムミスの可能\性が高いので、開発者に連絡してください)
#
#-----「問題あり」メッセージのリスト(アラートメッセージ)#2004/01/24メッセージを日本語化
POP-M001 言語設定ファイル %1.dat が見つかりません。デフォルト言語版(日本語)としてページ生成を実行します
POP-M002 おやおや。カードIDが重複していますよ。重複IDは %1 です。先頭から: %2 番目です。
POP-M003 次のカードIDのタイトルを付けてください。 カードID:%1 。先頭から %2 番目のカードです。
POP-M004 おやおや。カードIDが未定義です。先頭から %1 番目のカードです。
POP-M005 次のファイルがありません。ファイル名: %1
POP-M006 次のフォルダが見つかりません。フォルダ名: %1
POP-M007 HTMLファイル %1 のBODYタグが一対になっていません。BODY部抽出処理を省略します
#2004/01/24 追加 Maekawa
POP-M008 フォルダ種別"%1"に対応するサイトフォルダIDを定義してください。フォルダIDは英数字で"cat", "rgn"などとします。
POP-M009 フォルダ種別"%1"に対応するフォルダ名を定義してください。フォルダ名の例:カテゴリフォルダ、地域フォルダ、…
POP-M010 フォルダ種別"%1"に対応するフォルダ名略称を定義してください。略称の例:カテゴリ、地域、…
POP-M011 フォルダ名を定義して下さい。仮の名前を "%1" としました。
POP-M012 フォルダ名「%1」の略称を定義してください。
POP-M013 フォルダ名「%1」のIDを定義してください。
#-----「案内」メッセージのリスト
POP-A001 PopCorn (ver. %1): %2 - Started at %3 %4
POP-A002 popcorn.pl => %1 \\t %2...done
POP-A003 Number of clips: %1
POP-A004 Finished : %1 - at %2 %3 (ps time %4)
POP-A010 Created a new directory: %1
#-----小道具サブルーチン(サイト自動生成に直接関わらないsub)専用メッセージ
# (メッセージの先頭には該当するサブルーチン名を入れて下さい)
UTL-E001 [filetrans] 変換前の文字列が未設定です
UTL-E002 [filetrans] 変換後の文字列が未設定です
UTL-E003 [filetrans] %1をオープンできませんでした
UTL-E004 [filetrans] %1の作成に失敗しました
UTL-A001 [popcorn.pl\'edit_dbdata] => %1: \\t %2...done
UTL-A002 [popcorn.pl\'clipmaster2clip] => %1...done (%2)
UTL-A003 [popcorn.pl\'div_clip] (by %1) => %2 of %3...done (%4)
UTL-A004 [popcorn.pl\'edit_dbdata_x] => %1 pages, %2 clips ...done (%3)
#=====================================================================
END_OF_MSGLIST
}
1
| | | | | | |
---|