#! /usr/bin/perl # # profile2.cgi # # 2.025 : 6/30/08 : サムネイル削除を修正 # 2.024 : 6/4/08 : NGワード機能を追加 # 2.023 : 4/29/08 : 名前検索のバグを修正 # 2.022 : 12/22/07 : 画像アップロード枚数制限機能を追加 # 2.021 : 12/2/07 : 縮小画像自動作成機能を追加 # 2.020 : 8/5/07 : 入力項目に編集不可の項目指定オプションを追加 # 2.019 : 6/18/07 : 登録者リストのフォームを修正 # 2.018 : 1/16/07 : 登録名重複チェックオプションを追加 # 2.017 : 12/20/06 : 検索をCase Insensitiveに修正 # 2.016 : 11/21/06 : パスワード変更処理を修正 # 2.015 : 11/16/06 : 検索機能を追加 # 2.014 : 6/29/06 : 携帯モードでの画像アップロード機能を削除 # 2.013 : 6/28/06 : 画像ファイルが無い場合の処理を修正 # 2.012 : 6/21/06 : 管理人モードでのパスワードチェックを修正 # 2.011 : 6/1/06 : 登録名チェック、携帯モード書き込み説明追加 # 2.010 : 5/1/06 : $prdirを自動作成するように変更 # 2.009 : 4/24/06 : 携帯モードリンクを追加 # 2.008 : 4/23/06 : 携帯モードを追加 # 2.007 : 4/6/06 : 最大投稿数制限機能を追加 # 2.006 : 1/23/06 : 画像以外のファイルのアップロード処理を追加 # 2.005 : 1/8/06 : 画像ファイルの処理を修正 # 2.004 : 1/7/06 : タイプミスを修正 # 2.003 : 1/6/06 : MIME encodeを修正。削除のバグを修正。 # 2.002 : 11/23/05 : タイプミスを修正 # 2.001 : 11/19/05 : サポートしてない画像も表示するように修正 # 2.0 : 11/16/05 : Modified from profile.cgi # # http://www.hidekik.com/ # # $Id: profile2.cgi,v 1.44 2008/06/30 15:53:31 Hideki Kanayama Exp $ # Copyright(c) 2003-2008, Hideki Kanayama, All rights reserved. # use strict; use CGI qw(:cgi-lib); use CGI::Carp qw(fatalsToBrowser); use File::Copy; use File::Basename; use POSIX; use GD; use Jcode; my $admindat = "adminpwd.dat"; my $setupfile = "profile_setup.pl"; my $version = "2.025"; my $lastmodifiedyear = "2008"; my $lang = 0; my $charset = ("Shift_JIS","ISO-8859-1")[$lang]; my $script = basename($0); #### 環境設定 ###### ここから ############ our $prdir = "data"; our $prfile = "$prdir/profile.lst"; our $dellog = "$prdir/delete.lst"; our $lockfile = "$prdir/lockfile.lck"; # バックグラウンド設定 # Background設定 # 1:画像を使う 0:カラー番号を使う our $bgimage_en = 0; our $bgimagefile = "$prdir/sample.jpg"; our $bgcolor="#ffffff"; #テーブルのバックグラウンド 1: on, 0: off our $table_bgcolor_en = 0; our $table_bgcolor = '#ffffff'; #名前欄の色 our $namebgcolor='lightblue'; #タイトル our $title_logo_en = 0; our $title_logo = ''; our $title = 'プロファイル'; our $title_color='blue'; our $regtitle_logo_en = 0; our $regtitle_logo = ''; our $regtitle = 'プロファイル登録'; our $regtitle_color='blue'; our $edititle_logo_en = 0; our $edititle_logo = ''; our $edititle = 'プロファイル修正'; our $edititle_color='blue'; our $register_title_logo_en = 0; our $register_title_logo = ''; our $register_title = '新規登録'; our $setup_title_logo_en = 0; our $setup_title_logo = ''; our $setup_title = '管理用'; #トップへのリンク 1: on 0:off our $toplink_en = 1; our $toplink_logo_en = 0; our $toplink_logo = ''; our $toplink_title = 'トップへ'; our $toplink_link = "../profile.html"; #登録者リスト表示 0:非表示 1:上に表示 2:下に表示 3:別ウィンドウに表示 4:別ページに表示 our $list_display = 0; our $list_logo_en = 0; our $list_logo = ''; our $list_title = '登録者リスト'; #携帯モードリンク表示 1:on 0:off our $mobilelink_en = 1; our $mobile_logo_en = 0; our $mobile_logo = ''; our $mobile_title = '携帯モード'; #サーチリンク表示 1:on 0:off our $searchlink_en = 1; our $search_logo_en = 0; our $search_logo = ''; our $search_title = '検索'; #携帯モード説明表示 1:on 0:off our $mobileusage_en = 0; #登録者リストの一行に表示される人数 our $list_cols = 5; #表示順 0:最新順 1:古い順 our $disp_order = 0; #記事更新時の表示順 0:登録順 1:更新順 our $reorder = 1; #削除機能 1: on, 0: off our $delete_en = 1; #管理人セットアップ表示 1: on, 0: off our $setup_en = 1; #登録リンク表示 1:on 0:off our $regform_en = 1; #管理人オンリーモード 1:on, 0:off our $admin_only_en = 0; #重複登録名チェック 1:on, 0:off our $regnamecheck_en = 1; #最終更新表示 1: on, 0: off our $lastupdate_en = 1; our $lastupdate = 'Last Update : '; our $lastupdate_color = '#3333ff'; our $lastupdate_form = '1'; #各記事更新表示 1: on, 0: off our $eachupdate_en = 1; our $eachupdate = '更新時間'; our $eachupdate_form = '1'; #登録修正フォームの1行目 our $item = '項目'; our $item_color = 'black'; our $item_bgcolor = 'lightblue'; our $contents = '内容'; our $contents_color = 'black'; our $contents_bgcolor = 'lightblue'; #項目欄の文字位置 our $item_lr = 0; # 0:左 1:中 2:右 our $item_ud = 1; # 0:上 1:中 2:下 #お名前の項目名 our $name_in = 'お名前'; #パスワード項目名 our $passitem = 'パスワード'; #修正ボタン名 our $editbutton = '修正する'; #削除ボタン名 our $deletebutton = '削除する'; #アイテムの最大数 our $itemmaxnum = 9; #1度にアップできる画像の最大数 our $picmaxnum = 6; #アップできる合計画像数制限 1:有効 0:無効 our $pic_total_max_en = 0; our $pic_total_max = 6; #1ページ表示制限 1:on 0:off our $pagedisp_en = 0; #1ページ表示件数 our $pagedispnum = 10; #最大投稿制限 1:on 0:off our $postmax_en = 0; our $postmax = 100; # 次ページ前ページリンク名 our $prev_icon_en = 0; our $next_icon_en = 0; our $prev_icon = ''; our $next_icon = ''; our $prevpage = '←前ページ'; our $nextpage = '次ページ→'; our $prev_loc = 0; our $next_loc = 2; our $first_icon_en = 0; our $first_icon = ''; our $firstpage = '最初に戻る'; #入力項目のデフォルト、最大$itemmaxnum項目(デフォルト9) our @item_value = ('家族構成','生年月日','最近の出来事'); #編集禁止入力項目数(最初のいくつ) 0:全て編集可能 our $no_item_edit = 0; # 画像ファイルの最大表示の大きさ(単位:ピクセル) # → これを超える画像は縮小表示します our $max_width = 150; # 横幅 our $max_height = 150; # 縦幅 #最大画像アップサイズ(kB) our $maxmb = 300; #縮小画像自動作成 1:on 0:off our $thumb_gen_en = 1; our $thumb_dir = 'prthumb'; #携帯モード画像ファイルサイズ制限 (KB) our $mob_image_size = 25; #携帯モード画像フォーマット 0:jpg 1:gif 2:png our $mob_image_format = 1; #一人がアップできる合計ファイルサイズ制限 1:on 0:off our $size_check_en = 1; #一人がアップできる合計ファイルサイズ(kB) our $allocated_size = 300; #画像クリック時 1: 同じウィンドウ 0: 別ウィンドウ our $samewin_en = 1; #画像表示位置 0:左 1:中 2:右 our $pic_loc = 1; #表示テーブルのサイズ(パーセント) our $table_width = 60; #項目欄のサイズ(パーセント) our $item_width = 20; #テーブルのレイアウト our $table_layout_en = 0; our $bordercolor = '#000000'; our $table_border = 1; our $cellpadding = 1; our $cellspacing = 1; #書き込みテキストエリアのサイズ our $textarea_cols = 50; our $textarea_rows = 3; #各記事ごとの
ライン 1:on 0:off our $hr_en = 1; #本文中のリンクを文字列に置き換える 1:on 0:off our $link_replace_en = 1; our $link_replace = 'リンクはこちら'; our $link_replace_top_en = 0; # NGワード our $ngword = 'url'; #メール送信 1:on 0:off our $reg_mail_en = 0; our $up_mail_en = 0; our $del_mail_en = 0; our $reg_mail_title = 'profile.cgi -- 登録情報'; our $up_mail_title = 'profile.cgi -- 更新情報'; our $del_mail_title = 'profile.cgi -- 削除情報'; our $mail_contents = 'profile.cgiが更新されました。'; our $to_mail = 'admin@yourdomain.com'; our $from_mail = 'admin@yourdomain.com'; our $mail_cmd = '/usr/sbin/sendmail -t'; #メンバー専用パスワード 1:on 0:off our $member_only = 0; our $member_pwd = '12345'; #〜内に挿入できる構文 1:on, 0:off our $head_insert_en = 0; our $head_insert = ''; #スタイルシート 1:on 0:off our $style_sheet_en = 1; our $style_sheet = ' A:link {text-decoration: none} A:visited {text-decoration: none} A:active {text-decoration: none} '; #書き込みの注意事項 our $usage = ' '; #時間設定 our $localtime_en = 0; our $offset_from_gmt = 9; #トップからのSSI表示による更新時間のための予備のアップデートファイル # 1: on, 0: off our $update1_file_en = 0; our $update2_file_en = 0; our $update1_file = "$prdir/update1.log"; our $update2_file = "$prdir/update2.log"; #### 環境設定 ###### ここまで ############ if (-e "$setupfile"){ require "$setupfile"; } my $url_pattern = 'https?:\/\/[\w\.\~\/\?\&\+\=\:\@\%\;\#\$\%\-]*'; if ($maxmb < 100) {$maxmb = 100;} my $maxmb2 = $maxmb + 20; # Margin for text up size $CGI::POST_MAX = $maxmb2 * 1024; my $q = new CGI; my $cgierror = $q->cgi_error; &error($cgierror) if ($cgierror); my %in = $q->Vars; %in = &postprocess(%in); if ($script eq 'prmobile.cgi'){ $script = 'profile2.cgi'; $in{mode} = 'mobile'; } my $table_bgcolor2; if ($table_bgcolor_en == 1){ $table_bgcolor2 = "bgcolor = $table_bgcolor"; } else { $table_bgcolor2 = ''; } my @mobext = qw(jpg gif png); if (! -e "$admindat"){ if ($in{mode} eq 'adminpwd'){ &wradminpwd; } else { &setadminpwd; } } if ($in{mode} eq 'register'){ ®ister; } elsif ($in{mode} eq 'edit'){ &edit; } elsif ($in{mode} eq 'iregform'){ &iregform; } elsif ($in{mode} eq 'regform'){ if ($admin_only_en == 1 && $in{pwd} eq ''){ $in{next} = 'regform'; &setup; } else { ®form; } } elsif ($in{mode} eq 'editform'){ &editform; } elsif ($in{mode} eq 'setup'){ &setup; } elsif ($in{mode} eq 'setform'){ &setform; } elsif ($in{mode} eq 'setupwrite'){ &setupwrite; } elsif ($in{mode} eq 'list_display' or $in{mode} eq 'mobile'){ &list_display; } elsif ($in{mode} eq 'iread'){ &iread; } elsif ($in{mode} eq 'read'){ &display; } elsif ($in{mode} eq 'schform'){ &schform; } elsif ($in{mode} eq 'search'){ &search; } else { if ($list_display == 3){ &frameset; } else { &display; } } sub postprocess { my %in = @_; my ($key,$value); while (($key,$value)=each %in){ if ($key !~ /upfile\d+_pic/){ $value =~ s//>/g; my $br = "
"; $value =~ s/\r\n/$br/g; $value =~ s/\n/$br/g; $value =~ s/\r/$br/g; $value =~ s/,/&\#44;/g; $in{"$key"}=$value; } } return (%in); } sub frameset { print $q->header(-type=>'text/html',-charset=>$charset); print < $title END } ################ 登録 ####################### sub register { my $count; my $datecode; my $regname; my @dum; my @countlist; my @countlist2; my @regnamelist; if (open(REGFILE,"< $prfile")){ while (){ ($count,$datecode,$regname,@dum)=split(/,/); push(@countlist,$count); push(@regnamelist,"$regname"); } close(REGFILE); @countlist2 = sort {$a <=> $b} @countlist; $count = $countlist2[$#countlist2] + 1; } else { $count = 1; } my $regs = $#countlist2 + 1; if ($regs >= $postmax and $postmax_en) { &error("$postmax件以上は登録できません。"); } if ($in{'yourname'} eq "") { &error("名前を入れてください。"); } if ($regnamecheck_en){ foreach (@regnamelist){ &error("$in{'yourname'}はすでに登録されています。") if ("$in{yourname}" eq "$_"); } } if ($in{'pwd'} eq "") { &error("パスワードを入れてください。"); } if ($admin_only_en == 1 && (! &checkadmin($in{pwd}))){ &error("管理人オンリーモードなので管理人のみ書き込みができます。"); } if ($member_only == 1 && ("$in{member_pwd}" ne "$member_pwd")){ &error('メンバー専用パスワードが違います。'); } &check_ngword; if (! -d "$prdir") { mkdir "$prdir"; # &error("データディレクトリ$prdirが存在しません。"); } my $fname; my $fileterm; my $upcom; my $filecomterm; my $picnum; &pic_total_max_check(0); foreach $picnum (1 .. $picmaxnum){ my $uppic = "upfile${picnum}_pic"; $fname = &upload_file($count,$picnum); $fileterm = $fileterm . "$uppic" . '=' . "$fname" . '<>'; $upcom = "upfile${picnum}_com"; $filecomterm = $filecomterm . "$upcom" . '=' . "$in{$upcom}" . '<>'; } my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=mylocaltime(time); my $update = sprintf("%s_%s_%s_%02s_%02s",$year+1900,$mon+1,$mday,$hour,$min); my $encpwd = &makecrypt($in{pwd}); &lockfile; open(DAT,">> $prfile") or &error("データを$prfileに書き込めません。"); print DAT "$count,$update,$in{yourname},$encpwd,$fileterm,$filecomterm"; foreach $a (1 .. $itemmaxnum){ my $tmpa = "item${a}_key"; my $tmpb = "item${a}_elem"; print DAT ",$in{$tmpa}<>$in{$tmpb}"; } print DAT "\n"; close(DAT); &unlockfile; chmod(0666,"$prfile"); &extraupdate; &mailnotice("$reg_mail_title","$in{yourname}","$update") if ($reg_mail_en == 1); &go_disp; } sub check_ngword { my @nglist = split /,/, $ngword; foreach my $a (1 .. $itemmaxnum){ my $tmpa = "item${a}_key"; my $tmpb = "item${a}_elem"; foreach my $ng (@nglist){ if ($in{$tmpa} =~ /\b$ng\b/i or $in{$tmpb} =~ /\b$ng\b/i){ &error("NGワードが含まれています。"); } } } } sub go_disp { if ($in{use} eq 'mobile'){ print "Location: $script?mode=iread\n\n"; } else { print "Location: $script\n\n"; } } sub upload_file { my ($count,$picnum )= @_; my $uppic = "upfile${picnum}_pic"; next if ($in{$uppic} eq ""); my $origfile = basename($in{$uppic}); $origfile =~ s/^.*[\/\\]([^\/\\]+)$/$1/; #just in case if ("$origfile" !~ /^[\w\._\-]+$/) { my $message = ("$origfile:アップ後のファイル名は半角英数で。","file name only allows alphabetical characters and _, ., -.")[$lang]; &error($message); } my $fname="$count-$picnum-$origfile"; my $outfile = "$prdir/$fname"; my $fh = $q->upload($uppic); my $cgierror = $q->cgi_error; &error($cgierror) if (!$fh && $cgierror); copy ($fh, $outfile) or &error(('アップロードに失敗しました','Failed to upload')[$lang]); close $fh; chmod (0666,"$outfile"); return $fname; } sub mylocaltime { my $src = shift; if ($localtime_en) { return (localtime($src)); } else { return (gmtime($src + $offset_from_gmt * 3600)); } } ################ 編集 ####################### sub edit { if ($admin_only_en && !&checkadmin($in{pwd2})){ &error('パスワードが違います。'); } if ($in{'pwd'} eq "") { &error("削除用パスワードを正しく入れてください。"); } &error(('使い方が間違っています。','Wrong edit method.')[$lang]) if ($ENV{REQUEST_METHOD} eq 'GET'); &check_ngword; my $aaa; my @newlist=(); my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem); open(DLFILE,"< $prfile"); while(){ chomp; ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/); my $editcount = "edit$count"; if ("$in{edit_num}" == $count){ my @fileterm_list = split(/<>/,$fileterm); my @filecomterm_list = split(/<>/,$filecomterm); my $fileterm_tmp = ''; my $filecomterm_tmp = ''; my $filesize_sum=0; my $cur_uppic_num = 0; my @delete_list; foreach my $a (1 .. $in{old_picnum_end}){ my $tmppic = "upfile${a}_pic"; my $tmpcom = "upfile${a}_com"; my @aaa = grep(/$tmppic=/,@fileterm_list); if ($in{$tmppic} ne 'on'){ if ($aaa[0] eq '') {next;} $cur_uppic_num++; $fileterm_tmp = $fileterm_tmp . $aaa[0] . "<>"; $filecomterm_tmp = $filecomterm_tmp . "$tmpcom=$in{$tmpcom}" . "<>"; if ($size_check_en == 1){ my $pic_filename = $aaa[0]; $pic_filename =~ s/$tmppic=//; my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$prdir/$pic_filename"); $filesize_sum=$filesize_sum + $d_size; } } else { $aaa[0] =~ /$tmppic=(.+)/; my $deletefile = $1; if ($pic_total_max_en){ push @delete_list, $deletefile; } else { unlink("$prdir/$deletefile"); &delete_thumbs($deletefile); } } } &pic_total_max_check($cur_uppic_num); if ($pic_total_max_en){ foreach my $deletefile (@delete_list) { unlink("$prdir/$deletefile"); &delete_thumbs($deletefile); } } my $allocated_size2 = $allocated_size * 1024 + 20480; # margin 20KB if ($size_check_en == 1){ $filesize_sum = $filesize_sum + $ENV{'CONTENT_LENGTH'}; if ($filesize_sum > $allocated_size2){ &error("一人がアップロードできる合計ファイルサイズが${allocated_size}kBを越えています。"); } } my $fileterm = $fileterm_tmp; my $filecomterm = $filecomterm_tmp; my $uppic; my $picnum; my $fname; my $upcom; foreach $picnum ($in{new_picnum_start} .. $in{new_picnum_end}){ $uppic = "upfile${picnum}_pic"; $fname = &upload_file($count,$picnum); $fileterm = $fileterm . "$uppic" . '=' . "$fname" . '<>'; $upcom = "upfile${picnum}_com"; $filecomterm = $filecomterm . "$upcom" . '=' . "$in{$upcom}" . '<>'; } my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=mylocaltime(time); $update = sprintf("%s_%s_%s_%02s_%02s",$year+1900,$mon+1,$mday,$hour,$min); my $encpwd; if ($in{pwdreset} eq 'on'){ $encpwd = &makecrypt($in{pwd2}); } else { $encpwd = &makecrypt($in{pwd}); } $aaa = "$count,$update,$in{yourname},$encpwd,$fileterm,$filecomterm"; foreach my $a (1 .. $itemmaxnum){ my $tmpa = "item${a}_key"; my $tmpb = "item${a}_elem"; next if ($in{$tmpa} eq ''); $aaa = $aaa . ",$in{$tmpa}<>$in{$tmpb}"; } $aaa = $aaa . "\n"; push (@newlist,"$aaa") if ($reorder == 0); } else { push(@newlist,"$_\n"); } } close(DLFILE); push(@newlist,$aaa) if ($reorder == 1); &lockfile; open(DAT,"> $prfile") or &error("データを$prfileに書き込めません。"); print DAT @newlist; close(DAT); &unlockfile; &extraupdate; if ($up_mail_en == 1){ &mailnotice("$up_mail_title","$in{yourname}",$update); } &go_disp; } sub extraupdate { if ($update1_file_en == 1){ open(UPDATE,">$update1_file"); print UPDATE "dummy file1\n"; close(UPDATE); chmod(0666,"$update1_file"); } if ($update2_file_en == 1){ open(UPDATE,">$update2_file"); print UPDATE "dummy file2\n"; close(UPDATE); chmod(0666,"$update2_file"); } } ################ 登録フォーム ####################### sub regform { if ($admin_only_en == 1 && ! &checkadmin($in{pwd})){ &error('パスワードが違います。'); } &beginning($regtitle); if ($regtitle_logo_en == 1){ print "

\"$regtitle\"

\n"; } else { print "

$regtitle

\n"; } ®explain; print <<"EOM";
EOM if ($table_layout_en == 1){ print "\n"; } else { print "
\n"; } print < EOM2 foreach (1 .. $itemmaxnum){ print "\n"; if ($_ <= $no_item_edit) { print "\n"; print < COMS } foreach (1 .. $picmaxnum){ print < PICS } if ($member_only == 1){ print < END3 } my $pwdmessage; if ($admin_only_en == 1){ $pwdmessage = '管理人パスワード'; } else { $pwdmessage = '修正用パスワード'; } print <
$item $contents
$name_in
"; print "$item_value[$_-1]"; } else { print ""; print ""; } print "
画像ファイル
画像コメント

メンバー専用パスワード
$pwdmessage
 
EOM2 &ending; } ################ 登録フォーム for mobile ####################### sub iregform { if ($admin_only_en == 1 && ! &checkadmin($in{pwd})){ &error('パスワードが違います。'); } &beginning($regtitle); print "$regtitle

\n"; print "$firstpage
\n"; print <<"EOM";

EOM if ($mobileusage_en){ print "$usage\n"; } print <

EOM2 foreach (1 .. $itemmaxnum){ if ($_ <= $no_item_edit){ print "$item_value[$_-1]\n"; } else { print "\n"; } print "
\n"; print <

COMS } # With a mobile phone, multipart/formdata does not work. # So, disable image upload in the mobile mode. # force max 2 in mobile mode $picmaxnum = 2; #foreach (1 .. $picmaxnum){ #print < #
#画像コメント
#

#PICS #} if ($member_only == 1){ print <

END3 } my $pwdmessage; if ($admin_only_en == 1){ $pwdmessage = '管理人パスワード'; } else { $pwdmessage = '修正用パスワード'; } print <

EOM2 &ending; } sub editform { open(EDITFILE,"< $prfile") or &error(("$prfileが開けません","Cannot open $prfile.")[$lang]); while(){ my ($count,@dumps)=split(/,/,$_); my $editkey = "edit${count}"; my $delkey = "delete${count}"; if (defined $in{$editkey}){ close(EDITFILE); chomp; if ($in{use} eq 'mobile'){ &ieditform2($_); } else { &editform2($_); } exit; } elsif (defined $in{$delkey}) { close(EDITFILE); &delete_one; exit; } } close(EDITFILE); &beginning('Error'); print "
パスワードを入力して【Enter】キーではなく、をクリックしてください。
"; &ending; exit; } ##### 削除 #### sub delete_one { &lockfile; open(TMPFILE,"> tmp.$$"); open(DELLOG,">> $dellog"); my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem); if (open(DELFILE,"< $prfile")){ while(){ ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/,$_); my $delkey = "delete${count}"; if (defined $in{$delkey}){ if (!((&checkcrypt($in{pwd},"$encpwd") && ("$encpwd" ne '')) || &checkadmin($in{pwd}))){ close(DELLOG); close(TMPFILE); close(DELFILE); unlink("tmp.$$"); &error("パスワードが違います。"); } print DELLOG $_; my @tmp_list=split(/<>/,$fileterm); my @picnumlist; foreach (@tmp_list){ my ($itemname,$filename)=split(/=/); $itemname =~ /upfile(\d+)_pic/; push(@picnumlist,$1); } my @aaa = sort {$a <=> $b} @picnumlist; my $old_picnum_end = $aaa[$#aaa]; foreach my $a (1 .. $old_picnum_end){ my $tmppic = "upfile${a}_pic"; my $tmpcom = "upfile${a}_com"; @aaa = grep(/$tmppic=/,@tmp_list); $aaa[0] =~ /$tmppic=(.+)/; my $deletefile = $1; unlink("$prdir/$deletefile") if (-f "$prdir/$deletefile"); &delete_thumbs($deletefile); } } else { print TMPFILE $_; } } close(DELFILE); } close(TMPFILE); close(DELLOG); rename("tmp.$$","$prfile"); &unlockfile; if ($del_mail_en == 1){ &mailnotice("$del_mail_title","$name","$update"); } &go_disp; exit; } sub lockfile { open(LOCKFILE,"> $lockfile") or &error("$lockfileが作成できません。"); flock LOCKFILE, 2; } sub unlockfile { no strict; close (LOCKFILE) if (defined LOCKFILE); close (TMPFILE) if (defined TMPFILE); unlink $lockfile if (-e $lockfile); unlink "tmp.$$" if (-e "tmp.$$"); } ##### 修正フォーム #### sub editform2 { my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/,shift); if (! &checkcrypt($in{pwd},$encpwd) and ! &checkadmin($in{pwd})){ &error(('パスワードが違います','Wrong password.')[$lang]); } &beginning($edititle); if ($edititle_logo_en == 1){ print "

\"$edititle\"

\n"; } else { print "

$edititle

\n"; } ®explain; print <<"EOM"; EOM if ($table_layout_en == 1){ print "\n"; } else { print "
\n"; } print < EOM2 my $item_keyelem_num = $#item_keyelem+1; my $item_max; if ($itemmaxnum >= $item_keyelem_num){ $item_max = $itemmaxnum; } else { $item_max = $item_keyelem_num; } my $keycount = 1; foreach (1 .. $item_max){ my ($key,$elem)=split(/<>/,$item_keyelem[$_-1]); $elem =~ s/
/\n/g; if ($key ne ''){ print ""; if ($_ <= $no_item_edit and $_ != 0){ print "\n"; $elem =~ s/(http..*)<\/a>/$1/; print "\n"; print "\n"; $keycount = $keycount + 1; } } if ($keycount <= $itemmaxnum){ foreach ($keycount .. $itemmaxnum){ print ""; print ""; print "\n"; print "\n"; } } my @tmp=split(/<>/,$fileterm); my @picnumlist; foreach (@tmp){ my ($itemname,$filename)=split(/=/); $itemname =~ /upfile(\d+)_pic/; push(@picnumlist,$1); } my @aaa = sort {$a <=> $b} @picnumlist; my $old_picnum_start = $aaa[0]; my $old_picnum_end = $aaa[$#aaa]; my $new_picnum_start = $old_picnum_end + 1; my $new_picnum_end = $old_picnum_end + $picmaxnum; foreach ($new_picnum_start .. $new_picnum_end){ print < PICS } my $hiddeninfo; if ($fileterm ne ''){ print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print ""; print "\n"; print ""; print "\n"; print <
$item $contents
$name_in
"; print "$key"; } else { print ""; print ""; } print "
画像ファイル
画像コメント

\n"; print ""; my @piclist = split(/<>/,$fileterm); my @comlist = split(/<>/,$filecomterm); my $i=1; my ($picfile,$picname,$picnum,$imtd_width,$actual_width,$actual_height,$comname,$comment); foreach my $pic (@piclist){ my ($tmp,$tmp1)=split(/=/,$pic); if ($pic eq '' or ! -e "$prdir/$tmp1") { $imtd_width = $max_width; ($picname,$picfile)=split(/=/,$pic); } else { ($picfile,$picname,$picnum,$imtd_width,$actual_width,$actual_height,$comname,$comment) = &get_one_image($pic,\@comlist); } if ($i % 3 == 1) {print "";} print ""; if ($i % 3 == 0) {print "";} $hiddeninfo = $hiddeninfo . "<>" . "upfile${picnum}_pic"; $i = $i + 1; } print "
"; if ($pic eq '' or ! -e "$prdir/$tmp1") { print "<No Image>"; } else { print &image_tag($picfile,$actual_width,$actual_height); } print "
\n"; print "
"; print "↑削除
"; print "
"; } print "
修正用パスワード"; if (&checkcrypt($in{pwd},$encpwd)){ print "←パスワードを変更できます"; } elsif (&checkadmin($in{pwd})){ print "\n"; print "\n"; print ""; print "←パスワードを変更するときチェック"; } print "
 
EOM2 &ending; } ##### 修正フォーム for mobile #### sub ieditform2 { my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/,shift); if (! &checkcrypt($in{pwd},$encpwd) and ! &checkadmin($in{pwd})){ &error(('パスワードが違います','Wrong password.')[$lang]); } &beginning($edititle); print "$edititle\n"; print <<"EOM";
EOM print <

EOM2 my $item_keyelem_num = $#item_keyelem+1; my $item_max; if ($itemmaxnum >= $item_keyelem_num){ $item_max = $itemmaxnum; } else { $item_max = $item_keyelem_num; } my $keycount = 1; foreach (1 .. $item_max){ my ($key,$elem)=split(/<>/,$item_keyelem[$_-1]); $elem =~ s/
/\n/g; if ($key ne ''){ if ($_ <= $no_item_edit){ print "$key"; } else { print ""; } print "
\n"; $elem =~ s/(http..*)<\/a>/$1/; print "

\n"; $keycount = $keycount + 1; } } if ($keycount <= $itemmaxnum){ foreach ($keycount .. $itemmaxnum){ print "
"; print "

\n"; } } my @tmp=split(/<>/,$fileterm); my @picnumlist; # force max 2 in mobile mode $picmaxnum = 2; foreach (@tmp){ my ($itemname,$filename)=split(/=/); $itemname =~ /upfile(\d+)_pic/; push(@picnumlist,$1); } my @aaa = sort {$a <=> $b} @picnumlist; my $old_picnum_start = $aaa[0]; my $old_picnum_end = $aaa[$#aaa]; my $new_picnum_start = $old_picnum_end + 1; my $new_picnum_end = $old_picnum_end + $picmaxnum; # foreach ($new_picnum_start .. $new_picnum_end){ # print < #画像ファイル
#
#画像コメント
#

#PICS #} my $hiddeninfo; if ($fileterm ne ''){ my @piclist = split(/<>/,$fileterm); my @comlist = split(/<>/,$filecomterm); my $i=1; foreach my $pic (@piclist){ my ($tmp,$tmp1)=split(/=/,$pic); my ($picfile,$picname,$picnum,$imtd_width,$actual_width,$actual_height,$comname,$comment); if ($pic eq '' or ! -e "$prdir/$tmp1") { $imtd_width = $max_width; ($picname,$picfile)=split(/=/,$pic); $picname =~ /upfile(\d+)_pic/; $picnum = $1; $comname = "upfile${picnum}_com"; print "<No Image>"; } else { ($picfile,$picname,$picnum,$imtd_width,$actual_width,$actual_height,$comname,$comment) = &get_one_image($pic,\@comlist); print &image_tag($picfile,$actual_width,$actual_height); } print "
\n"; print "
\n"; print "↑削除

\n"; $hiddeninfo = $hiddeninfo . "<>" . "upfile${picnum}_pic"; $i = $i + 1; } } print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "修正用パスワード
\n"; if (&checkadmin($in{pwd})){ print "\n"; print "\n"; print ""; print "←パスワードを変更するときチェック"; } else { print "
↑パスワードを変更できます

"; } print <
EOM2 &ending; } sub image_tag { my ($image,$w,$h) = @_; if ($w == 0 or $h == 0) { return "<File>"; } else { if ($in{mode} =~ /^i/ or $in{use} eq 'mobile'){ $image = &mob_image_gen($image,$w,$h); } else { $image = &image_gen($image,$w,$h) if ($thumb_gen_en); } return ""; } } sub get_one_image { my $pic = shift; my $comlist = shift; my ($picname,$picfile)=split(/=/,$pic); $picname =~ /upfile(\d+)_pic/; my $picnum = $1; my $comname = "upfile${picnum}_com"; my @com1 = grep(/^$comname=/,@{$comlist}); my $com = $com1[0]; $com =~ /$comname=(.*)/; my $comment = $1; $picfile =~ /(.+)(\..+)/; my $pichead = $1; my $tail = $2; my ($actual_width, $actual_height); ($picfile,$actual_width,$actual_height) = &get_image_size("$picfile"); my $imtd_width; if ($actual_width < $max_width) { $imtd_width = $max_width; } else { $imtd_width = $actual_width; } return ($picfile, $picname, $picnum, $imtd_width, $actual_width, $actual_height, $comname, $comment); } ################ セットアップ用パスワード入力 ####################### sub setup { my $next; if ($in{next} ne ''){ $next = $in{next}; } else { $next = 'setform'; } &beginning('管理者用パスワード'); print "

\n"; print "
管理者用パスワードを入力してください。
\n"; print "\n"; print "\n"; print "\n"; print "
"; &ending; exit; } ################ セットアップフォーム ####################### sub setform { if (! &checkadmin($in{pwd})){ &error('パスワードが違います。'); } &beginning($setup_title); my @admin_only_check; my @regnamecheck_check; my @title_logo_check; my @regtitle_logo_check; my @edititle_logo_check; my @register_title_logo_check; my @setup_title_logo_check; my @toplink_check; my @toplink_logo_check; my @mobile_check; my @search_check; my @mobile_logo_check; my @search_logo_check; my @mobileusage_check; my @list_logo_check; my @list_display_check; my @bgimage_check; my @setup_check; my @delete_check; my @regform_check; my @samewin_check; my @lastupdate_check; my @lastupdate_form_check; my @eachupdate_check; my @eachupdate_form_check; my @style_sheet_check; my @table_bgcolor_check; my @update1_file_check; my @update2_file_check; my @pagedisp_check; my @prev_icon_check; my @prev_loc_check; my @next_icon_check; my @next_loc_check; my @first_icon_check; my @link_replace_check; my @link_replace_top_check; my @head_insert_check; my @hr_check; my @table_layout_check; my @item_lr_check; my @item_ud_check; my @size_check_check; my @pic_loc_check; my @pic_total_max_check; my @disp_order_check; my @reorder_check; my @reg_mail_check; my @up_mail_check; my @del_mail_check; my @member_only_check; my @localtime_check; my @postmax_check; $admin_only_check[$admin_only_en] = "checked"; $regnamecheck_check[$regnamecheck_en] = "checked"; $title_logo_check[$title_logo_en] = "checked"; $regtitle_logo_check[$regtitle_logo_en] = "checked"; $edititle_logo_check[$edititle_logo_en] = "checked"; $register_title_logo_check[$register_title_logo_en] = "checked"; $setup_title_logo_check[$setup_title_logo_en] = "checked"; $toplink_check[$toplink_en] = "checked"; $toplink_logo_check[$toplink_logo_en] = "checked"; $mobile_check[$mobilelink_en] = "checked"; $search_check[$searchlink_en] = "checked"; $mobileusage_check[$mobileusage_en] = "checked"; $mobile_logo_check[$mobile_logo_en] = "checked"; $search_logo_check[$search_logo_en] = "checked"; $list_logo_check[$list_logo_en] = "checked"; $list_display_check[$list_display] = "checked"; $bgimage_check[$bgimage_en] = "checked"; $setup_check[$setup_en] = "checked"; $delete_check[$delete_en] = "checked"; $regform_check[$regform_en] = "checked"; $samewin_check[$samewin_en] = "checked"; $lastupdate_check[$lastupdate_en] = "checked"; $lastupdate_form_check[$lastupdate_form] = "checked"; $eachupdate_check[$eachupdate_en] = "checked"; $eachupdate_form_check[$eachupdate_form] = "checked"; $style_sheet_check[$style_sheet_en] = "checked"; $table_bgcolor_check[$table_bgcolor_en] = "checked"; $update1_file_check[$update1_file_en] = "checked"; $update2_file_check[$update2_file_en] = "checked"; $pagedisp_check[$pagedisp_en] = "checked"; $prev_icon_check[$prev_icon_en] = "checked"; $prev_loc_check[$prev_loc] = "checked"; $next_icon_check[$next_icon_en] = "checked"; $next_loc_check[$next_loc] = "checked"; $first_icon_check[$first_icon_en] = "checked"; $link_replace_check[$link_replace_en] = "checked"; $link_replace_top_check[$link_replace_top_en] = "checked"; $head_insert_check[$head_insert_en] = "checked"; $hr_check[$hr_en] = "checked"; $table_layout_check[$table_layout_en] = "checked"; $item_lr_check[$item_lr] = "checked"; $item_ud_check[$item_ud] = "checked"; $size_check_check[$size_check_en] = "checked"; $pic_loc_check[$pic_loc] = "checked"; $pic_total_max_check[$pic_total_max_en] = "checked"; $disp_order_check[$disp_order] = "checked"; $reorder_check[$reorder] = "checked"; $reg_mail_check[$reg_mail_en] = "checked"; $up_mail_check[$up_mail_en] = "checked"; $del_mail_check[$del_mail_en] = "checked"; $member_only_check[$member_only] = "checked"; $localtime_check[$localtime_en] = "checked"; $postmax_check[$postmax_en] = "checked"; my @thumb_gen_check; $thumb_gen_check[$thumb_gen_en] = "checked"; my @mob_image_format_check; $mob_image_format_check[$mob_image_format] = "checked"; my $item_value = join(',',@item_value); my $target; if ($list_display == 3){ $target = "target=_parent"; } else { $target = "target=_self"; } print "
\n"; print "\n"; print "\n"; if ($table_layout_en == 1){ print "\n"; } else { print "
\n"; } print <
  • ディレクトリ、ファイルの設定は、$scriptから見た相対パス、又は絶対パスで指定してください。CGIと同じディレクトリの場合、.(半角ドット)でOKです。バックグランドファイルやロゴファイルはhttp://からのリンクの指定も可能\\です。
  • 管理人パスワードを変更するには、$admindatを削除して、$scriptを実行しなおしてパスワードを再入力してください。
  • 削除された記事は$dellogに保存されますので、ここから復帰したい行を$prfileにコピーすると記事が復元できます。但し、画像は復帰できません。
  • これらの設定は$setupfileに保存されます。また、$setupfileをエディタ等で変更してもこの設定ページに反映されます。
  • $scriptがバージョンアップされた場合、単純に$scriptだけを置き換えるだけで設定はそのまま使えます。
  • $admindatと$setupfileのファイル名はこの設定ページでは変更できません。変更したい場合は$scriptの中で変更してください。
  • 管理人パスワードで他人の書き込みを修正、削除することができます。
  • 管理用リンクを非表\\示にしている場合にこのページにアクセスするには、$script?mode=setupを実行するとアクセスできます。
  • 登録リンクを非表\\示にしている場合に登録ページにアクセスするには、$script?mode=regformを実行するとアクセスできます。
  • 画像アップサイズを変更した場合は、書き込みの注意事項内のサイズ部分も忘れずに変更してください。
  • 数字やカラー指定は必ず半角で指定してください。全角やブランクだとCGIが起動しなくなります。万一間違って全角で書いてしまった場合は、$setupfileをエディタで開きその場所を半角に正しく修正してください。それで直ります。
  • 送信ボタンなどのボタンはid=buttonがHTMLで設定されてるのでスタイルシートでボタンをデザインする時は、.button {...}で設定してください。
  • 各ページのタイトルは<H2>をつかってるのでスタイルシートでデザインを変更したい場合は、H2 {...}で設定してください。
データディレクトリ
データファイル
削除記事保存ファイル
ロックファイル
バックグランド 画像を使う カラー設定にする
画像を使う場合の画像ファイル
カラー設定の場合のカラー番号(白:\#ffffff 又は white)
表\\示テーブルのバックグラウンドカラー 有り 無し
色指定
名前欄のバックの色
管理人オンリーモード 有効 無効
有効にすると管理人のみ新規登録ができるようになります。
登録名重複チェック 有効 無効
有効にすると同じ名前で登録できなくなります。
タイトル名 ロゴ使用 ロゴ非使用
ロゴ画像ファイル
タイトル名
その色
登録タイトル ロゴ使用 ロゴ非使用
ロゴ画像ファイル
タイトル名
その色
修正タイトル ロゴ使用 ロゴ非使用
ロゴ画像ファイル
タイトル名
その色
登録リンク表\\示 表\\示 非表\\示
登録リンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
管理用リンク表\\示 表\\示 非表\\示
管理用リンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
トップへのリンク表\\示 有り 無し
トップのリンク先
トップへのリンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
携帯モードのリンク表\\示 有り 無し
携帯モードリンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
検索のリンク表\\示 有り 無し
検索リンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
携帯モードでの説明表\\示 有り 無し
登録者一覧表\\示 非表\\示 上に表\\示 下に表\\示 別ページに表\\示 別ウィンドウで表\\示
登録者一覧の一行に表\\示される数
登録者一覧表\\示名 アイコン使用 アイコン非使用
アイコン画像ファイル
リンク名
最終更新時間表\\示とフォーム 有り 無し
最終更新タイトル
その色
yyyy年mm月dd日HH時MM分
yyyy/mm/dd HH:MM
HH:MM yyyy/mm/dd
HH:MM mm/dd/yyyy
各記事更新時間 表\\示 非表\\示
更新時間タイトル
yyyy年mm月dd日HH時MM分
yyyy/mm/dd HH:MM
HH:MM yyyy/mm/dd
HH:MM mm/dd/yyyy
登録修正フォームの1行目 項目欄名
項目欄の文字色
項目欄の背景色
内容欄名
内容欄の文字色
内容欄の背景色
項目欄の文字の位置

お名前の項目名
パスワード項目名
修正ボタン名
削除機能\\ 有効 無効
削除ボタン名
表\\示順 最新順 古い順
登録順 更新順
最新順は更新時間が最新の記事が最初に表\\示されます。古い順は更新時間が最古の記事が最初に表\\示されます。
登録順は記事を更新してもその記事は最新記事として認識されないので最新順や古い順にしても順序が変わりません。更新順は記事を更新するとそれが最新記事として扱われますので最新順でその記事が最初に表\\示されて、古い順でその記事が最後に表\\示されます。
登録順/更新順は記事の書き込み時に適用される(データファイルにそのように書き込まれる)ので記事が書き込まれた後この設定を変更しても表\\示順序は変わりません。
最新順/古い順は表\\示時に適用されるので設定を変えた時点で有効になります。
1ページ表\\示制限 有効 無効
 有効時に1ページに表\\示する件数
前ページのリンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
前ページリンク名
位置
次ページのリンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
次ページリンク名
位置
最初に戻るのリンク名 アイコン使用 アイコン非使用
アイコン画像ファイル
次ページリンク名
アイテムの最大数
画像の最大数  1度にアップできる画像の最大数
アップ画像枚数制限 一人がアップできる合計画像枚数制限
有効 無効
有効時の制限枚数
入力項目のデフォルト 半角カンマ(,)で区切ってください
上記入力項目中最初の個は編集禁止(0:全て編集可能\)
画像表\\示サイズ 横幅 これを超える画像は縮小表\\示されます。
縦幅 但し画像をクリックするとフルサイズで表\\示されます。
画像アップサイズ KB 1度にアップできる最大合計サイズ
一人がアップできる合計画像サイズ制限 有効 無効
KB 現在アップされている画像も含め、一人がアップできる最大合計サイズ
縮小画像自動作成 サムネイルを縮小ファイルとして自動作成。有効にするとサムネイル画像として新しく縮小されたファイルを作成します。無効にするとサムネイル表\示しますが元画像の表\示サイズだけを変えて表\示します。
有効 無効
縮小画像ディレクトリ
携帯モード時に表\示する画像のファイルサイズ制限。
KB
携帯モード時に表\示する画像のフォーマット
jpg gif png
最大投稿数制限 有効 無効
登録できる最大数
画像クリック時 同じウィンドウ 別ウィンドウ
画像表\\示位置
表\\示テーブルのサイズ パーセント ページ全体からのパーセント
項目欄のサイズ パーセント テーブル全体からのパーセント
テーブルレイアウト 有効 無効
bordercolor= border= cellpadding= cellspacing=
書き込みテキストエリアのサイズ 横幅
縦幅
<HR>ライン 有り 無し
自動リンクの置き換え 有効 無効
置き換える文字列
自動リンククリック時 同じウィンドウ 別ウィンドウ
NGワード 入力禁止にする単語を半角スペースで区切って入力してください。
メンバー専用パスワード 有効 無効
パスワード
メール送信 新規登録時 有効 無効 メールタイトル
記事更新時 有効 無効 メールタイトル
記事削除時 有効 無効 メールタイトル
メールコマンド
送り主(From:)
送り先(To:)
メール内容

<head>内挿入文 有効 無効
HTML書式
ポップアップ広告やJavascript、<META>を挿入したい場合にここに記述する。
以下の記述が<head>〜</head>内に挿入される。

スタイルシート 有効 無効

書き込みの注意事項 HTML書式

時間設定 GMTからのオフセット ローカルタイム
GMTからのオフセットに設定した場合、GMTより時間(日本:+9時間)
予\\備のアップデートファイル 使用 非使用 ファイル名
使用 非使用 ファイル名
END print ""; print "
\n"; &ending; } ################ セットアップファイル作成 ####################### sub setupwrite { &checkadmin($in{pwd}); foreach (keys(%in)){ $in{$_} =~ s/
/\n/g; $in{$_} =~ s/&\#44;/,/g; $in{$_} =~ s/<//g; } my $item_value1 = ''; foreach (split(/,/,"$in{item_value}")){ $item_value1 = $item_value1 . "\'$_\'" . ','; } open(SETUP,"> $setupfile"); print SETUP <ライン 1:on 0:off \$hr_en = $in{hr_en}; #書き込みテキストエリアのサイズ \$textarea_cols = $in{textarea_cols}; \$textarea_rows = $in{textarea_rows}; #本文中のリンクを文字列に置き換える 1:on 0:off \$link_replace_en = $in{link_replace_en}; \$link_replace = '$in{link_replace}'; \$link_replace_top_en = $in{link_replace_top_en}; #メール送信 1:on 0:off \$reg_mail_en = $in{reg_mail_en}; \$up_mail_en = $in{up_mail_en}; \$del_mail_en = $in{del_mail_en}; \$reg_mail_title = '$in{reg_mail_title}'; \$up_mail_title = '$in{up_mail_title}'; \$del_mail_title = '$in{del_mail_title}'; \$mail_contents = '$in{mail_contents}'; \$to_mail = '$in{to_mail}'; \$from_mail = '$in{from_mail}'; \$mail_cmd = '$in{mail_cmd}'; # NGワード \$ngword = '$in{ngword}'; #メンバー専用パスワード 1:on 0:off \$member_only = $in{member_only}; \$member_pwd = '$in{member_pwd}'; #〜内に挿入できる構文 1:on, 0:off \$head_insert_en = $in{head_insert_en}; \$head_insert = '$in{head_insert}'; #スタイルシート 1:on 0:off \$style_sheet_en = $in{style_sheet_en}; \$style_sheet = '$in{style_sheet}'; #書き込みの注意事項 \$usage = '$in{usage}'; #時間設定 \$localtime_en = $in{localtime_en}; \$offset_from_gmt = $in{offset_from_gmt}; #トップからのSSI表\\示による更新時間のための予\\備のアップデートファイル # 1: on, 0: off \$update1_file_en = $in{update1_file_en}; \$update2_file_en = $in{update2_file_en}; \$update1_file = '$in{update1_file}'; \$update2_file = '$in{update2_file}'; #### 環境設定 ###### ここまで ############ END close(SETUP); print "Location: $script\n\n"; } ################ 表示 ####################### sub display { my @alldata; if (open(FILE,"< $prfile")){ @alldata=; close(FILE); } @alldata = reverse(@alldata) if ($disp_order == 0); my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$prfile"); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=mylocaltime($d_mtime); my $date_str; if ($lastupdate_form == 1){ $date_str = POSIX::strftime("%Y年%m月%d日%H時%M分",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); } elsif ($lastupdate_form == 2){ $date_str = POSIX::strftime("%Y/%m/%d %H:%M",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); } elsif ($lastupdate_form == 3){ $date_str = POSIX::strftime("%H:%M %Y/%m/%d",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); } elsif ($lastupdate_form == 4){ $date_str = POSIX::strftime("%H:%M %d/%m/%Y",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); } else { $date_str = POSIX::strftime("%Y年%m月%d日%H時%M分",$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); } &beginning($title); &header($date_str); my $target; print "
\n"; if ($toplink_en == 1){ if ($toplink_logo_en == 1){ if ($list_display == 3) { $target = "target=_parent"; } else { $target = "target=_self"; } print "\"$toplink_title\"\n"; } else { print "$toplink_title\n"; } } my $regform_mode; if ($admin_only_en == 1){ $regform_mode = "mode=setup&next=regform"; } else { $regform_mode = "mode=regform"; } if ($regform_en == 1){ if ($register_title_logo_en == 1){ print "\"$register_title\"\n"; } else { print "$register_title\n"; } } if ($list_display == 3 || $list_display == 4){ if ($list_display == 3){ $target = "target=_blank"; } else { $target = ''; } if ($list_logo_en == 1){ print "\"$list_title\"\n"; } else { print "$list_title\n"; } } if ($searchlink_en){ if ($search_logo_en){ print "\"$search_title\"\n"; } else { print "$search_title\n"; } } if ($mobilelink_en == 1){ if ($mobile_logo_en == 1){ print "\"$mobile_title\"\n"; } else { print "$mobile_title\n"; } } if ($setup_en == 1){ if ($setup_title_logo_en == 1){ print "\"$setup_title\"\n"; } else { print "$setup_title\n"; } } print "
\n"; if ($hr_en == 1 && $list_display == 1){ print "
\n"; } &listgen(@alldata) if ($list_display == 1); my $itemnumber = 0; my $midoffile = 0; my $actualdispnum = 0; my $allmesnum = $#alldata + 1; my $next = $in{next}; my @numarray; my $serialnum = 0; my $currentnum; foreach (@alldata){ chomp; my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/); $numarray[$serialnum] = $count; $currentnum = $serialnum if ($in{number} == $count); $serialnum++; next if ($in{number} ne '' && $in{number} != $count); $itemnumber = $itemnumber + 1; if ($pagedisp_en == 1){ if ($itemnumber < $next + 1){ next; } elsif ($itemnumber > $next + $pagedispnum){ $midoffile = 1; last; } } $actualdispnum = $actualdispnum + 1; if ($hr_en == 1){ print "
\n"; } else { print "
\n"; } if ($table_layout_en == 1){ print "\n"; } else { print "
\n"; } print ""; print ""; print "\n"; my @item_lr_name = ('left','center','right'); my @item_ud_name = ('top','center','bottom'); my $link_replace_target; if ($link_replace_top_en == 1){ $link_replace_target = 'target="_top"'; } else { $link_replace_target = 'target="_blank"'; } foreach my $keyelem (@item_keyelem){ my ($key,$elem)=split(/<>/,$keyelem); if ($key eq '') {next;} print ""; print ""; if ($elem eq ''){$elem = " ";} if ($link_replace_en == 1){ $elem =~ s/($url_pattern)/$link_replace<\/a>$2/g; } else { $elem =~ s/($url_pattern)/$1<\/a>$2/g; } print ""; print "\n"; } my @picalign; if ($fileterm ne ''){ @picalign = ('left','center','right'); print "\n"; } my @yourdate; my $dateform; if ($eachupdate_en == 1){ my @yourdate = split(/_/,$update); if ($eachupdate_form == 1){ $dateform = sprintf("%s年%s月%s日%s時%s分",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } elsif ($eachupdate_form == 2){ $dateform = sprintf("%s/%s/%s %s:%s",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } elsif ($eachupdate_form == 3){ $dateform = sprintf("%s:%s %s/%s/%s",$yourdate[3],$yourdate[4],$yourdate[0],$yourdate[1],$yourdate[2]); } elsif ($eachupdate_form == 4){ $dateform = sprintf("%s:%s %s/%s/%s",$yourdate[3],$yourdate[4],$yourdate[1],$yourdate[2],$yourdate[0]); } else{ $dateform = sprintf("%s年%s月%s日%s時%s分",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } print ""; print ""; print "\n"; } print "
\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
$name
$key$elem
\n"; my @piclist = split(/<>/,$fileterm); my @comlist = split(/<>/,$filecomterm); my $piccnt = $#piclist + 1; my $i=1; my $newwin; if ($samewin_en == 1){ $newwin = ''; } else { $newwin = 'target="_blank"'; } foreach my $pic (@piclist){ my ($tmp,$tmp1)=split(/=/,$pic); my ($picfile,$picname,$picnum,$imtd_width, $actual_width,$actual_height,$comname,$comment); my $colm_num; if ($piccnt/3 >= 1){$colm_num = 3;} else {$colm_num = $piccnt;} if ($pic eq '' or ! -e "$prdir/$tmp1") { $imtd_width = $max_width; } else { ($picfile,$picname,$picnum,$imtd_width, $actual_width,$actual_height,$comname,$comment) = &get_one_image($pic,\@comlist); } if ($i % 3 == 1) {print "\n\n";} print "\n"; if ($i % 3 == 0 and $colm_num % 3 != 0) {print "\n";} if ($i % 3 == $colm_num % 3) {print "\n
"; if ($pic eq '' or ! -e "$prdir/$tmp1") { print "<No Image>"; } else { print ""; print &image_tag($picfile,$actual_width,$actual_height); print ""; print "
\n"; print "$comment"; } print "
\n";} if ($i % 3 == $colm_num % 3) {$piccnt = $piccnt - $colm_num;} $i = $i + 1; } print "
$eachupdate$dateform
$passitem\n \n"; if ($delete_en == 1){ print "\n"; } print "
\n"; } if ($hr_en == 1){ print "
\n"; } else { print "
\n"; } my $prevlink = ''; my $nextlink = ''; my $prev; my $next; if ($in{number} eq '') { if ($pagedisp_en == 1){ if ($itemnumber > $pagedispnum + $midoffile){ $prev = $itemnumber - $pagedispnum - $actualdispnum; $prev = $prev - $midoffile; if ($prev_icon_en == 1){ $prevlink = "
\"$prevpage\"\n"; } else { $prevlink = "$prevpage\n"; } } if ($midoffile == 1){ $next = $itemnumber-1; if ($next_icon_en == 1){ $nextlink = "\"$nextpage\"\n"; } else { $nextlink = "$nextpage\n"; } } } } else { if ($currentnum != 0){ $prev = $numarray[$currentnum-1]; $prevlink = "$prevpage\n"; } if ($currentnum != $allmesnum - 1){ $next = $numarray[$currentnum+1]; $nextlink = "$nextpage\n"; } } my $firstlink; if ($first_icon_en == 1){ $firstlink = "\"$firstpage\"\n"; } else { $firstlink = "$firstpage\n"; } print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; if ($prev_loc == 0){print "$prevlink";} if ($next_loc == 0){print "$nextlink";} print "\n"; if ($prev_loc == 1){print "$prevlink";} print "$firstlink\n"; if ($next_loc == 1){print "$nextlink";} print "\n"; if ($prev_loc == 2){print "$prevlink";} if ($next_loc == 2){print "$nextlink";} print "
\n"; if ($hr_en == 1 && $list_display == 2){ print "
\n"; } &listgen(@alldata) if ($list_display == 2); &ending; } sub get_image_size { my $image = shift; my $imagefile = "$prdir/$image"; my $im = &get_imobj($imagefile); my ($width, $height) = $im->getBounds() if ($im); my $actual_width; my $actual_height; if ($width > $max_width or $height > $max_height){ my $width_shrink = $max_width / $width; my $height_shrink = $max_height / $height; my $shrink_ratio; if ($width_shrink < $height_shrink){ $shrink_ratio = $width_shrink; } else { $shrink_ratio = $height_shrink; } $actual_width = int($width * $shrink_ratio); $actual_height = int($height * $shrink_ratio); } else { $actual_width = $width; $actual_height = $height; } return($imagefile,$actual_width,$actual_height); } #### mobile mode display ### sub iread { my @alldata; if (open(FILE,"< $prfile")){ @alldata=; close(FILE); } @alldata = reverse(@alldata) if ($disp_order == 0); &beginning($title); print "$toplink_title

\n"; my $regform_mode; if ($admin_only_en == 1){ $regform_mode = "mode=setup&next=iregform"; } else { $regform_mode = "mode=iregform"; } if ($regform_en == 1){ print "$register_title
\n"; } &listgen(@alldata) if ($list_display == 1); my $allmesnum = $#alldata + 1; $pagedispnum = 1; my @numarray; my $serialnum = 0; my $currentnum; foreach (@alldata){ chomp; my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/); $numarray[$serialnum] = $count; $currentnum = $serialnum if ($in{number} == $count); $serialnum++; if ($in{number} eq ''){ $in{number} = $count; } next if ($in{number} ne '' && $in{number} != $count); print "

$name

"; my @item_lr_name = ('left','center','right'); my @item_ud_name = ('top','center','bottom'); my $link_replace_target; $link_replace_target = 'target="_top"'; foreach my $keyelem (@item_keyelem){ my ($key,$elem)=split(/<>/,$keyelem); if ($key eq '') {next;} print "$key:
\n"; if ($elem eq ''){$elem = " ";} if ($link_replace_en == 1){ $elem =~ s/($url_pattern)/$link_replace<\/a>$2/g; } else { $elem =~ s/($url_pattern)/$1<\/a>$2/g; } print "$elem

\n"; } my @picalign; if ($fileterm ne ''){ @picalign = ('left','center','right'); my @piclist = split(/<>/,$fileterm); my @comlist = split(/<>/,$filecomterm); my $piccnt = $#piclist + 1; my $i=1; my $newwin; $newwin = ''; foreach my $pic (@piclist){ my ($tmp,$tmp1)=split(/=/,$pic); ($pic eq '' or ! -e "$prdir/$tmp1") && next; my ($picfile,$picname,$picnum,$imtd_width, $actual_width,$actual_height,$comname,$comment) = &get_one_image($pic,\@comlist); # print ""; print &image_tag($picfile,$actual_width,$actual_height); # print ""; print "
\n"; print "$comment"; print "

\n"; $i = $i + 1; } } my @yourdate; my $dateform; if ($eachupdate_en == 1){ my @yourdate = split(/_/,$update); if ($eachupdate_form == 1){ $dateform = sprintf("%s年%s月%s日%s時%s分",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } elsif ($eachupdate_form == 2){ $dateform = sprintf("%s/%s/%s %s:%s",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } elsif ($eachupdate_form == 3){ $dateform = sprintf("%s:%s %s/%s/%s",$yourdate[3],$yourdate[4],$yourdate[0],$yourdate[1],$yourdate[2]); } elsif ($eachupdate_form == 4){ $dateform = sprintf("%s:%s %s/%s/%s",$yourdate[3],$yourdate[4],$yourdate[1],$yourdate[2],$yourdate[0]); } else{ $dateform = sprintf("%s年%s月%s日%s時%s分",$yourdate[0],$yourdate[1],$yourdate[2],$yourdate[3],$yourdate[4]); } print "$eachupdate:
"; print "$dateform"; print "
\n"; } print "

\n"; print "$passitem:
\n"; print "\n"; print "\n"; print "
\n"; print "
\n"; if ($delete_en == 1){ print "
\n"; } print "
\n"; } print "
\n"; my $prevlink = ''; my $nextlink = ''; my $prev; my $next; if ($currentnum != 0){ $prev = $numarray[$currentnum-1]; $prevlink = "$prevpage
"; } if ($currentnum != $allmesnum - 1){ $next = $numarray[$currentnum+1]; $nextlink = "$nextpage
"; } print "$firstpage
\n"; print "$prevlink\n"; print "$nextlink\n"; &ending; } sub listgen { my @alldata = @_; my $target; if ($list_display == 3){ $target = "target=profile_main"; } else { $target = "target=_self"; } # print "\n"; print "

\n"; my $i; my $flag = 0; my $forend = (($#alldata+1) % $list_cols == 0) ? $#alldata + 1 : (int(($#alldata+1) / $list_cols) + 1) * $list_cols; for ($i=0;$i<$forend;$i++){ chomp; my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/,$alldata[$i]); if ($i%$list_cols == 0 && $list_cols != 0) { print "\n"; $flag = 1; } # print "\n"; print "\n"; if ($i%$list_cols == $list_cols-1 && $list_cols != 0) { print "\n"; $flag = 0; } } print "\n" if ($flag == 1); print "
$name"; if ($count eq ''){ print " "; } else { print "$name"; } print "
\n"; } sub ilistgen { my @alldata = @_; my $i = 0; my $flag = 0; foreach (@alldata){ chomp; my ($count,$update,$name,$encpwd,$fileterm,$filecomterm,@item_keyelem)=split(/,/); print "$name
\n"; } } sub list_display { if ($in{mode} eq 'mobile'){ &beginning($title); } else { &beginning($list_title); } my @alldata; if (open(FILE,"< $prfile")){ @alldata=; close(FILE); } @alldata = reverse(@alldata) if ($disp_order == 0); my $regform_mode; if ($admin_only_en == 1){ $regform_mode = "mode=setup&next=iregform"; } else { $regform_mode = "mode=iregform"; } if ($in{mode} eq 'mobile'){ print "$title

\n"; print "$toplink_title

\n"; if ($regform_en == 1){ print "$register_title

\n"; } &ilistgen(@alldata); } else { if ($title_logo_en == 1){ print "

\"$title\"

\n"; } else { print "

$title

\n"; } print "
$toplink_title

\n"; &listgen(@alldata); } &ending; } sub beginning { my $title = shift; print $q->header(-type=>'text/html',-charset=>$charset); print "\n"; print < $title HEADPRINT if ($head_insert_en == 1){ print "$head_insert\n"; } if ($style_sheet_en == 1){ print "\n"; } my $bgset; if ($bgimage_en == 1){ $bgset = "background=\"$bgimagefile\""; } else { $bgset = "bgcolor=\"$bgcolor\""; } print "\n"; print "\n"; } sub ending { my $year = $lastmodifiedyear; if ($year > 2003){ $year = "2003-$year"; } my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang]; print "

profile2.cgi Ver. $version
Copyright(C) $year, hidekik.com
\n"; print "\n"; print "\n"; } sub header { my $date_str = shift; if ($title_logo_en == 1){ print "

\"$title\"

\n"; } else { print "

$title

\n"; } if ($lastupdate_en == 1){ print "
$lastupdate $date_str

\n"; } } sub error { my $message = shift; &unlockfile; &beginning($message); print "
$message
\n"; &ending; exit; } sub makecrypt { my $plain = shift; my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]; my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$'); return $result; } sub setadminpwd { &beginning($setup_title); print "
"; print "
管理者用パスワードを設定してください。
"; print ""; print ""; print ""; print "
"; &ending; exit; } sub wradminpwd { my $passwd = &makecrypt($in{pwd}); if (open(FILE,"> $admindat")){ print FILE "$passwd"; close(FILE); } else { &error(('パスワードファイル作成に失敗しました。','Failed to create a password file')[$lang]); } } sub checkcrypt { my ($pwd,$encpwd)=@_; return(crypt($pwd,$encpwd) eq "$encpwd"); } sub regexplain { print < $usage NOTICE } sub mailnotice { my ($subj,$name,$update) = @_; $subj=jcode($subj)->jis; my $header; $header = "To: " . jcode($to_mail)->mime_encode . "\n"; $header .= "From: " . jcode($from_mail)->mime_encode . "\n"; $header .= "Subject: " . jcode($subj)->mime_encode . "\n"; $header .= "MIME-Version: 1.0\n"; $header .= "Content-type: text/plain; charset=ISO-2022-JP\n"; $header .= "Content-Transfer-Encoding: 7bit\n\n"; my $body; $body = $mail_contents; $body .= "\n"; $body .= "名前 :$name\n"; $body .= "Host : $ENV{REMOTE_HOST}\n"; $body .= "IP : $ENV{REMOTE_ADDR}\n"; $body .= "時間 : $update\n\n"; if (open(SMAIL, "| $mail_cmd")){ print SMAIL $header; print SMAIL jcode($body)->jis; close(SMAIL); } else { &error("メールコマンドが実行できません。"); } } sub checkadmin { my $pwd = shift; $pwd ||= $in{pwd}; if (open(FILE,"< $admindat")){ my $filepwd = ; close(FILE); my $inpwd = crypt($pwd,$filepwd); return ("$inpwd" eq "$filepwd"); } else { my $message = ('パスワードファイルが存在しません','Cannot find password file.')[$lang]; &error($message); } } sub schform { &beginning($search_title); if ($regtitle_logo_en == 1){ print "

\"$search_title\"

\n"; } else { print "

$search_title

\n"; } print <
  • ブランクにしている項目は無視されます。
名前
項目
記事
AND  OR

AND  OR

   

$titleへ END2 &ending; } sub search { my $name = $in{name}; my $title = $in{title}; my $main1 = $in{main1}; my $main2 = $in{main2}; my $main3 = $in{main3}; foreach ($name, $title, $main1, $main2, $main3) { # 正規表現のスペシャルな文字に関してエスケープする。 # \=%5C, (=%28, )=%29, [=%5B, ]=%5D, |=%7C # ?=%3F, +=%2B, ^=%5E, $=%24, {=%7B, }=%7D # 圭=%8C%5C、表=%95%5C、ー=%81%5B、望=%96%5D、 # 評=%95%5D、従=%8F%5D、転=%93%5D、余=%97%5D、ゾ=%83%5D、犠=%8B%5D、 s/([\W])/sprintf("%%%02X", ord($1))/eg; s/%5[BCDE]/%5c$&/gi; s/%2[489B]/%5c$&/gi; s/%3F/%5c$&/gi; s/%7[BCD]/%5c$&/gi; s/[\.\*]/%5c$&/g; s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg; } &beginning("$search_title"); print "

"; &backbutton; print "
\n"; open(FILE,"< $prfile") || &error("データファイルが開けません。"); my $i = 0; while (){ chomp; my $nameres = "false"; my ($lnum,$ldcode,$lname,$lencpwd,$lfileterm,$lfilecomterm,@litem_keyelem)=split(/,/); ($name ne '') && ("$lname" =~ /$name/i) && ($nameres = 'true'); my $hit; foreach my $tmp (@litem_keyelem) { my $titleres = "false"; my $main1res = "false"; my $main2res = "false"; my $main3res = "false"; my ($ltitle, $lmain) = split /<>/, $tmp; next if ($ltitle =~ /^\s*$/); ($title ne '') && ("$ltitle" =~ /$title/i) && ($titleres = 'true'); ($main1 ne '') && ("$lmain" =~ /$main1/i) && ($main1res = 'true'); ($main2 ne '') && ("$lmain" =~ /$main2/i) && ($main2res = 'true'); ($main3 ne '') && ("$lmain" =~ /$main3/i) && ($main3res = 'true'); if (($main1res eq 'false') && ($main2res eq 'false') && ($main3res eq 'false') and ($nameres eq 'false')) {next;} if (($main1res eq 'false' || $main2res eq 'false') && $in{main1_plus} eq 'and' && $main1 ne '' && $main2 ne '' and ($nameres eq 'false')){next;} if (($main1res eq 'false' || $main3res eq 'false') && $in{main1_plus} eq 'and' && $main1 ne '' && $main3 ne '' and ($nameres eq 'false')){next;} if (($main2res eq 'false' || $main3res eq 'false') && $in{main2_plus} eq 'and' && $main2 ne '' && $main3 ne '' and ($nameres eq 'false')){next;} if ($nameres eq 'false' && $in{name_plus} eq 'and' && $name ne '' and ($nameres eq 'false')){next;} if ($titleres eq 'false' && $in{title_plus} eq 'and' && $title ne '' and ($nameres eq 'false')){next;} if ($hit == 0) { print "\n"; if ($name ne ''){$lname =~ s/($name)/$1<\/b>/gi;} print "\n"; } $hit = 1; if ($title ne ''){$ltitle =~ s/($title)/$1<\/b>/gi;} print "\n"; if ($main1 ne ''){$lmain =~ s/($main1)/$1<\/b>/gi;} if ($main2 ne ''){$lmain =~ s/($main2)/$1<\/b>/gi;} if ($main3 ne ''){$lmain =~ s/($main3)/$1<\/b>/gi;} print "\n"; print "\n"; } if ($hit){ print "\n"; print "
\n"; print "$lname"; print "
"; print "$ltitle"; print "\n"; print "$lmain"; print "
"; print "
この記事を表\示
\n"; print "

\n"; } } close(FILE); print "

"; &backbutton; print "
\n"; &ending; exit; } sub backbutton { my $back; if ($lang){ $back = 'Back'; } else { $back = '戻る'; } print "
\n"; } sub image_gen { my ($image,$new_width,$new_height) = @_; my $im = &get_imobj($image); my ($width, $height) = $im->getBounds() if ($im); my $target_im = new GD::Image($new_width,$new_height,1); $target_im->copyResized($im,0,0,0,0,$new_width,$new_height, $width,$height); mkdir "$thumb_dir" unless (-d "$thumb_dir"); my ($imagebody,$path,$ext) = fileparse("$image", '\.\w+$'); if ($in{mode} =~ /^i/ or $in{use} eq 'mobile'){ $ext = $mobext[$mob_image_format]; } else { $ext =~ s/^\.jpe?g/jpg/i; $ext =~ s/^\.gif/gif/i; $ext =~ s/^\.png/png/i; } $imagebody =~ s/^(.+)_\d+x\d+$/$1/; my $thumbimage = "$thumb_dir/${imagebody}_${new_width}x${new_height}.$ext"; if (! -e "$thumbimage"){ unless (open(IMAGE, "> $thumbimage")){ &error ("縮小画像ファイル作成に失敗しました。"); } binmode(IMAGE); if ($ext eq 'jpg'){ print IMAGE $target_im->jpeg(85); } elsif ($ext eq 'gif') { print IMAGE $target_im->gif(); } else { print IMAGE $target_im->png(); } close(IMAGE); undef $target_im; } return $thumbimage; } sub mob_image_gen { my ($image,$new_width,$new_height) = @_; my $thumbimage = &image_gen($image,$new_width,$new_height); my $kbyte = -s "$thumbimage"; # get file size if ($kbyte > $mob_image_size * 1024){ my $origthumb = $thumbimage; my $size_ratio = sqrt(($mob_image_size*1024)/$kbyte); my $new_width2 = int($new_width * $size_ratio); my $new_height2 = int($new_height * $size_ratio); my ($body,$path,$ext) = fileparse("$image", '\.\w+$'); my $thumbsbody = "${body}_${new_width2}x${new_height2}"; $thumbimage = "$thumb_dir/$thumbsbody.$mobext[$mob_image_format]"; if (! -e "$thumbimage"){ &image_gen($origthumb,$new_width2,$new_height2); } } return $thumbimage; } sub get_imobj { my $imagefile = shift; my $im; $imagefile =~ /\.jpe?g$/i and $im = GD::Image->newFromJpeg($imagefile); $imagefile =~ /\.gif$/i and $im = GD::Image->newFromGif($imagefile); $imagefile =~ /\.png$/i and $im = GD::Image->newFromPng($imagefile); $imagefile =~ /\.xbm$/i and $im = GD::Image->newFromxbm($imagefile); $imagefile =~ /\.gd$/i and $im = GD::Image->newFromgd($imagefile); $imagefile =~ /\.gd2$/i and $im = GD::Image->newFromgd2($imagefile); $imagefile =~ /\.xpm$/i and $im = GD::Image->newFromxpm($imagefile); return $im; } sub delete_thumbs { my $deletefile = shift; return if ($deletefile eq ''); my ($deletebody,$path,$ext) = fileparse($deletefile, '\.\w+$'); if (opendir (DIR, "$thumb_dir")){ foreach my $th (readdir DIR){ if ($th =~ /^${deletebody}_\d+x\d+\./){ unlink ("$thumb_dir/$th"); } } closedir DIR; } } sub pic_total_max_check { my $init = shift; if ($pic_total_max_en){ my $pic_total_num = $init; my $picnum_start; my $picnum_end; if ($in{mode} eq 'register'){ $picnum_start = 1; $picnum_end = $picmaxnum; } else { $picnum_start = $in{new_picnum_start}; $picnum_end = $in{new_picnum_end}; } # &error("$picnum_start:$picnum_end"); foreach my $picnum ($picnum_start .. $picnum_end){ my $uppic = "upfile${picnum}_pic"; $pic_total_num++ if ($in{$uppic} ne ''); if ($pic_total_num > $pic_total_max) { &error("一人がアップできる画像の枚数制限、$pic_total_max枚を越えています。"); } } } }