#!/usr/bin/perl

# 暫定バージョン
use Time::Local ;

#-----------------------------------------
# 設定変更箇所
#-----------------------------------------
my $calendar_dir = "/var/...PATH.../calendar" ;

my $cgi_charset  = "EUC-JP" ;	# CGI が出力する文字コード

# 画面下に表示する関連リンク
my $entry_footer = "[ <A HREF='entry.cgi?U=$U'>新項目の入力</A> | <A HREF='./?cal=$U'>iCalendar</A> ]" ;
my $form_footer  = "[ <A HREF='./?cal=$U'>iCalendar</A> ]" ;

#-----------------------------------------
# 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 "<HR>\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( <FH> ) {
      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 "<h2 class='blue'>カレンダー登録しました</h2>" ;
  print "カレンダー名: $U<BR>\n" ;
  if ( $TODO ne "" ) {
    print "ToDo:<BR>\n" ;
  } else {
    printf( "日付：%04d/%02d/%02d<BR>\n" , $Y , $M , $D ) ;
    print "時間：$TS-$TE<BR>\n" ;
  }
  print "タイトル：".escapeHTML($SUB)."<BR>\n" ;
  if ( $DES ne "" ) {
    print "詳細：".escapeHTML($DES)."<BR>\n" ;
  }
  print "<HR>\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 "<h2 class='blue'>カレンダー登録</h2>" ;
  form() ;
}

print end_html ;