#!/usr/bin/perl
# 暫定バージョン
use Time::Local ;
#-----------------------------------------
# 設定変更箇所
#-----------------------------------------
my $calendar_dir = "/var/...PATH.../calendar" ;
my $cgi_charset = "EUC-JP" ; # CGI が出力する文字コード
# 画面下に表示する関連リンク
my $entry_footer = "[ 新項目の入力 | iCalendar ]" ;
my $form_footer = "[ iCalendar ]" ;
#-----------------------------------------
# for CGI
use Jcode ;
use CGI qw/:standard/ ;
my $cgi = new CGI ;
my $U , $Y , $M , $D ;
my $TS , $TE ;
my $SUB , $DES ;
#-----------------------------------------
# ユーザ名の取り込み
$U = Jcode->new( param( 'U' ) )->euc ;
$U = "" unless ( $U =~ /^[a-z0-9-]*$/i ) ;
# 年/月/日の取り込み
$Y = param( 'Y' ) ;
$Y = $Y + 0 if ( $Y ne "" ) ;
$M = param( 'M' ) ;
$M = $M + 0 if ( $M ne "" ) ;
$D = param( 'D' ) ;
$D = $D + 0 if ( $D ne "" ) ;
# 時:分の取り込み
$TS = hm_check( param( 'TS' ) ) ;
$TE = hm_check( param( 'TE' ) ) ;
$TODO = param( 'TODO' ) ;
$SUB = Jcode->new( param( 'SUB' ) )->euc ;
$DES = Jcode->new( param( 'DES' ) )->euc ;
#-----------------------------------------
my @users = sort( userlist( $calendar_dir ) ) ;
my @today = localtime() ;
my $today_year = $today[ 5 ] + 1900 ;
my $today_mon = $today[ 4 ] + 1 ;
my $today_day = $today[ 3 ] ;
#-----------------------------------------
sub hm_check( $ ) {
local( $hm ) = @_ ;
my $h , $m ;
if ( $hm =~ /^(\d\d\d|\d\d\d\d)$/ ) {
($h , $m) = ( int($hm / 100) , $hm % 100 ) ;
} elsif( $hm =~ /^(\d+):(\d+)$/ ) {
($h , $m) = ($1 , $2) ;
} else {
return "" ;
}
return sprintf( "%02d:%02d" , $h , $m ) ;
}
#-----------------------------------------
# カレンダーファイルを持つユーザの一覧
sub userlist( $ ) {
local( $dir ) = @_ ;
opendir DIR , $dir || die( "can't opendir $dir" ) ;
@user = () ;
while( $file = readdir( DIR ) ) {
if ( $file =~ /^[a-z0-9-]*\.ics$/ ) {
$file =~ s/\.ics$// ;
push( @user , $file ) ;
}
}
closedir DIR ;
return @user ;
}
#-----------------------------------------
# 項目の入力
sub form() {
print start_form( -method=>'GET' , -action=>'entry.cgi' ) ;
print "ユーザ名:" ,
popup_menu( -name=>'U' , -values => [ @users ] , -default=> $U ) , br ;
print "日付:" ,
popup_menu( -name => 'Y' ,
-values => [ $today_year..$today_year + 2 ] ,
-default => $today_year )."年" , "\n" ,
popup_menu( -name => 'M' ,
-values => [ 1..12 ] ,
-default => $today_mon )."月" , "\n" ,
textfield( -name => 'D' ,
-value => $today_day ,
-size => 2 , -istyle => 4 )."日" , br , "\n" ;
print "時間:" ,
textfield( -name=>'TS' , -value => "$TS" , -size=>5 , -istyle=>4 ),"\n" ,
textfield( -name=>'TE' , -value => "$TE" , -size=>5 , -istyle=>4 ),"\n" ,
checkbox_group( -name=>'TODO' , -values=>['ToDo'] , -default => [] ) ,
br , "\n" ;
print "項目:" ,
textfield( -name=>'SUB' , -size=>20 , -value=>$SUB ) , br ;
print textarea( -name=>'DES' , -cols=>20 , -rows=>5, -default=>$DES ) , br ;
print submit( -label => '登録' ) , "\n" ;
print end_form() ;
print "
\n$form_footer" ;
}
# カレンダーファイルの読み込み。
#sub read_calendar( $ ) {
# local( $user ) = @_ ;
# if ( -f "$calendar_dir/$user.ics" ) {
# my $filename = "$calendar_dir/$user.ics" ;
# return Data::ICal->new( filename => $filename ) ;
# } else {
# die( "Can't find $calendar_dir/$user.ics" ) ;
# }
#}
sub read_calendar( $ ) {
local( $user ) = @_ ;
my $filename = "$calendar_dir/$user.ics" ;
my @ans = () ;
if ( -f $filename ) {
open( FH , "$filename" ) || die( "Can't find $filename" ) ;
while( ) {
push( @ans , Jcode->new( $_ )->euc ) ;
}
close( FH ) ;
}
return @ans ;
}
sub gmtime_ical( $ ) {
local( $time ) = @_ ;
my @time = gmtime( $time ) ;
return sprintf( "%04d%02d%02dT%02d%02d%02dZ" ,
$time[ 5 ] + 1900 , $time[ 4 ] + 1 , $time[ 3 ] ,
$time[ 2 ] , $time[ 1 ] , $time[ 0 ] ) ;
}
sub localtime_ical( $ ) {
local( $time ) = @_ ;
my @time = localtime( $time ) ;
return sprintf( "%04d%02d%02dT%02d%02d%02d" ,
$time[ 5 ] + 1900 , $time[ 4 ] + 1 , $time[ 3 ] ,
$time[ 2 ] , $time[ 1 ] , $time[ 0 ] ) ;
}
sub localtime_day_ical( $ ) {
local( $time ) = @_ ;
my @time = localtime( $time ) ;
return sprintf( "%04d%02d%02d" , $time[ 5 ] + 1900 , $time[ 4 ] + 1 , $time[ 3 ] ) ;
}
sub uuid( $ ) {
local( $time ) = @_ ;
return "uuid$time$PID" ;
}
sub description_nocrlf( $ ) {
local( $str ) = @_ ;
$str =~ s/[\r\n]//g ;
return $str ;
}
# 新しい ToDo を作成
sub new_todo() {
my $time = time() ;
my $now = gmtime_ical( $time ) ;
return "BEGIN:VTODO\r\n"
."CREATED:$now\r\n"
."LAST-MODIFIED:$now\r\n"
."UID:".uuid( $time )."\r\n"
."SUMMARY:".Jcode->new( $SUB )->euc."\r\n"
.($DES ne "" ? "DESCRIPTION:".description_nocrlf( Jcode->new( $DES )->euc )."\r\n" : "")
."STATUS:INCOMPLETED\r\n"
."END:VTODO\r\n" ;
}
# 新しい Event を作成
sub new_event( $ ) {
local( $tz ) = @_ ;
my $time = time() ;
my $now = gmtime_ical( $time ) ;
my $dtstart , $dtend ;
if ( $TS eq "" ) {
my $local = Time::Local::timelocal_nocheck( 0 , 0 , 0 , $D , $M - 1 , $Y - 1900 ) ;
$dtstart = "DTSTART;VALUE=DATE;TZID=$tz:"
.localtime_day_ical( $local ) ;
$dtend = "DTEND;VALUE=DATE;TZID=$tz:"
.localtime_day_ical( $local + 3600 * 24 ) ;
} else {
$TS =~ /^(\d+):(\d+)$/ ;
my $local = Time::Local::timelocal_nocheck( 0 , $2 , $1 , $D , $M - 1 , $Y - 1900 ) ;
$dtstart = "DTSTART;TZID=$tz:"
.localtime_ical( $local ) ;
if ( $TE eq "" ) {
$dtend = "DTEND;TZID=$tz:".localtime_ical( $local + 3600 ) ;
} else {
$TE =~ /^(\d+):(\d+)$/ ;
$dtend = "DTEND;TZID=$tz:"
.localtime_ical( Time::Local::timelocal_nocheck( 0 , $2 , $1 , $D , $M - 1 , $Y - 1900 ) ) ;
}
}
return "BEGIN:VEVENT\r\n"
."CREATED:$now\r\n"
."LAST-MODIFIED:$now\r\n"
."DTSTAMP:$now\r\n"
."UID:".uuid( $time )."\r\n"
."SUMMARY:".Jcode->new( $SUB )->euc."\r\n"
.($DES ne "" ? "DESCRIPTION:".description_nocrlf( Jcode->new( $DES )->euc )."\r\n" : "")
.($dtstart ne "" ? "$dtstart\r\n" : "")
.($dtend ne "" ? "$dtend\r\n" : "")
."END:VEVENT\r\n" ;
}
sub new_ical( $ ) {
local( $tz ) = @_ ;
if ( $TODO ne "" ) {
return new_todo() ;
} else {
return new_event( $tz ) ;
}
}
#-----------------------------------------
print header( -charset => $cgi_charset ) ;
print start_html( -title => 'iCalendar Entry' ,
-charset => $cgi_charset ,
-encoding => $cgi_charset ,
-lang => $cgi_charset ,
-head => Link( {-rel=>'stylesheet',
-type=>'text/css',
-href=>'/style.css'} )) ;
#-----------------------------------------
if ( $U ne "" && $SUB ne "" ) {
print "カレンダー登録しました
" ;
print "カレンダー名: $U
\n" ;
if ( $TODO ne "" ) {
print "ToDo:
\n" ;
} else {
printf( "日付:%04d/%02d/%02d
\n" , $Y , $M , $D ) ;
print "時間:$TS-$TE
\n" ;
}
print "タイトル:".escapeHTML($SUB)."
\n" ;
if ( $DES ne "" ) {
print "詳細:".escapeHTML($DES)."
\n" ;
}
print "
\n$entry_footer" ;
# カレンダーファイルの読み込み
my @calendar = read_calendar( $U ) ;
# TZID の取得
my $tzid = "" ;
foreach $line ( @calendar ) {
if ( $line =~ /^(DTSTART|DTEND);(.*;|)TZID=([^:]+):/ ) {
$tzid = $3 ;
last ;
}
}
my $entry = new_ical( $tzid ) ;
# 追加した iCalendar を暫定ファイルに出力
open( FH , ">$calendar_dir/.$U.ics.new" )
|| die( "Can't write $calendar_dir/.$U.ics.new" ) ;
my $notout = 1 ;
foreach $line ( @calendar ) {
if ( $notout && $line =~ /^BEGIN:VTIMEZONE\r*$/ ) {
print FH Jcode->new( $entry )->utf8 ;
$notout = 0 ;
}
print FH Jcode->new( $line )->utf8 ;
}
close( FH ) ;
# 暫定ファイルを正式ファイルに置き換える
if ( -f "$calendar_dir/.$U.ics.new" ) {
unlink( "$calendar_dir/.$U.ics.bak" ) if ( -f "$calendar_dir/.$U.ics.bak" ) ;
rename( "$calendar_dir/$U.ics" , "$calendar_dir/.$U.ics.bak" ) ;
rename( "$calendar_dir/.$U.ics.new" , "$calendar_dir/$U.ics" ) ;
}
} else {
print "カレンダー登録
" ;
form() ;
}
print end_html ;