# HG changeset patch
# User Shinji KONO <kono@ie.u-ryukyu.ac.jp>
# Date 1314955796 -32400
# Node ID 1fc0675b44cd7de7c114cbdc3cdf2795453dbff4

hg init

diff -r 000000000000 -r 1fc0675b44cd Calcon.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Calcon.pm	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,4377 @@
+package Calcon;
+
+## $Id: Calcon.pm,v 1.14 2008/11/08 05:24:55 kono Exp $
+
+use 5.008;
+use strict;
+# use warnings; we have -w, so why we need this?
+
+#require Exporter;
+
+#our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration	use Calcon ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+#our %EXPORT_TAGS = ( 'all' => [ qw(
+#	
+#) ] );
+
+#our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+#our @EXPORT = qw(
+
+#);
+
+our $VERSION = '0.02';
+
+
+# Preloaded methods go here.
+
+# if you don't have NKF
+# package Calcon::NKF;
+#
+# コード変換しなくても動くことは動くけど、いくつか問題がある。
+#
+# sub nkf {
+#    return shift(@_);
+# }
+
+# デバッグ中に本当にこのパッケージを見ているかどうかの確認用。
+# print STDERR "new versoin!!\n";
+
+#######################################################################/
+
+package Calcon::Basic ;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ();
+
+# このパッケージ用の汎用ライブラリ。Date や Record などの
+# ファクトリーもここにある。Read/Write の両方から参照される。
+# Date/Record の実装を変えたいときは、ここを変更する。
+
+my $date_class = 'Calcon::Date';
+my $record_class = 'Calcon::Record';
+
+sub new {
+   my ($this,$opts,$file) = @_;
+   # ClassName->new で呼び出される時のためにこれがある。Perl の決り文句。
+   my $class = ref($this) || $this;
+   my $self = {};
+   bless $self, $class;
+   # 入出力ファイル名
+   $self->{'-file'} = $file if ($file);
+   $self->option($opts);
+   $self->initialize();  # this calls sub class' initializer.
+   return $self;
+}
+
+# 下位クラスから呼び出される初期化。ここでは何もしない。
+# new で呼ばれたinitilize は、段階的に SUPER::initilalize を呼び出す。
+# 最終的に、基底クラスである Calcon::Basic (Calcon そのものであるべき?)
+# の initialize を呼び出す。呼び出されるのだから用意しておく必要がある。
+
+sub initialize {
+    my ($self) = @_;
+}
+
+# option 関係。
+
+sub set_debug {
+    my ($self,$flag) = @_;
+    $self->{'-debug'} = $flag;
+}
+
+sub option {
+    my ($self,$option) = @_;
+
+    return if (! defined($option));
+    foreach my $opt ( $option =~ /./g ) {
+        if ($opt eq '-') {
+        } elsif ($opt eq 'n') {
+            $self->{'-file-out'} = 1;
+        } elsif ($opt eq 'd') {
+            $self->set_debug(1);
+        } elsif ($opt eq 'a') {
+            $self->{'-address-only'} = 1;
+        } elsif ($opt eq 'c') {
+            $self->{'-calendar-only'} = 1;
+        } elsif ($opt eq 'F') {
+            $self->{'-future-only'} = 1;
+        } elsif ($opt eq 't') {
+            $self->{'-tomorrow'} = 1;
+        } elsif ($opt eq 'C') {
+            $self->{'-count'} = 5;
+        }
+    }
+}
+
+# デバッグ用レコード表示ルーチン。
+
+sub show {
+    my ($self,$record) = @_;
+    $record->show();
+}
+
+# 時間関係のライブラリ
+
+sub localtime {
+    my ($self,$date) = @_;
+    return $date->localtime();
+}
+
+sub date {
+    my ($self,$date) = @_;
+    return $date->date();
+}
+
+sub today {
+    $date_class->today;
+}
+
+sub unix_time {
+    my ($self,$date) = @_;
+    return $date->unix_time();
+}
+
+# Factory Pattern
+
+sub make_date_unix {
+    my ($self,$date) = @_;
+    return $date_class->make_date_unix($date);
+}
+
+sub make_date {
+    my ($self,$date) = @_;
+    return $date_class->make_date($date);
+}
+
+sub make_record {
+    my ($self) = @_;
+    my %record;
+    my $record = \%record;
+    bless $record,$record_class;
+}
+
+#######################################################################/
+
+package Calcon::Record ;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Time::Local;
+@ISA = ();
+
+# 変換に用いる中間データ形式。オブジェクトにすると、デバッグの
+# 時に便利。
+
+sub show {
+    my ($self) = @_;
+    foreach my $key (keys %$self) {
+	my $value = $self->{$key};
+	if (ref $value) {
+	    $value = $value->value();
+	}
+	print "$key: $value\n" if (defined($value) && $value ne '');
+    }
+    print "\n";
+}
+
+# 中身を文字列で返す。
+
+sub value {
+    my ($self) = @_;
+    my $data;
+    foreach my $key (keys %$self) {
+	my $value = $self->{$key};
+	if (ref $value) {
+	    $value = $value->value();
+	}
+	$data .= "$key: $value\n" if (defined($value) && $value ne '');
+    }
+    $data;
+}
+
+# 等しいかどうか
+
+sub equal {
+    my ($self,$record) = @_;
+
+    foreach my $key (keys %{$self}) {
+	next if (!defined $self->{$key} && !defined $record->{$key});
+	if(ref $self->{$key} && ref $record->{$key}) {
+	    return 0 if (! $self->{$key}->equal($record->{$key}));
+	} else {
+	    return 0 if ($self->{$key} ne $record->{$key});
+	}
+    }
+    return 1;
+}
+
+# 与えられたレコードリストに含まれる情報しか持っていないかどうか
+
+sub information_in_list {
+    my ($self,$records) = @_;
+
+    my $lines;
+    foreach my $record (@$records) {
+	foreach my $key (keys %{$record}) {
+	    my $value;
+	    if (ref $record->{$key}) {
+		$value = $record->{$key}->value();
+	    } else {
+		$value = $record->{$key};
+	    }
+	    foreach my $line (split(/\n/,$value)) {
+		$line =~ s/\s+/ /g;
+		next if (! $line);
+		$lines->{$line} = $key;
+	    }
+	}
+    }
+    return $lines;
+}
+
+# 与えられたレコードリストに対して相対的に新しい情報だけのレコードを作る。 
+
+sub new_information {
+    my ($self,$records) = @_;
+    my $lines = $self->information_in_list($records);
+
+    my $info;
+    foreach my $key (keys %{$self}) {
+	my $value;
+	if (ref $self->{$key}) {
+	    $value = $self->{$key}->value();
+	} else {
+	    $value = $self->{$key};
+	}
+	foreach my $line (split(/\n/,$value)) {
+	    $line =~ s/\s+/ /g;
+	    next if (! $line);
+	    next if (defined $lines->{$line}) ;
+	    if (defined $info->{$key}) { $info->{$key} .= "\n$line";}
+	    else { $info->{$key} .= $line; }
+	}
+    }
+    if(defined $info) {
+	bless $info ;
+
+	# 必要なキーを残す
+
+	$info->{'-date'} = $records->[0]->{'-date'} 
+	    if (defined ($records->[0]->{'-date'})) ;
+	$info->{'-name'} = $records->[0]->{'-name'} 
+	    if (defined ($records->[0]->{'-name'})) ;
+	# else error だけど、まぁ、良い。
+    }
+    $info;
+}
+
+# 与えられたリストにおなじ値を持つレコードが含まれているかどうか
+
+sub is_included {
+    my ($self,$records) = @_;
+    my $lines = $self->information_in_list($records);
+
+    foreach my $key (keys %{$self}) {
+	my $value;
+	if (ref $self->{$key}) {
+	    $value = $self->{$key}->value();
+	} else {
+	    $value = $self->{$key};
+	}
+	foreach my $line (split(/\n/,$value)) {
+	    $line =~ s/\s+/ /g;
+	    next if (! $line);
+	    return 0 if (! defined $lines->{$line}) ;
+	}
+    }
+    return 1;
+}
+
+#######################################################################/
+
+package Calcon::Date ;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Time::Local;
+@ISA = ();
+
+# 日付に関するオブジェクト
+#   Perl に標準なものがあるんだろうけど。
+# record とおなじインタフェースを持つべき
+
+my @monthname = ( 'Jan','Feb', 'Mar', 'Apr', 'May', 'Jun',
+     'Jul','Aug','Sep','Oct','Nov', 'Dec');
+my %monthname;
+my $i;
+foreach my $name (@monthname) { $monthname{$name} = $i++; }
+
+# use unix time scalar as an object
+#     < 1902/1/1-12/31         date in every year
+#     1903/1/1    00:00-23:59  time in evey day
+#     1903/1/1-7               every weekday
+# It is better to use [$date,$tags] array for this class.
+# あんまり良い実装じゃないね。せこすぎ。
+
+my $every_day_min = timelocal(0,0,0,1,0,1902);
+my $every_day_max = timelocal(0,0,0,1,0,1903);
+my $every_time_min = timelocal(0,0,0,1,0,1903);
+my $every_time_max = timelocal(59,59,23,1,0,1903);
+my $every_weekday_min = timelocal(0,0,0,4,0,1903); # Sunday
+my $every_weekday_max = timelocal(0,0,0,11,0,1903);# Sunday
+
+my $today = time - 24*3600;
+
+my %week = (
+    'Sun'=> timelocal(0,0,0,4,0,1903),
+    'Mon'=> timelocal(0,0,0,5,0,1903),
+    'Tue'=> timelocal(0,0,0,6,0,1903),
+    'Wed'=> timelocal(0,0,0,7,0,1903),
+    'Thu'=> timelocal(0,0,0,8,0,1903),
+    'Fri'=> timelocal(0,0,0,9,0,1903),
+    'Sat'=> timelocal(0,0,0,10,0,1903),
+);
+my @week_name = (
+    'Sun',
+    'Mon',
+    'Tue',
+    'Wed',
+    'Thu',
+    'Fri',
+    'Sat',
+);
+
+sub is_allday {
+    my ($self) = @_;
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+	   localtime($$self);
+    return ($sec==0 && $min==0 && $hour==0);
+}
+
+sub is_day {
+    my ($self) = @_;
+    return ( $every_day_min <= $$self && $$self < $every_day_max );
+}
+
+sub is_time {
+    my ($date) = @_;
+    return ( $every_time_min <= $$date && $$date < $every_time_max );
+}
+
+sub future {
+    my ($self) = @_;
+    return ( $$self >= $today );
+}
+
+sub tomorrow {
+    my ($self) = @_;
+    return ( $today+24*3600*2 >= $$self && $$self >= $today-24*3600/2);
+}
+
+sub is_weekday {
+    my ($date) = @_;
+    return ( $every_weekday_min <= $$date && $$date < $every_weekday_max );
+}
+
+sub localtime {
+    my ($self) = @_;
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+	   localtime($$self);
+    return ($year+1900,$mon+1,$mday,$hour,$min);
+}
+
+sub make_date {
+    my ($self,$date) = @_;
+    my ($year,$month,$day,$hour);
+    my ($sec,$min);
+
+    $hour = $min = $sec = 0;
+
+    if ($date =~ m-(\d+)/(\d+)/(\d+)-) {
+	# $year = $1 - 1900;     this is no longer good for timelocal
+	$year = $1;
+	$month = $2-1;
+	$day = $3;
+    } elsif ($date =~ m-(\d+)/(\d+)-) {
+	$year = 1902;
+	$month = $1-1;
+	$day = $2;
+    } else {
+	if ($week{$date}) {
+	    my $weekday  = $week{$date};
+	    bless $date;
+	    return $date;
+	}
+	if ($date =~ m-(\d+):(\d+)-) {
+	    $hour = $1;
+	    $min = $2;
+	}
+	$year = 1903; $month = 0; $day = 1;
+	return &make_date1($year,$month,$day,$hour,$min,$sec);
+    }
+    if ($date =~ m-(\d+):(\d+)-) {
+	$hour = $1;
+	$min = $2;
+    }
+    return &make_date1($year,$month,$day,$hour,$min,$sec);
+}
+
+sub make_date1 {
+    my ($year,$month,$day,$hour,$min,$sec) = @_;
+    my ($date,$self);
+
+    if ( eval '$date = timelocal($sec,$min,$hour,$day,$month,$year)' ) {
+    } else {
+	$date = timelocal(0,0,0,1,0,70);
+    }
+    $self = \$date;
+    bless $self;
+}
+
+sub make_date_unix {
+    my ($self,$date) = @_;
+    $self = \$date;
+    bless $self;
+}
+
+sub date {
+    my ($self) = @_;
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+	   CORE::localtime($$self);
+    my $date;
+    if ($self->is_day()) {
+	$date = ($mon+1)."/$mday";
+    } elsif ($self->is_weekday()) {
+	return $week_name[$wday];
+    } elsif ($self->is_time()) {
+        $date = sprintf(" %02d:%02d",$hour,$min) if ($hour || $min);
+    } else {
+	$date = ($year+1900)."/".($mon+1)."/$mday";
+	$date .= sprintf(" %02d:%02d",$hour,$min) if ($hour || $min);
+    }
+    return $date;
+}
+
+sub unix_time {
+    my ($self) = @_;
+    $$self;
+}
+
+sub add {
+    my ($self,$add) = @_;
+    my ($result);
+    return $self if (!defined($add));
+    $result = $$self + $add;
+    bless \$result;
+}
+
+sub date_after {
+    my ($self,$day2) = @_;
+    return $$self<$$day2;
+}
+
+sub today {
+    my $today = time;
+    bless \$today;
+}
+
+# record のインタフェース
+
+sub show  {
+    my ($self) = @_;
+    print $self->date();
+}
+
+sub value {
+    my ($self) = @_;
+    $self->date();
+}
+
+sub equal {
+    my ($self,$date) = @_;
+    return ($self->unix_time() !=  $date->unix_time());
+}
+
+#######################################################################/
+
+package Calcon::Reader ;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = (  'Calcon::Basic' );
+
+# Reader の基底クラス
+
+#  Reader は decode method を持つ必要がある。
+
+sub decode {
+    my ($self) = @_;
+}
+
+sub set_output{
+    my ($self,$out) = @_;
+    $self->{'-output'} = $out;
+}
+
+# date_normalize は Date クラスに変換するので、Reader は必ず
+# 呼ぶ必要がある。少し汎用すぎるか?
+
+sub date_normalize {
+    my ($self,$keys,$record) = @_;
+    my ($sday,$stime,$eday,$etime);
+
+    if ($record->{'birth'}) {
+	$record->{'birth'} = $self->make_date($record->{'birth'});
+    }
+    if ($record->{'modify-date'}) {
+	$record->{'modify-date'} = $self->make_date($record->{'modify-date'});
+    }
+    return if (! $record->{'date'}); # internal error
+# print ">**$record->{'date'}***\n";
+# print ">**$record->{'end-date'}***\n";
+# print ">**$record->{'time'}***\n";
+# print ">**$record->{'end-time'}***\n";
+    # warning killer
+    if (! defined($record->{'date'})) { $record->{'date'} = '';}
+    if (! defined($record->{'time'})) { $record->{'time'} = '';}
+    if (! defined($record->{'end-time'})) { $record->{'end-time'} = '';}
+    if (! defined($record->{'end-date'})) { $record->{'end-date'} = '';}
+    $sday = $eday = $stime = $etime = '';
+
+    if ($record->{'time'} =~ /(\d+:\d+)\s*-\s*(\d+:\d+)/) {
+	$stime = $1; $etime = $2;
+    } elsif ($record->{'time'} =~ /(\d+:\d+)/) {
+	$stime = $1;
+    }
+    if ($record->{'date'} =~ /(\d+\/\d+\/\d+).*\s+(\d+:\d+)\s*-(\d+\/\d+\/\d+).*\s*(\d+:\d+)/) {
+	$sday = $1; $stime = $2; $eday = $3; $etime = $4;
+    } elsif ($record->{'date'} =~ /(\d+\/\d+\/\d+).*\s+(\d+:\d+)\s*-\s*(\d+:\d+)/) {
+	$sday = $1; $stime = $2; $etime = $3;
+    } elsif ($record->{'date'} =~ /(\d+\/\d+\/\d+).*\s+(\d+:\d+)/) {
+	$sday = $1; $stime = $2; 
+    } elsif ($record->{'date'} =~ /(\d+\/\d+\/\d+)/) {
+	$sday = $1;
+    }
+
+    # これらのチェックで end-time などが作られてしまうみたい。本来は、
+    # defined で避けるべきなんだろうが...
+
+    if ($record->{'end-time'} =~ /(\d+:\d+)/) {
+	$etime = $1;
+    }
+    if ($record->{'end-date'} =~ /(\d+\/\d+\/\d+).*\s+(\d+:\d+)/) {
+	$eday = $1; $etime = $2;
+    } elsif ($record->{'end-date'} =~ /(\d+\/\d+\/\d+)/) {
+	$eday = $1;
+    } elsif ( $etime ) {
+	$eday = $sday;
+    }
+
+    $sday = $self->make_date("$sday $stime");
+    if ($eday) {
+	$eday = $self->make_date("$eday $etime");
+	if ($eday->date_after($sday)) {
+	    undef $eday;
+	}
+    }
+
+    # いったん消しておいて、
+    foreach my $key ('end-date','date', 'time','end-time') {
+	undef $record->{$key};
+    }
+    @$keys = grep(!/^end-date|^date|^time|^end-time/,@$keys);
+
+    # もう一回作る。まったくね。
+
+# print "@$keys\n";
+    if ($eday) {
+	$record->{'end-date'} = $eday;
+	unshift(@$keys,'end-date');
+    }
+    $record->{'date'} = $sday;
+    unshift(@$keys,'date');
+
+# print "@$keys\n";
+# print "***$record->{'date'}***\n";
+# print "***$record->{'end-date'}***\n";
+}
+
+#######################################################################/
+
+package Calcon::Writer ;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Basic' );
+use Carp;
+
+# Writer の基底クラス
+
+# Why this class is necessary?
+sub initialize {
+    my ($self) = @_;
+
+    # 書き出しファイルの切替え
+    # directory などに出力する場合は、-file を undef する。
+    if (defined $self->{'-file'}) {
+	open(OUT,">".$self->{'-file'}) or 
+	    croak("Can't open $self->{'-file'}:$!\n");
+	select OUT;
+    }
+    # いらないのは知っているが、拡張するかも知れないので。
+    $self->SUPER::initialize();
+}
+
+#   Writer の基本インタフェース (必ず上書きされる)
+#     Perl にもインタフェースが欲しいよね。
+
+sub start_file {
+    my ($self,$type) = @_;
+}
+
+sub end_file {
+    my ($self,$type) = @_;
+}
+
+sub record {
+    my ($self,$record,$key) = @_;
+}
+
+
+#######################################################################/
+
+package Calcon::File_write ;
+
+# ファイル形式への書き出し
+#    key: データ
+# レコードのセパレータは "\n\n"
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ('Calcon::Writer');
+
+sub record {
+    my ($self,$keys,$items) = @_;
+    my @keys = @$keys;
+    my %items = %$items;
+    # should be override
+    if ($items->{'date'}) { return if ($self->{'-future-only'} && ! $items->{'date'}->future()); }
+    foreach my $key (@keys) {
+	my $value = $items{$key};
+	if (ref $value) {
+	    $value = $value->value();
+	}
+	print "$key: $value\n" if (defined($value) && $value ne '');
+    }
+    print "\n";
+}
+
+#######################################################################/
+
+package Calcon::Print_write ;
+
+# 印刷形式。login時に表示するコンパクトな形式。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ('Calcon::Writer');
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    if ($self->{'-tomorrow'}) {
+	$self->{'-count'} = 5;
+    } else {
+	$self->{'-count'} = -1;
+    }
+}
+
+sub record {
+    my ($self,$keys,$items) = @_;
+    my @keys = @$keys;
+    my %items = %$items;
+    # should be override
+    if (defined $items->{'date'}) { 
+        my $date = $items->{'date'};
+	return if ($self->{'-future-only'} && ! $date->future()); 
+	return if ($self->{'-tomorrow'} && ! $date->tomorrow()); 
+	return if ($self->{'-count'} == 0);
+	$self->{'-count'} --;
+	$date = $date->date();
+	my $memo ='';
+	$memo = $items->{'summary'} if (defined($items->{'summary'}));
+	$memo .= $items->{'memo'} if (defined($items->{'memo'}));
+	$memo =~ s/\n+$//;
+	if ($self->{'-tomorrow'}) {
+	    print nkf('-w',"$date:\t$memo\n");
+	} else {
+	    $memo =~ s/^/$date:\t/mg;
+	    print nkf('-w',"$memo\n");
+	}
+    } else {
+	foreach my $key (@keys) {
+	    my $value = $items{$key};
+	    if (ref $value) {
+		$value = $value->value();
+	    }
+	    print nkf('-j',"$key: $value\n") if (defined($value) && $value ne '');
+	}
+	print "\n";
+    }
+}
+
+#######################################################################/
+
+package Calcon::Zaurus;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ();
+
+# ザウルス関連の基底クラス
+# フレーバとして使うので new がない。
+# 使用するクラスはZaurus_initialize を呼び出す必要がある。
+
+my %item_type = (
+'ADR1'=>'s', 'ADR2'=>'s', 'ALRM'=>'d', 'ANN1'=>'d', 'ANN2'=>'d', 'ATSC'=>'u',
+'ATTM'=>'u', 'ATTR'=>'u', 'BRTH'=>'d', 'CFIP'=>'s', 'CHK1'=>'b', 'CHK2'=>'b',
+'CHK3'=>'b', 'CHK4'=>'b', 'CLAS'=>'s', 'CLSC'=>'u', 'CNTC'=>'u', 'COLR'=>'u',
+'CPS1'=>'s', 'CTGR'=>'u', 'DB01'=>'u', 'DB02'=>'u', 'DB03'=>'u', 'DB04'=>'u',
+'DB05'=>'u', 'DB06'=>'u', 'DB07'=>'u', 'DB08'=>'u', 'DB09'=>'u', 'DB10'=>'u',
+'DB11'=>'u', 'DB12'=>'u', 'DB13'=>'u', 'DB14'=>'u', 'DB15'=>'u', 'DB16'=>'u',
+'DB17'=>'u', 'DB18'=>'u', 'DB19'=>'u', 'DB20'=>'u', 'DB21'=>'u', 'DB22'=>'u',
+'DB23'=>'u', 'DB24'=>'u', 'DB25'=>'u', 'DB26'=>'u', 'DB27'=>'u', 'DB28'=>'u',
+'DBFN'=>'u', 'DBID'=>'u', 'DBIT'=>'u', 'DBSI'=>'u', 'DBST'=>'u', 'DNS1'=>'s',
+'DNS2'=>'s', 'ECDT'=>'u', 'EDDY'=>'d', 'EDTM'=>'d', 'ETDY'=>'d', 'FAX1'=>'s',
+'FAX2'=>'s', 'FINF'=>'b', 'FNDY'=>'d', 'HOL1'=>'d', 'HTXT'=>'h', 'IMG1'=>'i',
+'IMGF'=>'g', 'IMJG'=>'j', 'IORR'=>'b', 'LKDT'=>'d', 'LKIF'=>'u', 'LTDY'=>'d',
+'MAL1'=>'s', 'MARK'=>'u', 'MEM1'=>'s', 'MLAD'=>'s', 'MLCC'=>'s', 'MLFM'=>'s',
+'MLID'=>'u', 'MLRP'=>'s', 'MLTO'=>'u', 'MPFB'=>'s', 'NAME'=>'s', 'NAPR'=>'s',
+'NMSK'=>'s', 'OFCE'=>'s', 'OFPR'=>'s', 'OPT1'=>'u', 'OPT2'=>'u', 'PGR1'=>'s',
+'POPA'=>'s', 'POPP'=>'s', 'PRBD'=>'u', 'PRF1'=>'u', 'PRTY'=>'u', 'PSTN'=>'s',
+'PSWD'=>'s', 'RCCK'=>'b', 'RDCK'=>'b', 'RMRK'=>'s', 'RVTM'=>'u', 'SBJT'=>'u',
+'SCCP'=>'s', 'SCTG'=>'u', 'SCTN'=>'s', 'SDDT'=>'d', 'SDTM'=>'u', 'SPKS'=>'s',
+'STDY'=>'d', 'SVAD'=>'s', 'TCPS'=>'u', 'TEL1'=>'s', 'TEL2'=>'s', 'TIM1'=>'d',
+'TIM2'=>'d', 'TITL'=>'s', 'TMNL'=>'u', 'USID'=>'s', 'XLIF'=>'u', 'ZCCP'=>'s',
+'ZIP2'=>'s', 'ZIPC'=>'s', 'ZPKS'=>'s', 'ZRTF'=>'u', 'ZXLS'=>'u', 'mDTM'=>'d',
+'mISC'=>'u', 'tPID'=>'u', 
+);
+
+my %item_name = (
+    'FNDY'=>'finish-date',
+    'ETDY'=>'start-date',
+    'LTDY'=>'deadline',
+    'STDY'=>'start-date',
+    'ADR1'=>'home-address',
+    'ADR2'=>'address',
+    'ANN1'=>'anniversary',
+    'BRTH'=>'birth',
+    'CLAS'=>'class',
+    'CPS1'=>'mobile-tel',
+    'DNS1'=>'DNS 1',
+    'DNS2'=>'DNS 2',
+    'EDTM'=>'edit-time',
+    'FAX1'=>'home-fax',
+    'FAX2'=>'fax',
+    'HTXT'=>'hand-text',
+    'IMG1'=>'image',
+    'IMGF'=>'gif',
+    'IMJG'=>'jpg',
+    'LKDT'=>'link-date',
+    'MAL1'=>'mail',
+    'MEM1'=>'memo',
+    'MLAD'=>'mail-adderess',
+    'MLTO'=>'mail-to',
+    'NAME'=>'name',
+    'NAPR'=>'name-yomi',
+    'NMSK'=>'mask',
+    'OFCE'=>'office',
+    'OFPR'=>'office-yomi',
+    'POPA'=>'pop 1',
+    'POPP'=>'pop p',
+    'PSTN'=>'position',
+    'PSWD'=>'password',
+    'RMRK'=>'remark',
+    'SCCP'=>'sccp',
+    'SCTN'=>'section',
+    'SDTM'=>'sdtm',
+    'SPKS'=>'spks',
+    'SVAD'=>'cvad',
+    'TEL1'=>'home-tel',
+    'TEL2'=>'tel',
+    'TIM1'=>'date',
+    'TIM2'=>'end-date',
+    'TITL'=>'title',
+    'USID'=>'user id',
+    'ZCCP'=>'zccp',
+    'ZIP2'=>'home-zip',
+    'ZIPC'=>'zip',
+    'ZPKS'=>'packats',
+    'mDTM'=>'modify-date',
+);
+
+
+sub Zaurus_initialize {
+    my ($self) = @_;
+    $self->{'-item_type'} = \%item_type;
+    $self->{'-item_name'} = \%item_name;
+    $self->{'-offset'} = 8;
+}
+
+# ザウルスのBOX形式に格納されている属性名リストの取出
+
+sub item_list {
+    my ($self,$data) = @_;
+    my ($value,@index);
+    my ($debug) = $self->{'-debug'};
+
+    my $title_offset;
+    my $title_len = 0;
+    my $field_offset;
+
+    my $version = unpack("n",substr($data,2,2));
+    $self->{'-zaurus-version'} = $version;
+    # $title_offset += ($version < 0x1030)?2:0;
+
+    if ($version <= 0x1002 ) {
+	$title_offset = 0x15;
+	$self->{'-title-begin'} = $title_offset;
+	$field_offset = 1;
+    } elsif ($version < 0x1030 ) {
+	$title_offset =  unpack("V",substr($data,0x8,4));
+	$self->{'-title-begin'} = $title_offset;
+	$title_offset += 2;
+	$field_offset = 2;
+    } else {
+	$title_offset =  unpack("V",substr($data,0x8,4));
+	$self->{'-title-begin'} = $title_offset;
+	$field_offset = 2;
+    }
+
+    my $title_count =  ord(substr($data,$title_offset,1));
+    my $ptr = $title_offset+1;
+    my $i = 0;
+    print "\n\nfile:",$self->{'-file'},"\n\n" 
+        if ($debug && defined ($self->{'-file'}));
+    while($title_count-->0) {
+	my $item_len =  ord(substr($data,$ptr,1));
+	$ptr += 2;
+	# print "item: ",unpack("H*",substr($data,$ptr,$item_len)) if ($debug);
+	my $id = $self->{'-item_id'}->[$i] = substr($data,$ptr+$field_offset,4);
+	my $name = $self->{'-item_name1'}->[$i] = 
+		substr($data,$ptr+5,$item_len-5);
+	print "list:\t$i:$id:$item_len:$name\n" if ($debug);
+	$ptr += $item_len;
+	$i++;
+    }
+    print "title-len: $version $title_len ",$ptr - $title_offset,"\n" if ($debug);
+    $self->{'-item_name_count'} = $i;
+    $self->{'-title-length'} = $ptr-$title_offset;
+}
+
+
+#######################################################################/
+
+package Calcon::Zaurus_read ;
+
+# BOX 形式からの読み込み
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ('Calcon::Zaurus', 'Calcon::Reader');
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->Zaurus_initialize();
+
+    $self->{'-debug'} = 0;
+    $self->{'-offset'} = 8;
+    $self->{'-all'} = 0;
+    $self->{'-item_list'} = '';  # '' or 'original' or 'id'
+}
+
+sub read {
+    my ($self,$file) = @_;
+
+    $self->{'-file'} = $file;
+    open(F,"<".$file);
+
+    local($/) ;
+    undef $/;
+    my $data = <F>;
+    $data;
+}
+
+sub decode {
+    my ($self,$file) = @_;
+    my ($debug) = $self->{'-debug'};
+    my $out = $self->{'-output'};
+
+    my $data = $self -> read($file);
+    $self -> item_list($data);
+    $out->start_file($file);
+    print "Zaurus version: $self->{'-zaurus-version'}\n" if ($debug);
+    if ($self->{'-zaurus-version'} <= 0x1002) {
+	$self->decode_old_data($data);
+    } elsif ($self->{'-zaurus-version'} == 0x1030) {
+	$self->{'-offset'} = 10;
+	$self->decode_data($data);
+    } else {
+	$self->decode_data($data);
+    }
+    $out->end_file($file);
+}
+
+# 複雑なIndexの処理
+
+sub decode_index {
+    my ($self,$data) = @_;
+    my ($debug) = $self->{'-debug'};
+
+    my ($length) =  unpack("V",substr($data,0x10,4));
+    if ($self->{'-zaurus-version'} eq 0x1030) {
+	$length =  unpack("V",substr($data,0x8,4));
+    }
+    my $offset = 0x50;
+    my ($value,@index);
+    my $i;
+    my $flag;
+
+    do {
+	for($i=$offset;$i<$length;$i+=4) {
+	    $value = unpack("V",substr($data,$i,4));
+	    next if ($value == 0xffffffff);
+	    push(@index,$value) if ($value);
+	}
+	$offset = $value;
+	$flag = unpack("v",substr($data,$offset,2));
+
+	printf "next index %0x: %0x\n",$offset,"" if ($debug);
+	printf "flag: %0x\n",$flag if ($debug);
+
+	if ($self->{'-zaurus-version'} eq 0x1030) {
+	    $length = unpack("V",substr($data,$offset+2,4));
+	    $offset = $offset+6;
+	    $length += $offset;
+	} else {
+	    $length = unpack("v",substr($data,$offset+2,2));
+	    $offset = $offset+5;
+	    $length += $offset;
+	}
+	printf "next index length %0x\n",$length if ($debug);
+
+    } while ($flag == 0xfff0);
+
+    return @index;
+}
+
+# BOX形式の中のレコードの処理
+
+sub decode_data {
+    my ($self,$data) = @_;
+    my ($offset) = $self->{'-offset'};
+    my ($debug) = $self->{'-debug'};
+
+    my(@index) = $self->decode_index($data);
+
+    foreach my $index (@index) {
+	printf "index %0x: %s\n",$index,"" if ($debug);
+
+	last if (length(substr($data,$index,2))<2);
+	next if (substr($data,$index,2) eq "\xf0\xff");
+
+	my $record_number=ord(substr($data,$index,1)) +
+	    ord(substr($data,$index+1,1))*256;
+	my $record_len=ord(substr($data,$index+2,1)) +
+	    ord(substr($data,$index+3,1))*256;
+
+	my $item_count=ord(substr($data,$index+6,1));
+	my $item_dummy=ord(substr($data,$index+10,1));
+
+	my @len = ();
+	my $ptr = $index + $offset;
+	my $total_len = 0;
+        my $k = 1;
+        for(my $j=$self->{'-item_name_count'}; $j>0; $j--) {
+	    my $i=ord(substr($data,$ptr,1));
+	    if ($i>=0x80) {
+		$ptr++; 
+		$i = ord(substr($data,$ptr,1))+($i-0x80)*256;
+	    }
+	    print "len:$k:  $i\n" if ($debug);
+	    $k++;
+	    push(@len,$i);
+	    $total_len += $i;
+	    $ptr++;
+	}
+	printf "offset: %x\n",$ptr-$index if ($debug);
+
+	# $ptr = $index+40+$item_dummy; should be this kind of method...
+	# $ptr = $index+$record_len-$total_len+5;
+	# $ptr = $index+8+$item_count;
+
+
+	print "head: ",unpack("H*",substr($data,$index,50)),"\n" if ($debug);
+	print "body: ",unpack("H*",substr($data,$ptr,50)),"\n" if ($debug);
+
+	my $i = 0;
+	my $record = $self->make_record;
+	my @key_list = ();
+	foreach my $len (@len) {
+	    my ($key,$item,$type) = 
+		$self->decode_item($i,substr($data,$ptr,$len));
+	    if ($item) {
+		if ($type eq 's' || $type eq 'd') {
+		    push(@key_list,$key);
+		    $record->{$key} = $item;
+		} elsif ($self->{'-all'}) {
+		    push(@key_list,$key);
+		    $record->{$key} = $type.":".unpack("H*",$item);
+		}
+	    }
+	    $i++;
+	    $ptr += $len;
+	}
+	$self->date_normalize(\@key_list,$record);
+	$self->{'-output'}->record(\@key_list,$record);
+	print "\n" if ($debug);;
+    }
+}
+
+# たぶん、PI-7000以前の形式
+
+sub decode_old_data {
+    my ($self,$data) = @_;
+    my $debug = $self->{'-debug'};
+    my @len = ();
+    my $ptr = $self->{'-title-begin'} + $self->{'-title-length'};
+
+    my $old_number = 0;
+    while(1) {
+	my $record = $self->make_record;
+	my @key_list = ();
+
+	# my $record_number = ord(substr($data,$ptr++,1));
+	my $record_number = unpack("v",substr($data,$ptr,2));
+	my $optr = $ptr;
+	while ($record_number != $old_number+1) {
+	    # $record_number = ord(substr($data,$ptr++,1));
+            $ptr += 1;
+	    $record_number = unpack("v",substr($data,$ptr,2));
+	    return if ($ptr>length($data));
+	}
+	print "offset: ",$ptr-$optr,"\n" if ($debug && $optr<$ptr);
+        $ptr += 2;
+	my $record_length = unpack("v",substr($data,$ptr,2));
+	$ptr += 2;
+	print "record_number:  $record_number\n" if ($debug);
+	print "record_length:  $record_length\n" if ($debug);
+	$old_number = $record_number;
+	# last if ($record_length == 0);
+	my $record_end = $optr + $record_length+4; # - 3;
+	my $i = 0;
+	$ptr+=2;
+        for(my $j=$self->{'-item_name_count'}; $j>0; $j--) {
+	# while($ptr < $record_end) {
+	    my $len=ord(substr($data,$ptr++,1));
+	    if ($len>=0x80) {
+		$len = ord(substr($data,$ptr,1))+($len-0x80)*256;
+		$ptr++; 
+	    }
+	    print "len:  $len\n" if ($debug);
+	    print "data: ",substr($data,$ptr,$len),"\n" if ($debug);
+	    my ($key,$item,$type) = 
+		$self->decode_item($i,substr($data,$ptr,$len));
+	    if ($item) {
+		if ($type eq 's' || $type eq 'd') {
+		    push(@key_list,$key);
+		    $record->{$key} = $item;
+		} elsif ($self->{'-all'}) {
+		    push(@key_list,$key);
+		    $record->{$key} = $type.":".unpack("H*",$item);
+		}
+	    }
+	    $i++;
+	    $ptr += $len;
+	}
+	if ($debug && $ptr != $record_end) {
+	    print "record_end: $ptr $record_end\n";
+	}
+	$ptr = $record_end;
+	print "\n" if ($debug);;
+	$self->date_normalize(\@key_list,$record);
+	$self->{'-output'}->record(\@key_list,$record);
+        # }
+    }
+}
+
+sub decode_time {
+    my ($self,$t) = @_;
+
+    return '' if (! $t);
+    # print unpack("H*",substr($t,1,4)),"\n";
+
+    $t = hex(unpack("H*",substr($t,1,4)));
+    my $year =  ($t&0x0000000f)*16 ;
+    $year +=   (($t&0x0000f000)>>12) + 1900;
+    my $month = ($t&0x00000f00)>>8;
+    my $day =   ($t&0x00f80000)>>19;
+    my $min =   ($t&0x3f000000)>>24;
+    my $hour =((($t&0xc0000000)>>30)&0x3)<<0;
+    $hour +=   (($t&0x00070000)>>16)<<2;
+    if ($year == 2155) { # unspecified case
+	$t = sprintf("%d/%d",$month,$day);
+    } else {
+	$t = sprintf("%04d/%d/%d",$year,$month,$day);
+    }
+    if($min!=63) {
+        $t .= sprintf(" %02d:%02d",$hour,$min);
+    }
+    $t;
+}
+
+# Zaurus レコード中の可変長データを属性名とともに変換する。
+
+sub decode_item {
+    my ($self,$i,$item) = @_;
+    my $all = $self->{'-all'};
+    my $debug = $self->{'-debug'};
+
+    return if (! $item);
+    # print $self->{'-item_id'}->[$i],": ",unpack("H*",$item),"\n";
+    my $id_name =  $self->{'-item_id'}->[$i];
+    my $id_type =  $self->{'-item_type'}->{$id_name};
+
+    if ($self->{'-item_list'} eq 'original') {
+	$id_name = $self->{'-item_name1'}->[$i];
+    } elsif ($self->{'-item_list'} eq 'id') {
+    } elsif (defined $self->{'-item_name'}->{$id_name}) {
+	$id_name = $self->{'-item_name'}->{$id_name};
+    }
+
+    if ( $id_type eq 'd' ) {
+	$item = $self->decode_time($item);
+    }
+    return ($id_name,$item,$id_type);
+} 
+
+#######################################################################/
+
+package Calcon::Pool;
+
+# 差分などを取るための中間的なレコードバッファ
+# Unix の pipe みたいに使う
+# Writer/Reader を両方継承すべきかも知れない。けど、今のところ、Reader
+# を継承する利点は無い。decode ではなく、output を呼ぶ。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ('Calcon::Writer');
+# This also has Reader interface.
+
+sub record {
+    my ($self,$keys,$record) = @_;
+
+    if(defined($record->{'name'})) {
+	$self->address($keys,$record);
+    } elsif(defined($record->{'date'})) {
+	if ($record->{'date'}) { return if ($self->{'-future-only'} && ! $record->{'date'}->future()); }
+	$self->calendar($keys,$record);
+    } else {
+	# I don't know.
+    }
+}
+
+sub address {
+    my ($self,$keys,$record) = @_;
+    push(@{$self->{'-address-index'}->{$record->{'name'}}},$record);
+}
+
+sub calendar {
+    my ($self,$keys,$record) = @_;
+    push(@{$self->{'-date-index'}->{$record->{'date'}->unix_time()}},$record);
+}
+
+sub set_contents {
+    my ($self,$address,$calendar) = @_;
+    $self->{'-date-index'} = $calendar;
+    $self->{'-address-index'} = $address;
+}
+
+sub contents {
+    my ($self) = @_;
+    return ( $self->{'-date-index'}, $self->{'-address-index'});
+}
+
+# Reader インターフェースの部分
+
+sub set_output {
+    my ($self,$out) = @_;
+    $self->{'-output'} = $out;
+}
+
+sub output {
+    my ($self,$out) = @_;
+
+    $self->{'-output'} = $out;
+    $self->{'-output'}->start_file();
+    $self->write_datebook();
+    $self->write_addressbook();
+    $self->{'-output'}->end_file();
+}
+
+sub write_datebook {
+    my ($self) = @_;
+    for my $date ( sort {$a<=>$b} keys %{$self->{'-date-index'}} ) {
+	for my $record ( @{$self->{'-date-index'}->{$date}} ) {
+	    my @keys = keys %{$record};
+	    $self->{'-output'}->record(\@keys,$record);
+	}
+    }
+}
+
+sub write_addressbook {
+    my ($self) = @_;
+    for my $adr ( keys %{$self->{'-address-index'}} ) {
+	for my $record ( @{$self->{'-address-index'}->{$adr}} ) {
+	    my @keys = keys %{$record};
+	    $self->{'-output'}->record(\@keys,$record);
+	}
+    }
+}
+
+# 自分自身のクラスを切替えることで動作モードを切替える
+
+sub delete_mode {
+    my ($self) = @_;
+    bless $self,'Calcon::Pool::delete';
+}
+
+sub merge_mode {
+    my ($self) = @_;
+    bless $self,'Calcon::Pool::merge';
+}
+
+sub input_mode {
+    my ($self) = @_;
+    bless $self,'Calcon::Pool';
+}
+
+# 以下のルーチンは、たぶん、Record クラスにあるべき
+
+sub same_record_in_list {
+    my ($self,$list,$record) = @_;
+# print "\nCampare: ";$record->value;
+    record: 
+    for (my $i = 0; $i<=$#{$list}; $i++) {
+	my $r = $list->[$i];
+# print "\nList: ";$r->value;
+	next if (! $record->equal($r));
+# print "\nResult: $i\n";
+	return $i;
+    }
+# print "\nResult: -1\n";
+    return -1;
+}
+
+#######################################################################/
+
+package Calcon::Pool::delete;
+
+# 自分のPoolから、与えれたレコードを削除する。差分計算。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ('Calcon::Pool');
+
+sub address {
+    my ($self,$keys,$record) = @_;
+    my $name = $record->{'name'};
+    if (my $list = $self->{'-address-index'}->{$name}) {
+	my $i;
+	if (($i = $self->same_record_in_list($list,$record)) >= 0 ) {
+	    splice(@{$list},$i,1);
+	    if (! @$list) {
+		delete $self->{'-address-index'}->{$name};
+	    }
+	}
+    }
+}
+
+sub calendar {
+    my ($self,$keys,$record) = @_;
+    my $date = $record->{'date'}->unix_time();
+    if (my $list = $self->{'-date-index'}->{$date}) {
+	my $i;
+	if (($i = $self->same_record_in_list($list,$record)) >= 0 ) {
+	    splice(@{$list},$i,1);
+	    if (! @$list) {
+		delete $self->{'-date-index'}->{$date};
+	    }
+	}
+    }
+}
+
+#######################################################################/
+
+package Calcon::Pool::merge;
+
+# Pool にないレコードだったら、そのレコードを付け加える。
+# 中身を見て、必要な情報のみを付け加える方が良い。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ('Calcon::Pool');
+
+sub address {
+    my ($self,$keys,$record) = @_;
+    my $name = $record->{'name'};
+    if (my $list = $self->{'-address-index'}->{$name}) {
+	my $i;
+	if (($i = $self->same_record_in_list($list,$record)) >= 0 ) {
+	    return;
+	}
+	push(@$list,$record);
+    } else {
+	push(@{$self->{'-address-index'}->{$name}},$record);
+    }
+}
+
+sub calendar {
+    my ($self,$keys,$record) = @_;
+    my $date = $record->{'date'}->unix_time();
+    my $list = $self->{'-date-index'}->{$date};
+    if ($list) {
+	my $i;
+	if (($i = $self->same_record_in_list($list,$record)) >= 0 ) {
+	    return;
+	}
+	push(@$list,$record);
+    } else {
+	push(@{$self->{'-date-index'}->{$date}},$record);
+    }
+}
+
+
+#######################################################################/
+
+package Calcon::Buffered_Writer;
+
+# 変換前にすべてを読み込む必要がある形式のために使うクラス。
+# データの先頭に総レコード数を持つ形式とか。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ('Calcon::Writer');
+
+#
+# Some format requires whole record before write, because of
+# record count or sorted order. This plugin class perform
+# reading and queueing.
+#
+# write_datebook or write_address_book should be overwrited.
+#
+
+sub record {
+    my ($self,$keys,$record) = @_;
+
+    if(defined($record->{'name'})) {
+	$self->{'-adr-max'}++;
+	$self->address($keys,$record);
+    } elsif(defined($record->{'date'})) {
+	if ($record->{'date'}) { return if ($self->{'-future-only'} && ! $record->{'date'}->future()); }
+	$self->{'-date-max'}++;
+	$self->calendar($keys,$record);
+    } else {
+	# I don't know.
+    }
+}
+
+sub address {
+    my ($self,$keys,$record) = @_;
+    push(@{$self->{'-address-records'}}, $record); 
+}
+
+sub calendar {
+    my ($self,$keys,$record) = @_;
+    push(@{$self->{'-date-records'}}, $record); 
+}
+
+sub end_file {
+    my ($self) = @_;
+    $self->write_datebook() if ( defined($self->{'-date-max'}));
+    $self->write_addressbook() if ( defined($self->{'-adr-max'}));
+}
+
+sub write_datebook {
+    my ($self) = @_;
+    my $count = $self->{'-date-max'};
+    for my $dates ( @{$self->{'-date-records'}} ) {
+    }
+}
+
+sub write_addressbook {
+    my ($self) = @_;
+    my $count = $self->{'-adr-max'};
+    for my $adr ( @{$self->{'-address-records'}} ) {
+    }
+}
+
+
+#######################################################################/
+
+package Calcon::Zaurus_backup_read ;
+
+# ザウルスのバックアップ形式
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Zaurus_read' );
+
+sub decode {
+    my ($self,$backup) = @_;
+    my $out = $self->{'-output'};
+
+    my $data = $self->backup_read($backup);
+
+    foreach my $file ( $self->backup_files($data) ) {
+	next if ($file !~ /BOX$/);
+	$self->SUPER::decode($file);
+    }
+}
+
+sub backup_files {
+    my ($self,$data) = @_;
+    if ($data =~ /^\032*PABAK/) {
+	return $self->text_backup($data);
+    } else {
+	return $self->ztar($data);
+    }
+}
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+
+# alphabet encoding
+#
+# 0-5        "0".."5"
+# 6-0x1f     "A".."Z"
+# 0x20-0x25  "6"..";"
+# 0x26-0x3f  "a".."z"
+#
+# make character replacement code
+#
+    my $ya = '';
+    my $yb = '';
+    for(my $i=0;$i<0x40;$i++) {
+	if( $i <= 0x05 ) { $ya .= pack("C",($i + 0x30));}
+	elsif( $i <= 0x1f ) { $ya .= pack("C",($i + 0x3b));}
+	elsif( $i <= 0x25 ) { $ya .= pack("C",($i + 0x16));}
+	else { $ya .= pack("C",($i + 0x3b)); }
+    # since . never matches \n, 0x40 is added
+	$yb .= sprintf("\\%03o",$i+0x40);
+    }
+    eval "sub a_decode \{ y\/" . $ya . "/" . $yb . "/;}\n";
+    eval "sub a_encode \{ y\/" . $yb . "/" . $ya . "/;}\n";
+
+}
+
+sub read {
+    my ($self,$file) = @_;
+    return $self->{'-files'}->{$file};
+}
+
+##########################################################
+#
+# Zaurus Binary Encoding
+#
+##########################################################
+
+# bit encoding
+# s/..../&decode($&)/eg;
+# 76543210765432107654321076543210
+# 00      11      22        001122
+# 33221100332211003322110033221100
+# 00      11      22        001122
+
+sub bit_decode {
+    my $bit = substr($_[0],0,3); 
+    vec($bit, 3,2) =  vec($_[0],14,2);
+    vec($bit, 7,2) =  vec($_[0],13,2);
+    vec($bit,11,2) =  vec($_[0],12,2);
+    return $bit;
+}
+
+sub bit_encode {
+    my $bit = $_[0];
+    vec($bit,14,2) = vec($bit, 3,2);
+    vec($bit,13,2) = vec($bit, 7,2);
+    vec($bit,12,2) = vec($bit,11,2);
+# since . never matches \n, 0x40 is added
+    vec($bit,11,2) = vec($bit,7,2) = vec($bit,3,2) = 1;
+    return $bit;
+}
+
+sub z_encode {
+    my ($i);
+    $i = (length()%3);
+    $_ .= "\0" x (3-$i) if($i);
+    s/.../&bit_encode($&)/eg;
+    &a_encode;
+}
+
+sub z_decode {
+    my ($i);
+    s/\s//g;
+    &a_decode;
+    $i = (length()%4);
+    $_ .= "\0" x (4-$i) if($i);
+    s/..../&bit_decode($&)/eg;
+}
+
+sub text_backup {
+    my ($self,$data) = @_;
+    my $debug = $self->{'-debug'};
+    my (@names,@size);
+
+    print("\nBackup Directory\n") if ($debug);
+
+    $data =~ s/^\032*PABAK.*\n([^\032]*\032)//;
+    $_ = $1;
+    &z_decode;
+    my @title = (); my @attr = ();
+    my $len = length($_) - 20; my $j = 0;
+    for(my $i=6;$i<$len;$i+=20) {
+	$title[$j] = substr($_,$i,12);
+	$attr[$j] = unpack("H*",substr($_,$i+12,5));
+	$size[$j] = (ord(substr($_,$i+17,1))
+	     +ord(substr($_,$i+18,1))*0x100
+	     +ord(substr($_,$i+19,1))*0x10000);
+	print($title[$j]."\t") if ($debug);
+	print($attr[$j]."\t") if ($debug);
+	print($size[$j]."\n") if ($debug);
+	$j++;
+    }
+    my $i = 0;
+    foreach (split(/\032/,$data)) {
+	s/^PABAK.*\n//;
+        &z_decode;
+	$self->{'-files'}->{$title[$i++]} = $_;
+    }
+    return @title;
+}
+
+sub ztar {
+    my ($self,$data) = @_;
+    my $debug = $self->{'-debug'};
+    my (@names,@size);
+    my $ptr = 0;
+
+    $_ = substr($data,0,16);
+    $ptr += 16;
+    my $count = unpack("V",substr($_,4,4));
+
+    print unpack("H*",substr($_,0,8)),"\n" if ($debug);
+    for ( my $i = 0; $i<$count ; $i++ ) {
+	$_ = substr($data,$ptr,24); $ptr+=24;
+	last if (substr($_,0,1) eq "\xff");
+	my $name = substr($_,0,12); $name =~ s/\0.*//;
+	print "name: $name\n" if ($debug);
+	push(@names,$name);
+	my $size = unpack("V",substr($_,12,4));
+	print "size: $size\n" if ($debug);
+	push(@size,$size);
+	print unpack("H*",substr($_,12)),"\n" if ($debug);
+    }
+
+    for ( my $i = 0; $i<$count ; $i++ ) {
+	$_ = substr($data,$ptr,$size[$i]); $ptr+=$size[$i];
+	my $name = $names[$i];
+	$self->{'-files'}->{$name} = $_;
+    }
+    return @names;
+}
+
+sub backup_read {
+    my ($self,$file) = @_;
+
+    $self->{'-file'} = $file;
+    open(F,"<".$file);
+    local($/) ;
+    undef $/;
+    my $data = <F>;
+    $data;
+}
+
+
+
+#######################################################################/
+
+package Calcon::iApp_read;
+
+# iCal/AddressBook からAppleScript 経由で読み込む。なので、
+# Mac::AppleScript が必要。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+# use Mac::AppleScript qw(RunAppleScript);
+use NKF;
+@ISA = ( 'Calcon::File_read' ) ;
+
+# We use Applescript, but it is very slow.
+
+my $tell;
+
+my %record_keys = (
+    "phone電話"=>"tel",
+    "phoneファックス"=>"fax",
+    "emailメール"=>"mail",
+    "address住所"=>"address",
+);
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'-labels'} = \%record_keys;
+}
+
+sub decode {
+    my ($self,$file) = @_;
+    my ($debug) = $self->{'-debug'};
+    my $out = $self->{'-output'};
+    my $record;
+    my $keys;
+
+    $out->start_file('');
+    $self->get_all_event() if (! $self->{'-address-only'});
+    $self->get_all_contact() if (! $self->{'-calendar-only'});
+    $out->end_file('');
+
+}
+
+sub date {
+    my ($self,$date)=@_;
+    my @date = ($date =~ /(\d+)/g);
+    if ($date =~ /PM$/) {
+	if ($date[3]==12) { $date[3]=0;}
+	$date[3]+=12;
+    }
+    return $self->make_date("$date[0]/$date[1]/$date[2] $date[3]:$date[4]");
+}
+
+
+sub property {
+    my ($self,$contact,$id,$property,$record,$key) = @_;
+    my $result;
+    $result = RunAppleScript("${tell}${property} of ${contact} $id\nend tell\n");
+    # it looks like apple event returns some garbage
+    $result =~ s/^\"//; $result =~ s/\"$//; $result =~ s/\001.*$//;
+    if (defined($record) && $result ne '') {
+	if ($key =~ /date/ || $key =~ /birth/) {
+	    $record->{$key} = $self->date($result);
+	} else {
+	    $record->{$key} = nkf('-eS',$result);
+	}
+    } else {
+        nkf('-eS',$result);
+    }
+}
+
+sub address {
+    my($self,$id,$vid,$phone,$record) = @_;
+
+    my ($street , $zip , $state , $country , $city);
+    $street = $zip = $state = $country = $city = '';
+    my $address = RunAppleScript("${tell}properties of ${phone} $vid of person $id\nend tell\n");
+
+# {zip:missing value, label:"住所", state:missing value, street:"那覇市久茂地3-21-1", country code:missing value, country:missing value, id:"AFBD61FE-FB17-11D6-A84E-0003936AC938", city:missing value, class:address}
+
+    $address =~ s/^\"//; $address =~ s/\"$//; 
+    $address =~ s/\001.*$//;
+    $address =~ s/\002.*?"/"/;
+    $address = nkf('-eS',$address);
+
+    # my ($street , $zip , $state , $country , $city);
+    $address =~ /street:"([^"]*)"/ && ($street = $1);
+    $address =~ /zip:"([^"]*)"/ && ($zip = $1);
+    $address =~ /state:"([^"]*)"/ && ($state = $1);
+    $address =~ /city:"([^"]*)"/ && ($city = $1);
+    $address =~ /country:"([^"]*)"/ && ($country = $1);
+
+    my ($label) = ($address =~ /label:"(.*?)"/);
+    if (! defined($self->{'-labels'}->{$phone.$label})) {
+        print "## $phone$label not defined\n";
+    } else {
+	$record->{$self->{'-labels'}->{$phone.$label}} = 
+	    "$state $city $street $country"
+	    if ($state||$city||$street||$country);
+	if ($zip && $self->{'-labels'}->{$phone.$label} =~ /home/) {
+	    $record->{'home-zip'} = $zip;
+	} else {
+	    $record->{'zip'} = $zip if ($zip);
+	}
+    }
+}
+
+sub value {
+    my($self,$id,$vid,$phone,$record) = @_;
+    my $result  = RunAppleScript("${tell}properties of ${phone} $vid of person $id\nend tell\n");
+    $result =~ s/^\"//; $result =~ s/\"$//; $result =~ s/\001.*$//;
+    $result = nkf('-eS',$result);
+    my ($value,$label) = ($result =~ /value:"(.*?)".*label:"(.*?)"/);
+    if (! defined($self->{'-labels'}->{$phone.$label})) {
+        print "## $phone$label not defined\n";
+    } else {
+	$record->{$self->{'-labels'}->{$phone.$label}} = $value;
+    }
+}
+
+
+sub get_all_contact {
+    my ($self) = @_;
+    $tell = "tell application \"Address Book\"\n";
+
+    my $count = RunAppleScript("${tell}count of person\nend tell\n");
+    foreach my $id ( 1..$count ) {
+	$self->person($id);
+    }
+}
+
+sub person {
+    my ($self,$id) = @_;
+    my $record = {};
+
+    my $phone_count  = RunAppleScript("${tell}count of phone of person $id\nend tell\n");
+    foreach my $phone_id ( 1..$phone_count ) {
+	$self->value($id,$phone_id,'phone',$record);
+    }
+
+    my $email_count  = RunAppleScript("${tell}count of email of person $id\nend tell\n");
+    foreach my $email_id ( 1..$email_count ) {
+	$self->value($id,$email_id,'mail',$record);
+    }
+
+    my $address_count  = RunAppleScript("${tell}count of address of person $id\nend tell\n");
+    foreach my $address_id ( 1..$address_count ) {
+	$self->address($id,$address_id,'address',$record);
+    }
+
+    my $name = $self->property('person',$id,'last name');
+    my $first_name = $self->property('person',$id,'first name');
+    $record->{'name'} = ($name && $first_name)?"$name $first_name":
+	($name)?$name:$first_name;
+
+    my $name_p = $self->property('person',$id,'phonetic last name');
+    my $first_name_p = $self->property('person',$id,'phonetic first name');
+    $record->{'name-yomi'} = ($name_p && $first_name_p)?"$name_p $first_name_p":
+	($name_p)?$name_p:$first_name_p;
+
+    $self->property('person',$id,'job title',$record,'section');
+    $self->property('person',$id,'title',$record,'title');
+
+    #       $self->property('person',$id,'birth date',$record,'birth');
+    $self->property('person',$id,'organization',$record,'office');
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+
+sub get_all_event {
+    my ($self) = @_;
+
+    $tell = "tell application \"iCal\"\n";
+    if ($self->{'-future-only'}) {
+	my $today = $self->today();
+        my ($year,$mon,$mday,$hour,$min) = $today->localtime();
+	my $count = RunAppleScript("${tell}uid of every event of last calendar whose start date > date \"$year/$mon/$mday\"\nend tell\n");
+	for my $id ($count =~ /("[^"]*")/g) {
+	    $self->uid_event($id);
+	}
+    } else {
+	my $count = RunAppleScript("${tell}count of event of last calendar\nend tell\n");
+	for(my $id=1; $id <= $count ;$id++) {
+	    $self->event($id);
+	}
+    }
+}
+
+sub uid_event {
+    my ($self,$id) = @_;
+    my $record = $self->make_record;
+
+    # $self->property('event',$id,'all day event',$record,'all-day');
+    $self->property('some event of last calendar whose uid is',$id,'start date',$record,'date');
+    $self->property('some event of last calendar whose uid is',$id,'end date',$record,'end-date');
+    $self->property('some event of last calendar whose uid is',$id,'summary',$record,'summary');
+    $self->property('some event of last calendar whose uid is',$id,'description',$record,'memo');
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+sub event {
+    my ($self,$id) = @_;
+    my $record = $self->make_record;
+
+    # $self->property('event',$id,'all day event',$record,'all-day');
+    $self->property('event',$id." of last calendar",'start date',$record,'date');
+    $self->property('event',$id." of last calendar",'end date',$record,'end-date');
+    $self->property('event',$id." of last calendar",'summary',$record,'summary');
+    $self->property('event',$id." of last calendar",'description',$record,'memo');
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+
+
+#######################################################################/
+
+package Calcon::iApp_write ;
+
+# AppleScript 経由で iCal/AddressBook に書き出す。この実装では、
+# Mac::AppleScript はいらない
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+use Carp;
+
+@ISA = ( 'Calcon::Writer' );
+
+sub initialize {
+    my ($self) = @_;
+
+    $self->SUPER::initialize();
+    if (defined $self->{'-file'}) {
+	$self->{'-file-out'} = 1;
+    } else {
+	if (defined $self->{'-file-out'}) {
+	    $self->{'-file'} = "script-out";
+	}
+    }
+
+    $self->{'-fake-allday'} = 1;
+    $self->{'-time-for-allday'} = 12*3600;
+    $self->{'-add-time-for-allday'} = 2*3600;
+
+    $self->{'-check-script'} = 1;
+    $self->{'-check-group'} = 20;
+    $self->{'-do-grouping'} = 1;
+
+#    | perl -pe 's/[\177-\377]/sprintf "\\%03o",ord($&)/eg;'
+#    | perl -pe 's/\\(\d\d\d)/sprintf "%c",oct($&)/eg;'
+
+    $self->{"-phone-labels"} = {
+	"tel"=>"電話",
+	"tel-home"=>"自宅電話",
+	"mobile-tel"=>"携帯",
+	"home-fax"=>"自宅ファックス",
+	"fax"=>"ファックス",
+
+    };
+    $self->{"-mail-labels"} = {
+	"mail"=>"メール",
+	"mail-to"=>"メール2",
+	"mail-address"=>"メール3",
+
+    };
+    $self->{"-address-labels"} = {
+	"address"=>"住所",
+	"home-address"=>"自宅住所",
+    };
+    $self->{"-zip-labels"} = {
+	"zip"=>"郵便番号",
+	"home-zip"=>"自宅郵便番号",
+    };
+    $self->{'-groups'} = {};
+    $self->{'-init-file'} = "s000000";
+    $self->{'-check-script-count'} = 0;
+    $self->{'-script-name'} =  $self->{'-init-file'};
+
+}
+
+sub start_file {
+    my ($self,$type) = @_;
+    undef $self->{'-application'};
+    if ($self->{'-file-out'}) {
+	mkdir $self->{'-file'};
+    }
+}
+
+sub end_file {
+    my ($self,$type) = @_;
+    $self->close();
+    $self->{'-telling'} = 0;
+    if ($self->{'-file-out'}) {
+	$self->make_group();
+	while(<script-out/*.script>) {
+	    my $out = $_;
+	    $out =~ s/\.script$/.compile/;
+	    print STDERR "osacompile -o $out $_\n";
+	    # system "osacompile -o $out $_";
+	    # system "osascript $out";
+	}
+    }
+}
+
+sub start_record {
+    my ($self,$type) = @_;
+
+    if ($self->{'-check-script'}) {
+	my $i = $self->{'-check-script-count'}++;
+	if ($i % $self->{'-check-group'}==0) {
+	    my $d = $self->{'-script-name'}++;
+	    $self->close() if ( $self->{'-telling'} );
+	    $self->{'-telling'} = 0;
+            if (1) {
+	    if ($self->{'-file-out'}) {
+		open OUT,"> script-out/$d.script" or croak($!);
+	    } else {
+		print STDERR "doing $i\n";
+		open OUT,"| osascript " or cloak($!);
+	    }
+            } else {
+	    if ($self->{'-file-out'}) {
+		open OUT,"> script-out/$d.script" or croak($!);
+	    } else {
+		print STDERR "doing $i\n";
+		open OUT,"| osascript " or cloak($!);
+	    }
+            }
+	    select OUT;
+	}
+    }
+}
+
+sub print {
+    my ($self,@data) = @_;
+    foreach (@data) {
+	my $data = nkf('-s -Z',$_);
+	$data =~ s/\354\276/\203_/g;
+	$data =~ s/\356\276/  /g;
+	$data =~ s/\356\277/  /g;
+	$data =~ s/([^\200-\377])\\/$1\200/g;
+	# $data =~ s/\201/\/g;
+        $data =~ s/\\/\\\\/g;
+	print $data;
+    }
+}
+
+sub record {
+    my ($self,$keys,$record) = @_;
+    my ($application);
+
+    $self->start_record('');
+
+    # check proper application
+    if (defined $record->{'name'}) {
+	$application = 'Address Book';
+	$self->set_application($application);
+	$self->address_book($keys,$record);
+	$self->print("end tell\n") if (! $self->{'-check-script'}) ;
+    } elsif (defined $record->{'date'}) {
+	if ($record->{'date'}) { return if ($self->{'-future-only'} && ! $record->{'date'}->future()); }
+	$application = 'iCal';
+	$self->set_application($application);
+	$self->ical($keys,$record);
+	$self->print("end tell\n") if (! $self->{'-check-script'}) ;
+    } else {
+	# nothing to do
+    }
+    $self->print("\n");
+}
+
+sub close {
+    my ($self) = @_;
+    my $application = $self->{'-application'};
+    if ($self->{'-check-script'}) {
+	if ($application eq "Address Book") {
+	    $self->print("--close address\n");
+	    $self->print("--close group\n");
+	    # $self->print("with transaction\n");
+	    $self->print("save addressbook\n");
+	    # $self->print("end transaction\n");
+	}
+	$self->print("quit saving yes\n")
+	    if (0 && $self->{'-check-script-count'} % 5 == 4);
+	$self->print("end tell\n");
+	undef $self->{'-application'};
+    }
+    $self->{'-telling'} = 0;
+}
+
+sub set_application {
+    my ($self,$application) = @_;
+
+    if ($application ne $self->{'-application'}) {
+	$self->print("end tell\n") if ($self->{'-telling'} );
+	$self->{'-application'} = $application;
+	$self->print("\ntell Application \"$application\"\n");
+	$self->{'-telling'} = 1;
+    }
+}
+
+sub address_book {
+    my ($self,$keys,$record) = @_;
+    my @keys = @$keys;
+    my %record = %$record;
+    my ($tab) = '';
+    
+
+    return if(! defined $record{'name'});
+    $tab .= '    ';
+
+    # $self->print("with transaction\n");
+    if(defined $record{'office'}) {
+	my $group = $record{'office'};
+	$self->print($tab,"if not exists some group whose name is ");
+	$tab .= '    ';
+	$self->print("\"$group\" then \n");
+	$self->print($tab,"make new group with properties ");
+	$self->print("{name:\"$group\"}\n");
+	$tab =~ s/    $//;
+	$self->print($tab,"end\n\n");
+    }
+    $self->print($tab,"set aPerson to make new person with properties {");
+    $tab .= '    ';
+
+    my @names;
+    my $data =  $record{'name'}; 
+    @names = split(/ +/,$data);
+
+    $self->print("last name: \"",shift(@names),"\",");
+    $self->print("first name: \"@names\"}\n");
+
+    $self->print($tab,"tell aPerson\n");
+    if(defined $record{'name-yomi'}) {
+	if($record{'name-yomi'} =~ /\201H/) {  # ?
+	} else {
+	    my $data =  $record{'name-yomi'}; 
+	    if ($data =~ /,/) {
+		@names = split(/,/,$data);
+		$data = $names[1].' '.$names[0];
+	    }
+	    $data = nkf('-sIZ --hiragana',$data);
+	    $data = $self->check_2byte($data);
+	    @names = split(/ +/,$data);
+            # put one space to prevent a problem of incomplete Shift JIS
+	    $self->print($tab,"set phonetic last name to \"",shift(@names)," \"\n");
+	    $self->print($tab,"set phonetic first name to \"@names \"\n")
+		if (@names);
+	}
+    }
+
+    if(defined $record{'section'}) {
+	$self->print($tab,"set job title to \"$record{'section'}\"\n");
+    }
+    if(defined $record{'title'}) {
+	$self->print($tab,"set title to \"$record{'title'}\"\n");
+    }
+    foreach my $address ('','home-') {
+	my @data = ();
+	if(defined $record{$address."address"}) {
+	    my $adr = nkf('-s -Z',$record{$address."address"});
+	    if($adr=~ s/\201\247\s*(\d+)//) {
+		$record{$address.'zip'} = $1;
+	    }
+	    if($record{$address.'zip'}) {
+		push(@data,",zip:\"$self->{'-zip-labels'}->{$record{$address.'zip'}}\"");
+	    }
+	    $self->add_address($tab,$adr,$address."address",\@data);
+	}
+    }
+    foreach my $phone ('tel','tel-home','mobile-tel','home-fax','fax') {
+	if(defined $record{$phone}) {
+	    $self->add_phone($tab,$record{$phone},$phone);
+	}
+    }
+    foreach my $mail ('mail','mail-to','mail-address') {
+	if(defined $record{$mail}) {
+	    $self->add_mail($tab,$record{$mail},$mail);
+	}
+    }
+
+    if(defined $record{'birth'}) {
+	# it looks like Address Book's apple script has trouble with birth date
+	# $self->print($tab,"set birth date to ",$self->date($record{'birth'}),"\n");
+    }
+    if(defined $record{'office'}) {
+	$self->print($tab,"set organization to \"$record{'office'}\"\n");
+	if ($self->{'-do-grouping'}) {
+	    $tab =~ s/    $//;
+	    $self->print($tab,"end tell\n");
+	    $self->print($tab,"try\n");
+	    $tab .= '    ';
+	    $self->print($tab,"add aPerson to some group whose name is \"");
+	    $self->print($record{'office'},"\"\n");
+	    $tab =~ s/    $//;
+	    $self->print($tab,"end\n");
+	    # $self->print("end transaction\n");
+	    $self->{'-groups'}->{$record{'office'}} = 1;;
+	    return;
+	}
+    }
+    $tab =~ s/    $//;
+    $self->print($tab,"end tell\n");
+    # $self->print("end transaction\n");
+}
+
+sub check_2byte {
+    my ($self,$data) = @_;
+    my $new  = '';
+    my $tmp;
+    
+    while($data) {
+	if ($data =~ s/^([\000-\177]*)([\200-\377])//) {
+	    $new .= $1; $tmp = $2;
+	    if (! $data ) {
+	    } elsif ($data =~ /^[!-\376]/) {
+		$data =~ s/^.//;
+		$new .= $tmp . $&
+	    }
+	} else {
+	    $new .= $data;
+	    last;
+	}
+    }
+    $new;
+}
+
+
+sub date {
+    my ($self,$date) = @_;
+    my ($year,$month,$day,$hour,$min) = $date->localtime();
+
+    $date = "date \"${year}N $month $day j";
+    if ($hour) { $date .= " $hour:$min";} 
+    $date .= "\"";
+    return $date;
+}
+
+sub add_address {
+    my ($self,$tab,$data,$label,$option) = @_;
+	
+    $label = nkf('-s',$self->{'-address-labels'}->{$label});
+    $self->print($tab,"make new address at end of address of aPerson ");
+    $self->print("with properties {street:\"$data\", label:\"$label\"@$option}\n");
+}
+
+sub add_phone {
+    my ($self,$tab,$data,$label) = @_;
+	
+    $label = nkf('-s',$self->{'-phone-labels'}->{$label});
+    $self->print($tab,"make new phone at end of phone of aPerson with properties {value:\"$data\", label:\"$label\"}\n");
+}
+
+sub add_mail {
+    my ($self,$tab,$data,$label) = @_;
+	
+    $label = nkf('-s',$self->{'-mail-labels'}->{$label});
+    $self->print($tab,"make new email at end of email of aPerson with properties {value:\"$data\", label:\"$label\"}\n");
+}
+
+sub make_group {
+    my ($self) = @_;
+    my (%groups) = %{$self->{'-groups'}};
+    my $tab = '    ';
+
+    return if (! %groups);
+    open OUT,"> script-out/group.script" or cloak($!);
+    select OUT;
+    $self->print("tell application \"Address Book\"\n");
+    foreach my $group (keys %groups) {
+	$self->print($tab,"if not exists some  group whose name is ");
+	$tab .= '    ';
+	$self->print("\"$group\" then \n");
+	$self->print($tab,"make new group with properties ");
+	$self->print("{name:\"$group\"}\n");
+	$tab =~ s/    $//;
+	$self->print($tab,"end\n");
+    }
+    $self->print("close group\n");
+    # $self->print("with transaction\n");
+    $self->print("save addressbook\n");
+    # $self->print("end transaction\n");
+    $self->print("quit saving yes\n");
+    $self->print("end tell\n");
+}
+
+sub ical {
+    my ($self,$keys,$record) = @_;
+    my @keys = @$keys;
+    my %record = %$record;
+    my ($tab) = '';
+
+    # $self->print("with transaction\n");
+    # $self->print($tab,"set aDay to ");
+    $self->print("make new event at end of event of last calendar with properties {");
+    if ($record{'date'}->is_allday() &&  $self->{'-fake-allday'} ) {
+	$record{'date'} = $record{'date'}->add($self->{'-time-for-allday'});
+	$record{'end-date'} = 
+	    $record{'date'}->add($self->{'-add-time-for-allday'});
+    }
+    $self->print($tab,"start date:",$self->date($record{'date'}));
+    if (defined $record{'end-date'}) {
+        if ($record{'date'}->value() == $record{'end-date'}->value()) {
+	    $record{'end-date'} = 
+		$record{'date'}->add($self->{'-add-time-for-allday'});
+	}
+	$self->print($tab,",end date:",$self->date($record{'end-date'}))
+    }
+    $self->print($tab,",stamp date:",$self->date($record{'modify-date'}))
+	if (defined $record{'modify-date'});
+    if (defined($record{'memo'})) {
+	my ($summary,$memo);
+	if (defined($record{'summary'})) {
+	    $summary = $record{'summary'};
+	    $memo = $record{'memo'};
+	} else {
+	    $summary = $record{'memo'};
+	    # if this contains double quote we have a problem. But 
+	    # I cannot fix it without decoding shift JIS and backslash/0x80
+	    # conversion.
+	    $summary =~ s/"//g; # oops
+	    $summary =~ s/[\r\n].*$//; $memo = $&;
+	}
+
+	$self->print($tab,",summary:\"",$summary,"\"") if ($summary);
+	$self->print($tab,",description:\"",$memo,"\"") if ($memo);
+    }
+    $self->print($tab,"}\n");
+
+    # $self->print($tab,"tell aDay\n");
+    # $self->print($tab,"if start date = end date then\n");
+    # $self->print($tab,"   set end date to start date + ".
+    #	int($self->{'-add-time-for-allday'}/60)." * minutes\n");
+    # $self->print($tab,"end if\n");
+    # $self->print($tab,"end\n");
+    # $self->print("end transaction\n");
+}
+
+#######################################################################/
+
+package Calcon::Entourage_write ;
+
+# Mac のEntrourage に AppleScript 経由で書き出す。ここでも Mac::AppleScript
+# は使わない。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use NKF;
+@ISA = ( 'Calcon::iApp_write' );
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+
+    $self->{'-fake-allday'} = 0;
+    $self->{'-time-for-allday'} = 12*3600;
+    $self->{'-add-time-for-allday'} = 2*3600;
+
+    $self->{'-check-script'} = 1;
+    $self->{'-check-group'} = 20;
+
+    $self->{'-init-file'} = "s000000";
+    $self->{'-check-script-count'} = 0;
+    $self->{'-japanese-format'} = 1;
+    $self->{'-script-name'} =  $self->{'-init-file'};
+
+    $self->{"-phone-labels"} = {
+	"tel"=>"business phone number",
+	"tel-home"=>"home phone number",
+	"mobile-tel"=>"mobile phone number",
+	"home-fax"=>"home fax phone number",
+	"fax"=>"business fax phone number",
+
+    };
+}
+
+sub record {
+    my ($self,$keys,$record) = @_;
+
+    $self->start_record('');
+
+    # check proper application
+    if (defined $record->{'name'}) {
+	my $application = 'Microsoft Entourage';
+	$self->set_application($application);
+	$self->contact($keys,$record);
+	$self->print("end tell\n") if (! $self->{'-check-script'}) ;
+    } elsif (defined $record->{'date'}) {
+	if ($record->{'date'}) { return if ($self->{'-future-only'} && ! $record->{'date'}->future()); }
+	my $application = 'Microsoft Entourage';
+	$self->set_application($application);
+	$self->event($keys,$record);
+	$self->print("end tell\n") if (! $self->{'-check-script'}) ;
+    } else {
+	# nothing to do
+    }
+    $self->print("\n");
+}
+
+sub close {
+    my ($self) = @_;
+    my $application = $self->{'-application'};
+    if ($self->{'-check-script'}) {
+	$self->print("quit saving yes\n")
+	    if (0 && $self->{'-check-script-count'} % 5 == 4);
+	$self->print("end tell\n");
+	undef $self->{'-application'};
+    }
+    $self->{'-telling'} = 0;
+}
+
+sub make_group {
+}
+
+sub contact {
+    my ($self,$keys,$record) = @_;
+    my @keys = @$keys;
+    my %record = %$record;
+    my ($tab) = '';
+    my @names;
+    my $data =  $record{'name'}; 
+    @names = split(/ +/,$data);
+
+    # $self->print("with transaction\n");
+    $tab .= '    ';
+
+
+    # $self->print("${tab}try\n${tab}set aPerson to some contact whose last name is \"$names[0]\" and first name is \"$names[1]\"\n${tab}on error\n";
+
+    $self->print($tab,"set aPerson to make new contact with properties {");
+
+    $tab .= '    ';
+
+    $self->print($tab,"last name: \"",shift(@names),"\",");
+    $self->print($tab,"first name: \"@names\"}\n");
+    $tab =~ s/    //;
+    # $self->print($tab,"end\n");
+    
+
+    $self->print($tab,"tell aPerson\n");
+    if(defined $record{'name-yomi'}) {
+	if($record{'name-yomi'} =~ /\201H/) {  # ?
+	} else {
+	    my $data =  $record{'name-yomi'}; 
+	    if ($data =~ /,/) {
+		@names = split(/,/,$data);
+		$data = $names[1].' '.$names[0];
+	    }
+	    $data = nkf('-sIZ --hiragana',$data);
+	    $data = $self->check_2byte($data);
+	    @names = split(/ +/,$data);
+            # put one space to prevent a problem of incomplete Shift JIS
+	    $self->print($tab,"set last name furigana to \"",shift(@names)," \"\n");
+	    $self->print($tab,"set first name furigana to \"@names \"\n")
+		if (@names);
+	}
+    }
+
+    $self->print($tab,"set japanese format to true\n") if ($self->{'-japanese-format'});
+    if(defined $record{'section'}) {
+	$self->print($tab,"set department to \"$record{'section'}\"\n");
+    }
+    if(defined $record{'title'}) {
+	$self->print($tab,"set job title to \"$record{'title'}\"\n");
+    }
+    if(defined $record{'address'}) {
+	$self->print($tab,"set business address to {",
+           "zip:\"$record{'zip'}\",",
+           "street address:\"$record{'address'}\"",
+	    "}\n"
+	);
+    }
+    if(defined $record{'home-address'}) {
+	$self->print($tab,"set home address to {",
+           "zip:\"$record{'home-zip'}\",",
+           "street address:\"$record{'home-address'}\"",
+	    "}\n"
+	);
+    }
+             
+    foreach my $phone ('tel','tel-home','mobile-tel','home-fax','fax') {
+	if(defined $record{$phone}) {
+	    $self->print($tab,"set ",$self->{'-phone-labels'}->{$phone},
+		" to \"",$record{$phone},"\"\n"
+	    );
+	}
+    }
+
+    # $self->print($tab,"delete every email address of aPerson\n");
+    foreach my $mail ('mail','mail-to','mail-address') {
+	if(defined $record{$mail}) {
+	    foreach my $m (split(/,/,$record{$mail})) {
+		$self->print($tab,"make new email address of aPerson with data \"$m\"\n");
+	    }
+	}
+    }
+
+    if(defined $record{'birth'}) {
+	$self->print($tab,"set birthday to \"",$self->birth_date($record{'birth'}),"\"\n");
+    }
+    if(defined $record{'office'}) {
+	$self->print($tab,"set company to \"$record{'office'}\"\n");
+    }
+    if(defined $record{'office-yomi'}) {
+	$self->print($tab,"set company furigana to \"$record{'office-yomi'}\"\n");
+    }
+    $tab =~ s/    $//;
+    $self->print($tab,"end tell\n");
+    # $self->print("end transaction\n");
+}
+
+sub birth_date {
+    my ($self,$date) = @_;
+    my ($year,$month,$day,$hour,$min) = $date->localtime();
+
+    if (!$year) { $year = '';} else { $year = "$year/"; }
+    $date = "$year$month/$day";
+    if ($hour) { $date .= " $hour:$min";} 
+    return $date;
+}
+
+
+sub event {
+    my ($self,$keys,$record) = @_;
+    my @keys = @$keys;
+    my %record = %$record;
+    my ($tab) = '';
+
+    # $self->print("with transaction\n");
+    # $self->print($tab,"set aDay to ");
+    $self->print("make new event with properties {");
+
+#  make new event with properties {subject:"", location:"", content:
+# "", start time:date "2002N 11 13 j 0:00:00 PM", end time:date
+# "2002N 11 13 j 0:30:00 PM", all day event:false, recurring:false,
+# category:{}, links:{}, remind time:1440, recurrence:""} 
+
+    if ( $record{'date'}->is_allday()) {
+	$self->print($tab,"all day event: true,");
+	$self->print($tab,"start time:",$self->date($record{'date'}));
+    } else {
+	$self->print($tab,"all day event: false,");
+	$self->print($tab,"start time:",$self->date($record{'date'}));
+	if (defined $record{'end-date'}) {
+	    $self->print($tab,",end time:",$self->date($record{'end-date'}))
+	}
+    }
+    # $self->print($tab,",stamp date:",$self->date($record{'modify-date'}))
+    # 	if (defined $record{'modify-date'});
+    if (defined($record{'memo'})) {
+	my ($summary,$memo);
+	if (defined($record{'summary'})) {
+	    $summary = $record{'summary'};
+	    $memo = $record{'memo'};
+	} else {
+	    $summary = $record{'memo'};
+	    # if this contains double quote we have a problem. But 
+	    # I cannot fix it without decoding shift JIS and backslash/0x80
+	    # conversion.
+	    $summary =~ s/"//g; # oops
+	    $summary =~ s/[\r\n].*$//; $memo = $&;
+	}
+
+	$self->print($tab,",subject:\"",$summary,"\"") if ($summary);
+	$self->print($tab,",content:\"",$memo,"\"") if ($memo);
+    }
+    $self->print($tab,"}\n");
+
+}
+
+
+#######################################################################/
+
+package Calcon::Sla300_read;
+
+# Linux Zaurus SLA300 の XML形式
+# でもなんか新しくなって、これではなくなったらしい。しくしく。
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Reader') ;
+
+use NKF;
+use Time::Local;
+
+my %keys = (
+   'birthday'=>'birth',
+   'businessfax'=>'fax',
+   'businessmobile'=>'keitai',
+   'businessphone'=>'tel',
+   'businessstate'=>'state',
+   'businessstreet'=>'address',
+   'businesszip'=>'zip',
+   'categories'=>'categories',
+   'company'=>'office',
+   'companypronunciation'=>'office-yomi',
+   'department'=>'section',
+   'description'=>'memo',
+   'emails'=>'mail',
+   'end'=>'end-date',
+   'firstname'=>'first-name',
+   'firstnamepronunciation'=>'first-name-yomi',
+   'homefax'=>'home-fax',
+   'homemobile'=>'home-keitai',
+   'homephone'=>'home-tel',
+   'homestate'=>'home_state',
+   'homestreet'=>'home-address',
+   'homezip'=>'home-zip',
+   'jobtitle'=>'title',
+   'lastname'=>'name',
+   'lastnamepronunciation'=>'name-yomi',
+   'notes'=>'memo',
+   'rid'=>'rid',
+   'rinfo'=>'rinfo',
+   'start'=>'date',
+   'uid'=>'uid',
+);
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'-keywords'} = \%keys;
+}
+
+sub decode {
+    my ($self,$file) = @_;
+    my $out = $self->{'-output'};
+
+    $self->{'-file'} = $file;
+    open(F,"<".$file);
+
+    $out->start_file('');
+
+    local($/) = ">";
+    while(<F>) {
+	$self->xml_decode($_);
+    }
+    $out->end_file('');
+}
+
+sub xml_decode {
+    my($self,$xml) = @_;
+    my($out) = $self->{'-output'};
+    my($convert) = $self->{'-keywords'};
+
+    $xml =~ s/^\s*<([^ ]*) // or return; 
+    my $type = $1;
+    $xml =~ s=/>\s*$== or return; 
+    $type =~ tr/A-Z/a-z/;
+    return if ($type ne 'contact' && $type ne 'event');
+    my $record = $self->make_record;
+    my $keys = [];
+    $_ = $xml;
+    while($_) {
+	if (s/^\s*([^\s]*)\s*\=\s*\"(.*?)\"\s*//) {
+	    my $key = $1;
+	    my $data = $2;
+	    $key =~ tr/A-Z/a-z/;
+	    $key = $convert->{$key} if ( $convert->{$key} );
+	    if ($key =~ /birth$/) {
+		my (@data) = ($data =~ /(\d+)/g);
+		$data = $self->make_date(join("/",@data));
+	    } elsif ($key =~ /date$/) {
+		$data = $self->make_date_unix($data);
+	    } else {
+		$data = nkf('-eZ -W',$data);
+	    }
+	    $record->{$key} = $data;
+	    push(@$keys,$key);
+	} else {
+	    s/^[^\s]*\s*//;
+	}
+    }
+    if (defined($record->{'type'}) && $record->{'type'} =~ /Allday/i) {
+	undef $record->{'end-date'};
+	@$keys = grep(!/^end-date/,@$keys);
+    }
+    $out->record($keys,$record);
+}
+
+
+#######################################################################/
+
+package Calcon::Sla300_write;
+
+# Linux Zaurus SLA300 の XML形式
+# でもなんか新しくなって、これではなくなったらしい。しくしく。
+
+use strict;
+# use warnings;
+use Time::Local;
+use NKF;
+use Carp;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ('Calcon::Buffered_Writer');
+
+# Mac OS X 10.2 's Address Book requires utf-16
+# | nkf -Z -e|iconv -c -f EUC-JP -t UTF-16 
+#
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'-fake-allday'} = 0;
+    $self->{'-time-for-allday'} = 12*3600;
+    $self->{'-add-time-for-allday'} = 2*3600;
+}
+
+sub write_datebook {
+    my ($self) = @_;
+    my $count = $self->{'-date-max'};
+
+    open(CAL,">datebook.xml") or croak($!);
+    $self->print ( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
+    $self->print ( "<!DOCTYPE DATEBOOK><DATEBOOK>\n");
+    $self->print ( "<RIDMax>$count</RIDMax>\n");
+    my $uid = -1032244274;
+    my $rid = 11;
+    
+    for my $dates ( @{$self->{'-date-records'}} ) {
+
+	my $end_date = $dates->{'end-date'};
+	if (! $end_date) { 
+	    if ($dates->{'date'}->is_allday()) {
+		if ($self->{'-fake-allday'}) {
+		    $dates->{'date'}=
+			$dates->{'date'}->add($self->{'-time-for-allday'});
+		    $dates->{'end-date'} = 
+			$dates->{'date'}->add($self->{'-add-time-for-allday'});
+		    $dates->{'date'} = $self->unix_time($dates->{'date'});
+		} else {
+		    $end_date = $dates->{'date'}->add(23*3600+59*60);
+		    $dates->{'type'} = "AllDay";
+		    $dates->{'date'} = $self->unix_time($dates->{'date'});
+		    $dates->{'end-date'} = $self->unix_time($end_date);
+		}
+	    } else {
+		$end_date = 
+		    $dates->{'date'}->add($self->{'-add-time-for-allday'});
+		$dates->{'date'} = $self->unix_time($dates->{'date'});
+		$dates->{'end-date'} = $self->unix_time($end_date);
+	    }
+	} else {
+	    $dates->{'date'} = $self->unix_time($dates->{'date'});
+	    $dates->{'end-date'} = $self->unix_time($dates->{'end-date'})
+	}
+	# warning killer
+	if (! defined($dates->{'summary'})) { $dates->{'summary'} = '';};
+	if (! defined($dates->{'memo'})) { $dates->{'memo'} = '';};
+	$dates->{'memo'} = nkf('-w -Z3',$dates->{'summary'}.$dates->{'memo'});
+
+	my $memo = $dates->{'memo'};
+	my $start_time = $dates->{'date'};
+	my $end_time   = $dates->{'end-date'};
+	$self->print("<event description=\"$memo\" categories=\"\" uid=\"$uid\" rid=\"$rid\" rinfo=\"1\" start=\"$start_time\"");
+	if ($dates->{'end-date'}) {
+	    $self->print(" end=\"$end_time\"");
+	}
+	if ($dates->{'type'}) {
+	    $self->print(" type=\"$dates->{'type'}\"");
+	}
+	$self->print("/>\n");
+	$uid++;
+	$rid++;
+	$count--;
+    }
+    $self->print("<events>\n");
+    $self->print("</events>\n");
+    $self->print("</DATEBOOK>\n");
+}
+
+sub write_addressbook {
+    my ($self) = @_;
+    my $count = $self->{'-adr-max'};
+
+    open(CAL,">addressbook.xml") or croak($!);
+
+    $self->print ( "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
+    $self->print ( "<!DOCTYPE Addressbook ><AddressBook>\n");
+    $self->print ( "<RIDMax>$count</RIDMax>\n");
+    $self->print ( "<Groups></Groups>\n");
+    for my $adr ( @{$self->{'-address-records'}} ) {
+
+	if (defined  $adr->{'birth'}){
+	      $adr->{'birth'} =  $self->birth_date($adr->{'birth'}) ;
+	}
+
+	my ($address) 		= $adr->{'address'};
+	my ($birth) 		= $adr->{'birth'};
+	my ($company) 		= $adr->{'office'};
+	my ($mail) 		= $adr->{'mail'};
+	my ($fax) 		= $adr->{'fax'};
+	my ($first_name) 	= $adr->{'first-name'};
+	my ($first_name_yomi) 	= $adr->{'first-name-yomi'};
+	my ($home_address) 	= $adr->{'home-address'};
+	my ($home_fax) 		= $adr->{'home-fax'};
+	my ($home_keitai) 	= $adr->{'home-keitai'};
+	my ($home_state) 	= $adr->{'home_state'};
+	my ($home_tel) 		= $adr->{'home-tel'};
+	my ($home_zip) 		= $adr->{'home-zip'};
+	my ($keitai) 		= $adr->{'keitai'};
+	my ($last_name) 	= $adr->{'name'};
+	my ($memo) 		= $adr->{'memo'};
+	my ($name_yomi) 	= $adr->{'name-yomi'};
+	my ($name) 		= $adr->{'name'};
+	my ($office_yomi) 	= $adr->{'office-yomi'};
+	my ($section) 		= $adr->{'section'};
+	my ($state) 		= $adr->{'state'};
+	my ($tel) 		= $adr->{'tel'};
+	my ($title) 		= $adr->{'title'};
+	my ($zip) 		= $adr->{'zip'};
+
+	$self->print ( "<Contact ");
+	$self->print ( "LastName=\"$last_name\" " ) if ($last_name);
+	$self->print ( "FirstName=\"$first_name\" " ) if ($first_name);
+	$self->print ( "JobTitle=\"$title\" " ) if ($title);
+	$self->print ( "Department=\"$section\" " ) if ($section);
+	$self->print ( "Company=\"$company\" " ) if ($company);
+	$self->print ( "Birthday=\"$birth\" " ) if ($birth);
+	$self->print ( "BusinessPhone=\"$tel\" " ) if ($tel);
+	$self->print ( "BusinessFax=\"$fax\" " ) if ($fax);
+	$self->print ( "BusinessStreet=\"$address\" " ) if ($address);
+	$self->print ( "BusinessState=\"$state\" " ) if ($state);
+	$self->print ( "BusinessZip=\"$zip\" " ) if ($zip);
+	$self->print ( "BusinessMobile=\"$keitai\" " ) if ($keitai);
+	$self->print ( "HomePhone=\"$home_tel\" " ) if ($home_tel);
+	$self->print ( "HomeMobile=\"$home_keitai\" " ) if ($home_keitai);
+	$self->print ( "HomeFax=\"$home_fax\" " ) if ($home_fax);
+	$self->print ( "HomeStreet=\"$home_address\" " ) if ($home_address);
+	$self->print ( "HomeState=\"$home_state\" " ) if ($home_state);
+	$self->print ( "HomeZip=\"$home_zip\" " ) if ($home_zip);
+	$self->print ( "Emails=\"$mail\" " ) if ($mail);
+	$self->print ( "Notes=\"$memo\" " ) if ($memo);
+	$self->print ( "rid=\"$count\" ");
+	$self->print ( "rinfo=\"1\" ");
+	$self->print ( "LastNamePronunciation=\"$name_yomi\" " ) if ($name_yomi);
+	$self->print ( "FirstNamePronunciation=\"$first_name_yomi\" " ) if ($first_name_yomi);
+	$self->print ( "CompanyPronunciation=\"$office_yomi\" " ) if ($office_yomi);
+	$self->print ( "/>\n");
+
+	$count--;
+    }
+    $self->print ( "</Contact>\n");
+    $self->print ( "</AddressBook>\n");
+}
+
+sub birth_date {
+    my ($self,$date) = @_;
+    my ($year,$month,$day,$hour,$min) = $date->localtime();
+
+    if ($date->is_day()) {
+	return "$month/$day";
+    }
+    return "$year/$month/$day";
+}
+
+sub print {
+    my ($self,@data) = @_;
+    print CAL nkf("-w -Z3",@data);
+}
+
+#######################################################################/
+
+package Calcon::Vcard_write;
+use strict;
+# use warnings;
+use NKF;
+
+# VCARD 形式
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Writer' );
+
+# Mac OS X 10.2 's Address Book requires utf-16
+# | nkf -Z -e|iconv -c -f EUC-JP -t UTF-16 
+#
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'-fake-allday'} = 0;
+    $self->{'-time-for-allday'} = 12*3600;
+    $self->{'-add-time-for-allday'} = 2*3600;
+}
+
+sub record {
+    my ($self,$keys,$record) = @_;
+    my ($application);
+
+    if(defined($record->{'name'})) {
+	$self->vcard($keys,$record);
+    } elsif(defined($record->{'date'})) {
+	if ($record->{'date'}) { return if ($self->{'-future-only'} && ! $record->{'date'}->future()); }
+	$self->vcal($keys,$record);
+    } else {
+	# I don't know.
+    }
+}
+
+sub end_file {
+    my ($self) = @_;
+    if ($self->{'-vcal-opening'}) {
+	print "END:VCALENDAR\n";
+	$self->{'-vcal-opening'} = 0;
+    }
+}
+
+sub print {
+    my ($self,@data) = @_;
+    foreach (@data) {
+	my $data = nkf('-s -Z',$_);
+	$data =~ s/\354\276/\203_/g;
+	$data =~ s/\356\276/  /g;
+	$data =~ s/\356\277/  /g;
+	$data =~ s/([^\200-\377])\\/$1\200/g;
+	# $data =~ s/\201/\/g;
+	$data = nkf('-w',$_);
+	$data =~ s/\000/ /g;
+	print $data;
+    }
+}
+
+sub vcal {
+    my ($self,$keys,$record) = @_;
+    my (%record) = %{$record};
+    my $data;
+
+    my $timezone = "Asia/Tokyo";
+
+    if (! $self->{'-vcal-opening'}) {
+    print(<<"EOFEOF");
+BEGIN:VCALENDAR
+CALSCALE:GREGORIAN
+X-WR-TIMEZONE;VALUE=TEXT:Asia/Tokyo
+METHOD:PUBLISH
+VERSION:2.0
+EOFEOF
+	$self->{'-vcal-opening'} = 1;
+    }
+
+#    if ($record{'date'}->is_allday() && $self->{'-fake-allday'}) {
+#	$record{'date'}=$record{'date'}->add($self->{'-time-for-allday'});
+#    }
+    my $dtstart = "\nDTSTART;TZID=$timezone:".$self->date($record{'date'});
+    my $dtend = '';
+    my $dtstamp = '';
+
+    if (! $record{'date'}->is_allday()) {
+	if (! defined( $record{'end-date'}) || $record{'end-date'} == $record{'date'} ) {
+	    # $dtend = "\nDURATION:PT2H";  this is useless for iCal
+	    $record{'end-date'} = $record{'date'}->add(
+		$self->{'-add-time-for-allday'});
+	    $dtend = "\nDTEND;TZID=$timezone:".$self->date($record{'end-date'});
+	} else {
+	    $dtend = "\nDTEND;TZID=$timezone:".$self->date($record{'end-date'});
+	}
+    } else {
+        $dtend = '';
+        $dtstart =~ s/T000000$//; 
+    }
+    if (defined( $record{'modify-date'})) {
+	$dtstamp = "\nDTSTAMP;TZID=$timezone:".$self->date($record{'modify-date'});
+    }
+
+    my $summary = '';
+    my $description = '';
+    if (defined($record{'memo'})) {
+	$summary = $record{'memo'};
+	if ($summary =~ s/[\r\n](.*)$// ) { $description = $1; }
+	$description =~ s/[\n\r]/\n /mg; 
+	$description =~ s/\s*$//;  
+	$summary =~ s/[\n\r]/ /mg; 
+	$summary =~ s/\s*$//;  
+    }
+
+    if ($description eq $summary) {
+	$description = "";
+    } else {
+	if ($description) {
+	    $description = "\nDESCRIPTION: $description";
+	}
+    }
+    return if (! $description && ! $summary );
+
+#     DURATION:PT1H = "DURATION:PT1H";
+#     X-WR-CALNAME;VALUE=TEXT:ホーム
+#     X-WR-TIMEZONE;VALUE=TEXT:Asia/Tokyo
+# SEQUENCE:$i
+
+    $self->print(<<"EOFEOF");
+BEGIN:VEVENT
+SUMMARY:$summary$dtstart$dtend$description$dtstamp
+END:VEVENT
+EOFEOF
+#    print "\n";
+}
+
+sub date {
+    my ($self,$date) = @_;
+    my ($year,$month,$day,$hour,$min) = $self->localtime($date);
+
+    $date = sprintf("%04d%02d%02dT%02d%02d%02d",
+	$year,$month,$day,$hour,$min,0);
+    return $date;
+}
+
+sub vcard {
+    my ($self,$keys,$record) = @_;
+    my (%record) = %{$record};
+    my $data;
+
+    if(defined($record{'office'})) {
+	$record{'office'} = 'etc' if(! $record{'office'}) ;
+    }
+    if(defined($record{'name-yomi'})) {
+	$record{'name-yomi'} =~ s/^ *//;
+    }
+    if(defined($record{'office-yomi'})) {
+	$record{'office-yomi'} =~ s/^ *//;
+    }
+    $record{'secret'} = ' ' if(! $record{'secret'});
+    $record{'alarm'} =  ' ' if(! $record{'alarm'}) ;
+    $record{'class'} = ' ' if(! defined($record{'class'}));
+    $record{'print-format'} = '2220' if(! defined($record{'print-format'}));
+    $record{'mark'} = '00' if(! defined($record{'mark'}));
+    $record{'priority'} = '01' if(! defined($record{'priority'}));
+    if ($record{'time'} =~ /(.*)-(.*)/) {
+	$record{'time'} = $1;
+	$record{'end-time'} = $2;
+    }
+
+    print "begin:vcard\n";
+    print "version:3.0\n";
+    if(defined $record{'name'}) {
+	$data =  $record{'name'};
+	print "FN:$data\n" if($data);
+	if(0 && defined $record{'name-yomi'}) {
+	    $data = join(";",split(/ /,$record{'name-yomi'}));
+	    print "N:$data\n" if($data);
+	} else {
+	    $data = join(";",split(/ /,$data));
+	    print "N:$data\n" if($data);
+	}
+	if(defined $record{'name-yomi'}) {
+	    my ($last , $first , $last_yomi , $first_yomi );
+	    $last = $first = $last_yomi = $first_yomi = '';
+	    ($last,$first) =  split(/ /,$record{'name'});
+	    ($last_yomi,$first_yomi) = split(/ /,$record{'name-yomi'}),
+#	    print YOMI $last,"\n";
+#	    print YOMI $last_yomi,"\n";
+#	    print YOMI $first,"\n";
+#	    print YOMI $first_yomi,"\n";
+	}
+
+	# print "fn:$data\n" if($data);
+	# if(defined $record{'office'}) {
+	#     $data = $data.";".$record{'office'};
+	# }
+	# print "n:$data\n" if($data);
+    }
+    if(defined $record{'office'}) {
+	 $data = "$record{'office'}";
+	if(defined $record{'section'}) {
+	    $data .= ";".$record{'section'};
+	}
+	print "org:$data\n" if($data);
+    }
+    if(defined $record{'title'}) {
+	 $data = "$record{'title'}";
+	print "title:$data\n" if($data);
+    }
+    if(defined $record{'address'}) {
+	my ($adr1 , $adr2 , $adr_state , $adr_zip , $adr_country ); 
+	$adr1 = $adr2 = $adr_state = $adr_zip = $adr_country = '';
+	$data =  $record{'address'};
+	$adr1 =  $record{'address'};
+# ADD:番地;;町村;沖縄;903-0213;日本
+	if(defined $record{'zip'}) {
+	    $adr_zip = $record{'zip'};
+	}
+#	    print "adr;type=work;type=pref:$data\n" if($data);
+print "adr;type=work;type=pref:;;$adr1;$adr2;$adr_state;$adr_zip;$adr_country\n" if ($data);
+	print "label;type=work;type=pref:$adr_zip $data\n" if($data);
+    }
+    if(defined $record{'tel'}) {
+	$data =  $record{'tel'};
+	print "tel;type=work:$data\n" if($data);
+    }
+    if(defined $record{'tel2'}) {
+	$data =  $record{'tel2'};
+	print "tel;type=cell:$data\n" if($data);
+    }
+    if(defined $record{'fax'}) {
+	$data =  $record{'fax'};
+	print "tel;type=fax:$data\n" if($data);
+    }
+    if(defined $record{'mail'}) {
+	$data =  $record{'mail'};
+	print "email;internet:$data\n" if($data);
+    } 
+    if(defined $record{'memo'}) {
+	$data =  $record{'memo'};
+	print "note:$data\n" if($data);
+    } 
+    if(defined $record{'birth'}) {
+	$data =  $record{'birth'};
+	print "bday:".$data->date()."\n" if($data);
+    }
+    if(defined $record{'name-yomi'}) {
+	$data =  $record{'name-yomi'};
+	print "x-custom1:$data\n" if($data);
+    }
+    if(defined $record{'office-yomi'}) {
+	$data =  $record{'office-yomi'};
+	print "x-custom2:$data\n" if($data);
+    }
+    print "end:vcard\n";
+    print "\n";
+}
+
+#######################################################################/
+
+package Calcon::Vcard_Apple_write;
+use strict;
+# use warnings;
+use NKF;
+
+# VCARD 形式
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Vcard_write' );
+
+# Mac OS X 10.3 's Address Book requires utf-16
+# | nkf -w16
+#
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    open(OUTPUT,"| nkf -w16") or die("nkf required.");
+    select OUTPUT;
+}
+
+sub print {
+    my ($self,@data) = @_;
+    foreach (@data) {
+	chop;
+	s/\015/\\n/g;
+	s/\012//g;
+	print "$_\n";
+    }
+}
+
+sub vcard {
+    my ($self,$keys,$record) = @_;
+    my (%record) = %{$record};
+    my $data;
+    $self->{'item'} = 1;
+
+    if(defined($record{'office'})) {
+	$record{'office'} = 'etc' if(! $record{'office'}) ;
+    }
+    if(defined($record{'name-yomi'})) {
+	$record{'name-yomi'} =~ s/^ *//;
+    }
+    if(defined($record{'office-yomi'})) {
+	$record{'office-yomi'} =~ s/^ *//;
+    }
+    $self->print("begin:vcard\n");
+    $self->print("version:3.0\n");
+    if(defined $record{'name'}) {
+	$data =  $record{'name'};
+	$self->print("FN:$data\n") if($data);
+	if(0 && defined $record{'name-yomi'}) {
+	    $data = join(";",split(/ /,$record{'name-yomi'}));
+	    $self->print("N:$data\n") if($data);
+	} else {
+	    $data = join(";",split(/ /,$data));
+	    $self->print("N:$data\n") if($data);
+	}
+	if(defined $record{'name-yomi'}) {
+	    my ($last , $first , $last_yomi , $first_yomi );
+	    $last = $first = $last_yomi = $first_yomi = '';
+	    ($last,$first) =  split(/ /,$record{'name'});
+	    ($last_yomi,$first_yomi) = split(/ /,$record{'name-yomi'}),
+	    $self->print("X-PHONETIC-LAST-NAME:$last_yomi\n");
+	    $self->print("X-PHONETIC-FIRST-NAME:$first_yomi\n");
+	}
+
+	# print "fn:$data\n" if($data);
+	# if(defined $record{'office'}) {
+	#     $data = $data.";".$record{'office'};
+	# }
+	# print "n:$data\n" if($data);
+    }
+#    my $cat = 0;
+    if(defined $record{'group'}) {
+	 $data = "$record{'group'}";
+	$self->print("CATEGORIES:$data\n") if($data);
+    }
+    if(defined $record{'office'}) {
+	 $data = "$record{'office'}";
+	$self->print("ORG:$data;\n") if($data);
+#	if ($cat==0) {
+#	    $self->print("CATEGORIES:$data\n") if($data);
+#	}
+    }
+    my $title;
+    if(defined $record{'section'}) {
+	$title = $record{'section'};
+    }
+    if(defined $record{'title'}) {
+	 $title .= ($title?'\n':'')."$record{'title'}";
+	$self->print("title:$data\n") if($data);
+    }
+    if(defined $record{'address'}) {
+	my $i = $self->{'item'}++;
+	my ($adr1 , $adr2 , $adr_state , $adr_zip , $adr_country ); 
+	$adr1 = $adr2 = $adr_state = $adr_zip = $adr_country = '';
+	$data =  $record{'address'};
+	$adr1 =  $record{'address'};
+# ADD:番地;;町村;沖縄;903-0213;日本
+	if(defined $record{'zip'}) {
+	    $adr_zip = $record{'zip'};
+	}
+$self->print("item$i.ADR;type=work;type=pref:;;$adr1;$adr2;$adr_state;$adr_zip;$adr_country\n") if ($data);
+    }
+    if(defined $record{'tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel'};
+	$self->print("TEL;type=WORK:$data\n") if($data);
+    }
+    if(defined $record{'mobile-tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mobile-tel'};
+	$self->print("TEL;type=CELL:$data\n") if($data);
+    }
+    if(defined $record{'home-tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel'};
+	$self->print("TEL;type=HOME:$data\n") if($data);
+    }
+    if(defined $record{'tel2'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel2'};
+	$self->print("TEL;type=CELL:$data\n") if($data);
+    }
+    if(defined $record{'fax'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'fax'};
+	$self->print( "TEL;type=FAX:$data\n") if($data);
+    }
+    if(defined $record{'home-address'}) {
+	my $i = $self->{'item'}++;
+	my ($adr1 , $adr2 , $adr_state , $adr_zip , $adr_country ); 
+	$adr1 = $adr2 = $adr_state = $adr_zip = $adr_country = '';
+	$data =  $record{'home-address'};
+	$adr1 =  $record{'home-address'};
+# ADD:番地;;町村;沖縄;903-0213;日本
+	if(defined $record{'home-zip'}) {
+	    $adr_zip = $record{'home-zip'};
+	}
+$self->print("item$i.ADR;type=home;type=pref:;;$adr1;$adr2;$adr_state;$adr_zip;$adr_country\n") if ($data);
+	# $self->print("item$1.X-ABADR:ja\n") if ($data);
+    }
+    if(defined $record{'mail2'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mail2'};
+	$self->print("EMAIL;type=INTERNET;type=home:$data\n") if($data);
+    } 
+    if(defined $record{'mail'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mail'};
+	$self->print("EMAIL;type=INTERNET;type=pref:$data\n") if($data);
+    } 
+    if(defined $record{'birth'}) {
+	$data =  $record{'birth'};
+	$self->print("bday:".$data->date()."\n") if($data);
+    }
+    if(defined $record{'memo'}) {
+	$data =  $record{'memo'};
+	$self->print("NOTE:$data\n") if($data);
+    }
+#    if(defined $record{'name-yomi'}) {
+#	$data =  $record{'name-yomi'};
+#	$self->print "x-custom1:$data\n" if($data);
+#    }
+#    if(defined $record{'office-yomi'}) {
+#	$data =  $record{'office-yomi'};
+#	$self->print "x-custom2:$data\n" if($data);
+#    }
+    $self->print("end:vcard\n");
+    $self->print("\n");
+}
+
+package Calcon::Vcard_N702iD_write;
+use strict;
+# use warnings;
+use NKF;
+
+# VCARD 形式
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Vcard_write' );
+
+# Q encoded Shift_JIS
+#
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'vcf_count'} = "PIM00001";
+#    open(OUTPUT,"| nkf -w16") or die("nkf required.");
+#    select OUTPUT;
+}
+
+sub print {
+    my ($self,@data) = @_;
+    foreach (@data) {
+	chop;
+	print "$_\r\n";
+    }
+}
+
+sub vcard {
+    my ($self,$keys,$record) = @_;
+    my (%record) = %{$record};
+    my $data;
+    $self->{'item'} = 1;
+    if (! $self->{'-vcard-opening'}) {
+	open(VCS,"| nkf -s >".$self->{'vcf_count'}++.".VCF");
+	$self->{'-vcard-opening'} = 1;
+	select VCS;
+    } else {
+	select VCS;
+    }
+
+    if(defined($record{'office'})) {
+	$record{'office'} = 'etc' if(! $record{'office'}) ;
+    }
+    if(defined($record{'name-yomi'})) {
+	$record{'name-yomi'} =~ s/^ *//;
+    }
+    if(defined($record{'office-yomi'})) {
+	$record{'office-yomi'} =~ s/^ *//;
+    }
+    $self->print("BEGIN:VCARD\n");
+    $self->print("VERSION:2.1\n");
+    if(defined $record{'name'}) {
+	$data =  $record{'name'};
+	$self->print("N;CHARSET=SHIFT_JIS:$data;;;;\n") if($data);
+	if(defined $record{'name-yomi'}) {
+	    $self->print("SOUND;X-IRMC-N;CHARSET=SHIFT_JIS:$record{'name-yomi'};;;;\n");
+	}
+
+	# print "fn:$data\n" if($data);
+	# if(defined $record{'office'}) {
+	#     $data = $data.";".$record{'office'};
+	# }
+	# print "n:$data\n" if($data);
+    }
+#    my $cat = 0;
+#    if(defined $record{'group'}) {
+#	 $data = "$record{'group'}";
+#	$self->print("CATEGORIES:$data\n") if($data);
+#    }
+#    if(defined $record{'office'}) {
+#	 $data = "$record{'office'}";
+#	$self->print("ORG:$data;\n") if($data);
+#	if ($cat==0) {
+#	    $self->print("CATEGORIES:$data\n") if($data);
+#	}
+#    }
+#    my $title;
+#    if(defined $record{'section'}) {
+#	$title = $record{'section'};
+#    }
+#    if(defined $record{'title'}) {
+#	 $title .= ($title?'\n':'')."$record{'title'}";
+#	$self->print("title:$data\n") if($data);
+#    }
+    if(defined $record{'address'}) {
+	my $i = $self->{'item'}++;
+	my ($adr1 , $adr2 , $adr_state , $adr_zip , $adr_country ); 
+	$adr1 = $adr2 = $adr_state = $adr_zip = $adr_country = '';
+	$data =  $record{'address'};
+	$adr1 =  $record{'address'};
+# ADD:番地;;町村;沖縄;903-0213;日本
+	if(defined $record{'zip'}) {
+	    $adr_zip = $record{'zip'};
+	}
+$self->print("ADR;CHARSET=SHIFT_JIS;HOME:;adr1;$adr2;$adr_state;;$adr_zip;");
+
+    }
+    if(defined $record{'tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel'};
+	$self->print("TEL;VOICE:$data\n") if($data);
+    } elsif(defined $record{'mobile-tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mobile-tel'};
+	$self->print("TEL;VOICE:$data\n") if($data);
+    } elsif(defined $record{'home-tel'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel'};
+	$self->print("TEL;VOICE:$data\n") if($data);
+    } elsif(defined $record{'tel2'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'tel2'};
+	$self->print("TEL;VOICE:$data\n") if($data);
+    }
+#    if(defined $record{'fax'}) {
+#	# my $i = $self->{'item'}++;
+#	$data =  $record{'fax'};
+#	$self->print( "TEL;type=FAX:$data\n") if($data);
+#    }
+#    if(defined $record{'home-address'}) {
+#	my $i = $self->{'item'}++;
+#	my ($adr1 , $adr2 , $adr_state , $adr_zip , $adr_country ); 
+#	$adr1 = $adr2 = $adr_state = $adr_zip = $adr_country = '';
+#	$data =  $record{'home-address'};
+#	$adr1 =  $record{'home-address'};
+# ADD:番地;;町村;沖縄;903-0213;日本
+#	if(defined $record{'home-zip'}) {
+#	    $adr_zip = $record{'home-zip'};
+#	}
+#$self->print("item$i.ADR;type=home;type=pref:;;$adr1;$adr2;$adr_state;$adr_zip;$adr_country\n") if ($data);
+	# $self->print("item$1.X-ABADR:ja\n") if ($data);
+#    }
+    if(defined $record{'mail2'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mail2'};
+	$self->print("EMAIL;INTERNET:$data\n") if($data);
+    } elsif(defined $record{'mail'}) {
+	# my $i = $self->{'item'}++;
+	$data =  $record{'mail'};
+	$self->print("EMAIL;INTERNET:$data\n") if($data);
+    } 
+    if(defined $record{'birth'}) {
+	$data =  $record{'birth'};
+	$self->print("BDAY:".$data->date()."\n") if($data);
+    }
+    if(defined $record{'memo'}) {
+	$data =  $record{'memo'};
+	$self->print("NOTE;CHARSET=SHIFT_JIS::$data\n") if($data);
+    }
+#    if(defined $record{'name-yomi'}) {
+#	$data =  $record{'name-yomi'};
+#	$self->print "x-custom1:$data\n" if($data);
+#    }
+#    if(defined $record{'office-yomi'}) {
+#	$data =  $record{'office-yomi'};
+#	$self->print "x-custom2:$data\n" if($data);
+#    }
+    if (defined $record{'group'} ) {
+	my $gno;
+	$record{'group'} =~ s/[\n\r]*//g;
+	if (! defined($self->{'-group'}->{$record{'group'}})) {
+	    # group 00 は特別らしい。
+	    $gno = $self->{-group}->{$record{'group'}}= ++$self->{'-groupno'}; 
+	} else {
+	    $gno = $self->{'-group'}->{$record{'group'}}; 
+	}
+	$self->print( "X-GNO:$gno\n");
+	$self->print( "X-GN;CHARSET=SHIFT_JIS:".$record{'group'}."\n");
+    }
+
+    $self->print("END:VCARD\n");
+    $self->print("\n");
+}
+
+sub vcal {
+    my ($self,$keys,$record) = @_;
+    my (%record) = %{$record};
+    my $data;
+
+    my $timezone = "Asia/Tokyo";
+    if (! $self->{'-vcal-opening'}) {
+	open(VCS,"| nkf -s >".$self->{'vcf_count'}++.".VCF");
+	$self->{'-vcal-opening'} = 1;
+	select VCS;
+	print(<<"EOFEOF");
+BEGIN:VCALENDAR
+VERSION:1.0
+EOFEOF
+    } else {
+	select VCS;
+    }
+
+    if ($record{'date'}->is_allday() && $self->{'-fake-allday'}) {
+	$record{'date'}=$record{'date'}->add($self->{'-time-for-allday'});
+    }
+    my $dtstart = "\nDTSTART:".$self->date($record{'date'});
+    my $dtend = '';
+    my $dtstamp = '';
+    my $group = '';
+
+    if (! defined( $record{'end-date'}) || $record{'end-date'} == $record{'date'} ) {
+	# $dtend = "\nDURATION:PT2H";  this is useless for iCal
+	$record{'end-date'} = $record{'date'}->add(
+	    $self->{'-add-time-for-allday'});
+	$dtend = "\nDTEND:".$self->date($record{'end-date'});
+    } else {
+	$dtend = "\nDTEND:".$self->date($record{'end-date'});
+    }
+    if (defined( $record{'modify-date'})) {
+	$dtstamp = "\nDTSTAMP:".$self->date($record{'modify-date'});
+    }
+
+    my $summary = '';
+    my $description = '';
+    if (defined($record{'memo'})) {
+	$summary = $record{'memo'};
+	$summary =~ s/[\r\n].*$//; $description = $&;
+
+	$description =~ s/[\n\r]/\n /mg; 
+	$description =~ s/\s*$//;  
+	$summary =~ s/[\n\r]/ /mg; 
+	$summary =~ s/\s*$//;  
+    }
+    # if (defined($record{'group'})) {
+# 	$group = "\nX-GN;CHARSET=SHIFT_JIS:".$record{'group'};
+ #    }
+
+    if ($description eq $summary) {
+	$description = "";
+    } else {
+	if ($description) {
+	    $description = "\nDESCRIPTION;CHARSET=SHIFT_JIS: $description";
+	}
+    }
+    return if (! $description && ! $summary );
+
+#     DURATION:PT1H = "DURATION:PT1H";
+#     X-WR-CALNAME;VALUE=TEXT:ホーム
+#     X-WR-TIMEZONE;VALUE=TEXT:Asia/Tokyo
+# SEQUENCE:$i
+
+# SUMMARY;CHARSET=SHIFT_JIS;ENCODING=QUOTED-PRINTABLE:=82=A9=82=A4
+    $self->print(<<"EOFEOF");
+BEGIN:VEVENT
+SUMMARY;CHARSET=SHIFT_JIS:$summary$dtstart$dtend$description$dtstamp
+CLASS:PUBLIC
+CATEGORIES:PERSONAL
+RRULE:
+END:VEVENT
+EOFEOF
+#    print "\n";
+}
+
+sub end_file {
+    my ($self,$type) = @_;
+
+    if ($self->{'-vcal-opening'}) {
+	select VCS;
+	$self->print(<<"EOFEOF");
+END:VCALENDAR
+EOFEOF
+	$self->{'-vcal-opening'} = 0;
+    }
+}
+
+
+#######################################################################/
+
+package Calcon::File_read;
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ( 'Calcon::Reader') ;
+
+# File 形式の読み込み。かなりいいかげんなものでも読み込むが...
+
+use NKF;
+
+sub initialize {
+    my ($self) = @_;
+    $self->SUPER::initialize();
+    $self->{'-email-extract'} = 1;
+}
+
+sub decode {
+    my ($self,$file) = @_;
+    my $out = $self->{'-output'};
+
+    $self->{'-file'} = $file;
+    open(F,"<".$file);
+
+    $out->start_file('');
+
+    local($/) = "\n\n";
+    while(<F>) {
+	$self->buffer_decode($_);
+    }
+    $out->end_file('');
+}
+
+# いいかげんなものでも読み込むためのルーチン
+
+sub buffer_decode {
+    my ($self,$buf,%initial) = @_;
+    my @data;
+    my $key;
+    my ($debug) = $self->{'-debug'};
+    my $i = 0;
+    my $out = $self->{'-output'};
+
+    # $_ =~ s/\n\s+/ /g;
+    # s/\n[ \t]/\037/g;
+
+    $buf =~ s/^\s*//;
+    @data = split(/\n/,$buf);
+    my $record = $self->make_record;
+    my $keys = [];
+
+    foreach my $key (keys %initial) {
+	$record->{$key} = $initial{$key};
+	push(@$keys,$key);
+    }
+    foreach $_ (@data) {
+	if (s/^([A-Za-z][-A-Za-z0-9_]*):\s*//) {
+	    $key = $1;
+	} else {
+	    $key = 'memo';
+	}
+	$key = 'memo' if ($key eq '');
+        if ($key eq 'Subject') {
+	    $key = 'memo';
+        }
+	s/^(\201\100)*//;
+	$_ = nkf('-sZ',$_);
+	if($key eq 'time' || $key eq 'end-time') {
+	    $record->{$key} = $_; 
+	    next;
+	}
+	if(!($key eq 'date' || $key eq 'end-date')) {
+	    my $save = $_;
+	    my $savekey = $key;
+
+	    my $stime;
+	    my $etime;
+	    # use extra . to avoid regex bug
+	    if (/(\d+:\d+).*[-~].*?(\d+:\d+)/) {
+		$stime = $1;
+		$etime = $2;
+# print "*0** $stime $etime\n";
+	    } elsif (/(\d+:\d+).*\201\140.*?(\d+:\d+)/) { # 〜
+		$stime = $1;
+		$etime = $2;
+# print "*1** $stime $etime\n";
+	    } elsif (/(\d+:\d+).*\201\250.*?(\d+:\d+)/) { # →
+		$stime = $1;
+		$etime = $2;
+# print "*2** $stime $etime\n";
+	    } elsif (/(\d+:\d+)/) {
+		$stime = $1;
+	    }
+	    if ($stime) {
+		my $date = $record->{'date'};
+		if ($date) {
+                    if ($record->{'memo'}) {
+			$self->date_normalize($keys,$record);
+			$out->record($keys,$record);
+
+			$record = $self->make_record; $keys = [];
+			foreach my $key (keys %initial) {
+			    $record->{$key} = $initial{$key};
+			    push(@$keys,$key);
+			}
+			$record->{'date'} = $date;
+			push(@$keys,'date');
+		    }
+		    if (! $record->{'time'}) {
+			$record->{'time'} = $stime;
+			push(@$keys,'time');
+		    }
+		    if (! $record->{'end-time'}) {
+			$record->{'end-time'} = $etime;
+			push(@$keys,'end-time');
+		    }
+		    $_ = $save;
+		    $key = $savekey;
+		}
+	    }
+	} else {
+	    # don't append time field
+	    push(@$keys,$key);
+	    $record->{$key} = $_; 
+	    next;
+	}
+	if ($self->{'-email-extract'}) {
+	    if(s/[-a-zA-Z0-9._]+@[-a-zA-Z0-9._]+//) {
+		if (defined($record->{'mail'})) {
+		    $record->{'mail'} .= ",".$&;
+		} else {
+		    $record->{'mail'} = $&;
+		    push(@$keys,'mail');
+		}
+	    }
+	}
+	next if (! $_);
+	if(defined $record->{$key}) {
+	    $record->{$key} .= "\n " . $_;    # append for duplicated field
+	} else {
+	    push(@$keys,$key);
+	    $record->{$key} = $_; 
+	}
+    }
+    $self->date_normalize($keys,$record);
+    $out->record($keys,$record);
+}
+
+#######################################################################/
+
+package Calcon::Xcalendar_read;
+
+# XCalendar 形式の読み込み。かなりいいかげんなものでも読み込むが...
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Time::Local;
+use NKF;
+
+@ISA = ( 'Calcon::File_read' ) ;
+
+sub decode {
+    my ($self,$file) = @_;
+    my @data;
+    my $key;
+    my ($debug) = $self->{'-debug'};
+    my $i = 0;
+    my $out = $self->{'-output'};
+
+    $self->{'-file'} = $file;
+    my $calendar = $file;
+
+    # my $i = 0;
+    my $found = 1;
+    my $today = time;
+    my $daytime = 60*60*24*2;
+
+    my $all = 1; 
+    my $tomorrow = $self->{'-tomorrow'}; 
+
+    my %xcal;
+
+    while(<$calendar/xc*>) {
+	my $file = $_;
+	my $date = $self->make_xcalendar_date($file);
+	next if (! defined $date->unix_time);
+	next if ($self->{'-tomorrow'} && ! $date->tomorrow());
+	next if ($self->{'-future-only'} && ! $date->future());
+        $xcal{$date->unix_time()} = $file;
+    }
+
+    $out->start_file('');
+
+    $i= $all ? -1 : 4;
+    foreach my $key ( sort {$a <=> $b;} keys(%xcal) ) {
+        $found = 0;
+        open(XCAL,$xcal{$key}) || next;
+        my ($sec,$min,$hour,$day,$month,$year,$wday,$date_,$isdst) =
+		    localtime($key);
+	my $date;
+	$date = ($year+1900)."/".($month+1)."/$day";
+	local($/) = "\n\n";
+        while(<XCAL>) {
+	    $self->buffer_decode($_,'date'=>$date);
+	}
+        last if($i-- == 0);
+    }
+    $out->end_file('');
+}
+
+#######################################################################/
+
+# 別に Xcalendar class のメソッドでもいいんだけど。
+
+package Calcon::Date ;
+
+use vars qw(%monthname);
+
+sub make_xcalendar_date {
+    my ($self,$name) = @_;
+
+    my $date;
+    if ($name =~ m^xc([0-9]+)([A-Za-z]+)([0-9]+)$^) {
+	my $day = $1 ;my $month = $monthname{$2}; my $year = $3;
+	# if($year > 1900) { $year -= 1900; }
+	$date = &timelocal(0,0,0,$day,$month,$year,0,0,0);
+    }
+    bless \$date;
+}
+
+#######################################################################/
+
+package Calcon::Basic ;
+
+sub make_xcalendar_date {
+    my ($self,$name) = @_;
+    $date_class->make_xcalendar_date($name);
+}
+
+#######################################################################/
+
+package Calcon::Xcalendar_write ;
+
+# Xcalendar 形式の書き出し
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+@ISA = ('Calcon::Writer');
+use NKF;
+
+sub initialize {
+    my ($self) = @_;
+    if (defined $self->{'-file'}) {
+	$self->{'-directory'} = defined $self->{'-file'};
+	undef  $self->{'-file'};
+    } else {
+	$self->{'-directory'} = "$ENV{'HOME'}/Calendar.new";
+    }
+    $self->SUPER::initialize();
+    mkdir $self->{'-directory'};
+}
+
+sub record {
+    my ($self,$keys,$record) = @_;
+    my @keys = @$keys;
+    my %record = %$record;
+    # should be override
+    return if (! $record->{'date'} );
+    return if ($self->{'-future-only'} && ! $record->{'date'}->future()); 
+    $self->open($record->{'date'});
+    foreach my $key (@keys) {
+	my $value = $record{$key};
+	if (ref $value) {
+	    $value = $value->value();
+	}
+	print nkf('-e',"$key: $value\n") if ($value);
+    }
+    print "\n";
+    $self->close();
+}
+
+sub open {
+    my ($self,$date) = @_;
+    my $name = $date->xcalendar_file_name;
+    if (defined($self->{'-directory'})) {
+	$name = $self->{'-directory'}."/".$name;
+    } 
+    open(OUT,">>".$name);
+    select OUT;
+}
+
+sub close {
+    close OUT;
+}
+
+#######################################################################/
+
+package Calcon::Date;
+
+sub xcalendar_file_name {
+    my ($self) = @_;
+    my ($year,$month,$day,$hour,$min) = $self->localtime();
+    sprintf("xc%02d%s%04d",$day,$monthname[$month-1],$year);
+}
+
+#######################################################################/
+
+package Calcon::Entourage_read;
+
+# Mac のEntourage から AppleScript 経由で読み込む
+# ファイルからでも読み込み可能
+# Zaurus のCSVも読めた方が良いね
+# 日本語専用
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+# use Mac::AppleScript qw(RunAppleScript);
+use NKF;
+use Carp;
+@ISA = ( 'Calcon::File_read' ) ;
+
+# We use Applescript, but it is very slow.
+# get_all_event is slightly faster.
+# To convert contact, it is better to use export address in Entourage Menu.
+# If it has a file name other than '/dev/stdin', it assumes export file.
+
+my %item_keys = (
+    "名"=>"first name",
+    "姓"=>"last name",
+    "敬称"=>"sir name",
+    "Suffix"=>"suffix",
+    "ニックネーム"=>"nick name",
+    "会社名"=>"company",
+    "役職"=>"title",
+    "部署"=>"department",
+    "番地 (勤務先)"=>"business address street address",
+    "市区町村 (勤務先)"=>"business address city",
+    "都道府県 (勤務先)"=>"business address state",
+    "郵便番号 (勤務先)"=>"business address zip",
+    "国/地域 (勤務先)"=>"business address country",
+    "Web ページ (勤務先)"=>"www",
+    "番地 (自宅)"=>"home address street address",
+    "市区町村 (自宅)"=>"home address city",
+    "都道府県 (自宅)"=>"home address state",
+    "郵便番号 (自宅)"=>"home address zip",
+    "国/地域 (自宅)"=>"home address country",
+    "Web ページ (自宅)"=>"home www",
+    "電話 1 (自宅)"=>"home phone number",
+    "電話 2 (自宅)"=>"home tel2",
+    "FAX (自宅)"=>"home fax number",
+    "電話 1 (勤務先)"=>"business phone number",
+    "電話 2 (勤務先)"=>"tel2",
+    "FAX (勤務先)"=>"business fax number",
+    "ポケットベル"=>"pager",
+    "携帯電話"=>"mobile phone number",
+    "電話 (メイン)"=>"main phone number",
+    "電話 (アシスタント)"=>"sub tel",
+    "電話 (ユーザー設定 1)"=>"tel 1",
+    "電話 (ユーザー設定 2)"=>"tel 2",
+    "電話 (ユーザー設定 3)"=>"tel 3",
+    "電話 (ユーザー設定 4)"=>"tel 4",
+    "電子メール アドレス 1"=>"mail-address",
+    "電子メール アドレス 2"=>"business mail",
+    "電子メール アドレス 3"=>"mail",
+    "電子メール アドレス 4"=>"mail-to",
+    "電子メール アドレス 5"=>"mail 5",
+    "電子メール アドレス 6"=>"mail 6",
+    "電子メール アドレス 7"=>"mail 7",
+    "電子メール アドレス 8"=>"mail 8",
+    "電子メール アドレス 9"=>"mail 9",
+    "電子メール アドレス 10"=>"mail 10",
+    "電子メール アドレス 11"=>"mail 11",
+    "電子メール アドレス 12"=>"mail 12",
+    "電子メール アドレス 13"=>"mail 13",
+    "メモ 1"=>"memo",
+    "メモ 2"=>"memo 2",
+    "メモ 3"=>"memo 3",
+    "メモ 4"=>"memo 4",
+    "メモ 5"=>"memo 5",
+    "メモ 6"=>"memo 6",
+    "メモ 7"=>"memo 7",
+    "メモ 8"=>"memo 8",
+    "日付 1 :"=>"date",
+    "日付 2 :"=>"date 2",
+    "配偶者"=>"spouse",
+    "誕生日"=>"birthday",
+    "記念日"=>"aniversary",
+    "備考"=>"note",
+    "年齢"=>"age",
+    "星座"=>"astology sign",
+    "血液型"=>"blood type",
+    "会社名 (ふりがな)"=>"company furigana",
+    "名 (ふりがな)"=>"first name furigana",
+    "姓 (ふりがな)"=>"last name furigana",
+    "配偶者名 (ふりがな)"=>"spouse furigana",
+    "趣味"=>"play",
+);
+
+$| = 0;
+# my $tell = "tell application \"Microsoft Entourage\"\n";
+$tell = "tell application \"Microsoft Entourage\"\n";
+
+sub decode {
+    my ($self,$file) = @_;
+    my ($debug) = $self->{'-debug'};
+    my $out = $self->{'-output'};
+    if (! $file || $file ne '/dev/stdin') {
+	$self->read_export($file);
+    }
+
+    $out->start_file('');
+    $self->get_all_event() if (! $self->{'-address-only'});
+    $self->get_all_contact() if (! $self->{'-calendar-only'});
+    $out->end_file('');
+
+}
+
+sub date {
+    my ($self,$date)=@_;
+    my @date = ($date =~ /(\d+)/g);
+    if ($date =~ /PM$/) {
+	if ($date[3]==12) { $date[3]=0;}
+	$date[3]+=12;
+    }
+    return $self->make_date("$date[0]/$date[1]/$date[2] $date[3]:$date[4]");
+}
+
+sub read_export {
+    my ($self,$file) = @_;
+
+    open(IN,"<$file") or cloak("$@");
+    local($/) = "\r";
+
+    my $title = <IN>;
+    chop($title);
+
+    return if (eof(IN));
+
+    my @keys = split(/\t/,nkf('-eS',$title));
+    my $i = 0;
+    my %keys;
+    foreach my $key (@keys) {
+	$keys{$item_keys{$key}} = $i++;
+    }
+    # foreach my $key (@keys) {
+    # 	print "$key:$item_keys{$key}:$keys{$item_keys{$key}}\n";
+    # }
+
+    $self->{'-input-keys'} = \%keys;
+    my $i0 = 0;
+    while(<IN>) {
+	my @items;
+	chop;
+	@items = split(/\t/,$_);
+	$self->{'-input'}->[$i0++] = \@items;
+    }
+    $self->{'-input-count'} = $i0;
+}
+
+sub property {
+    my ($self,$contact,$id,$property,$record,$key) = @_;
+    my $result;
+    if ($self->{'-input-count'}) {
+	$result = $self->{'-input'}->[$id]->[$self->{'-input-keys'}->{$property}];
+	if (! defined($self->{'-input-keys'}->{$property}) ) {
+	    print "$property not found\n";
+	}
+    } else {
+	$result = RunAppleScript("${tell}${property} of ${contact} $id\nend tell\n");
+    }
+    $result =~ s/^\"//;
+    $result =~ s/\"$//;
+    if (defined($record) && $result ne '') {
+	if ($key =~ /date/ || $key =~ /birth/) {
+	    $record->{$key} = $self->date($result);
+	} else {
+	    $record->{$key} = nkf('-eS',$result);
+	}
+    } else {
+	nkf('-eS',$result);
+    }
+}
+
+sub address {
+    my ($self,$id,$property,$record,$key) = @_;
+    my $address;
+    my ($street , $zip , $state , $country , $city);
+
+    if ($self->{'-input-count'}) {
+	my $l = $self->{'-input'}->[$id];
+        my $k = $self->{'-input-keys'};
+	$address = $l->[$k->{"$property street address"}];
+	$zip =     $l->[$k->{"$property zip"}];
+	$state =   $l->[$k->{"$property state"}];
+	$city =    $l->[$k->{"$property city"}];
+	$country = $l->[$k->{"$property country"}];
+    } else {
+	$address = RunAppleScript("${tell}${property} of contact $id\nend tell\n");
+	$address =~ /street address:"([^"]*)"/ && ($street = $1);
+	$zip =~ /zip:"([^"]*)"/ && ($zip = $1);
+	$state =~ /state:"([^"]*)"/ && ($state = $1);
+	$city =~ /city:"([^"]*)"/ && ($city = $1);
+	$country =~ /country:"([^"]*)"/ && ($country = $1);
+    }
+
+
+    $record->{$key} = nkf('-eS',"$state $city $street $country")
+	if ($state||$city||$street||$country);
+    if ($zip && $key =~ /home/) {
+	$record->{'home-zip'} = $zip;
+    } else {
+	$record->{'zip'} = $zip if ($zip);
+    }
+}
+
+sub get_all_contact {
+    my ($self) = @_;
+    my $out = $self->{'-output'};
+    my $count;
+    if ($self->{'-input-count'}) {
+	$count = $self->{'-input-count'};
+    } else {
+	$count = RunAppleScript("${tell}count of contact\nend tell\n") or croak("$@");
+    }
+
+    foreach my $id ( 1..$count ) {
+	$self->contact($id);
+    }
+}
+
+sub contact {
+    my ($self,$id) = @_;
+    my $record = $self->make_record;
+
+    $self->property('contact',$id,'business phone number',$record,'tel');
+    $self->property('contact',$id,'home phone number',$record,'tel-home');
+    $self->property('contact',$id,'mobile phone number',$record,'mobile-tel');
+    $self->property('contact',$id,'main phone number',$record,'tel');
+    $self->property('contact',$id,'home fax number',$record,'home-fax');
+    $self->property('contact',$id,'business fax number',$record,'fax');
+    
+    my $name = $self->property('contact',$id,'last name');
+    my $first_name = $self->property('contact',$id,'first name');
+    $record->{'name'} = ($name && $first_name)?"$name $first_name":
+	($name)?$name:$first_name;
+
+    my $name_p = $self->property('contact',$id,'last name furigana');
+    my $first_name_p = $self->property('contact',$id,'first name furigana');
+    $record->{'name-yomi'} = ($name_p && $first_name_p)?"$name_p $first_name_p":
+	($name_p)?$name_p:$first_name_p;
+
+    $self->property('contact',$id,'department',$record,'section');
+    $self->property('contact',$id,'title',$record,'title');
+
+    $self->address($id,'business address',$record,'address');
+    $self->address($id,'home address',$record,'home-address');
+
+    my $mail = $self->property('contact',$id,'mail');
+    my $mail1 = $self->property('contact',$id,'mail-to');
+    if ($mail) { $mail .= ",".$mail1 ;} else { $mail = $mail1;}
+    my $mail2 = $self->property('contact',$id,'mail-address');
+    if ($mail) { $mail .= ",".$mail1 ;} else { $mail = $mail2;}
+
+    $self->property('contact',$id,'birthday',$record,'birth');
+    $self->property('contact',$id,'company',$record,'office');
+    $self->property('contact',$id,'company furigana',$record,'office-yomi');
+
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    # $self->date_normalize($keys,$record);
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+sub get_all_event {
+    my ($self) = @_;
+    my $out = $self->{'-output'};
+    my $count ;
+    if ($self->{'-input-count'}) {
+	for(my $id=1; $id <= $count ;$id++) {
+	    $self->event($id);
+	}
+	return;
+    } elsif ($self->{'-future-only'}) {
+	my $today = $self->today();
+        my ($year,$mon,$mday,$hour,$min) = $today->localtime();
+
+	$_ = "${tell}id of every event whose start time > date \"$year/$mon/$mday\"\nend tell\n";
+	$count = RunAppleScript($_) or cloak("$@ $_");
+	for my $id ($count =~ /(\d+)/g) {
+	    $self->event_id($id);
+	}
+    } else {
+	$count = RunAppleScript("${tell}count of event\nend tell\n") or croak("$@");
+	for(my $id=1; $id <= $count ;$id++) {
+	    $self->event($id);
+	}
+    }
+}
+
+sub event {
+    my ($self,$id) = @_;
+    my $record = $self->make_record;
+
+    $self->property('event',$id,'all day event',$record,'all-day');
+    $self->property('event',$id,'start time',$record,'date');
+
+    if ($record->{'all-day'} ne "true") {
+	$self->property('event',$id,'end time',$record,'end-date');
+    }
+    $self->property('event',$id,'subject',$record,'summary');
+    $self->property('event',$id,'content',$record,'memo');
+
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+sub event_id {
+    my ($self,$id) = @_;
+    my $record = $self->make_record;
+
+    $self->property('event id',$id,'all day event',$record,'all-day');
+    $self->property('event id',$id,'start time',$record,'date');
+
+    if ($record->{'all-day'} ne "true") {
+	$self->property('event id',$id,'end time',$record,'end-date');
+    }
+    $self->property('event id',$id,'subject',$record,'summary');
+    $self->property('event id',$id,'content',$record,'memo');
+
+    my $keys = [];
+    push(@$keys,keys %{$record});
+
+    my $out = $self->{'-output'};
+    $out->record($keys,$record);
+}
+
+
+#######################################################################/
+
+package Calcon::Vcard_read;
+
+# Vcard / Vcal 形式を読み込む
+#  Vcard に読みがないのが日本語向きじゃないね
+#  みんな勝手に拡張しているらしい
+
+use strict;
+# use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+@ISA = ( 'Calcon::File_read' ) ;
+
+sub quoted_printable
+{
+    my ($d) = @_;
+    while ($d=~ s/\=$//) {  # continuation line?
+	my $r = <F>;
+	chop($r);
+	$r =~ s/\r//g;
+	$d .= $r;
+    }
+    $d =~ s/=([0-9a-fA-F][0-9a-fA-F])/sprintf("%c",hex($1))/eg;
+    return ": ".$d;
+}
+
+sub decode {
+    my ($self,$file) = @_;
+    my ($debug) = $self->{'-debug'};
+    my $out = $self->{'-output'};
+    my $record;
+    my $keys;
+
+    $self->{'-file'} = $file;
+    open(F,"<".$file);
+
+    $out->start_file('');
+
+    while(<F>) {
+s/\r//g;
+s/\;CHARSET\=SHIFT_JIS//g;
+s/\;CHARSET\=EUC//g;
+s/\;ENCODING\=QUOTED\-PRINTABLE:(.*)/&quoted_printable($1)/eg;
+if (/^begin:\s*vcalendar/i) {
+} elsif (/^begin:\s*vcad/i) {
+} elsif (/^end:\s*vcalendar/i) {
+} elsif (/^begin:\s*vcalendar/i) {
+} elsif (/^adr(.*):\s*(.*)/i) { $self->items($record,'address',$1,$2);
+} elsif (/^bday:\s*(.*)/i) { $record->{'birth'} = $self->make_date($1);
+} elsif (/^begin:\s*vcard/i) {  $record = $self->make_record;
+} elsif (/^begin:\s*vevent/i) { $record = $self->make_record;
+} elsif (/^calscale:\s*(.*)/i) {
+} elsif (/^uid:\s*(.*)/i) {
+} elsif (/^x-gn:\s*(.*)/i) { $record->{'group'} .= $1;
+} elsif (/^description:\s*(.*)/i) { $record->{'memo'} .= $1;
+    $record->{'memo'} =~ s/-output-vcard//ig;
+} elsif (/^class/i) {
+} elsif (/^aalarm/i) {
+} elsif (/^dalarm/i) {
+} elsif (/^photo/i) {
+} elsif (/^rrule/i) {
+} elsif (/^version/i) {
+} elsif (/^X-NEC-SUMMARY:/i) {
+} elsif (/^X-NEC-FILENAME:/i) {
+} elsif (/^X-NO:/i) {
+} elsif (/^X-CLASS:/i) {
+} elsif (/^X-GNO:/i) {
+} elsif (/^X-ABUID:/i) {
+} elsif (/^note:\s*(.*)/i) { $record->{'memo'} .= $1;
+} elsif (/^dtend(.*):\s*(.*)/i) { $record->{'end-date'} = $self->date($2,$1?$1:$record->{'timezone'});
+} elsif (/^dtstamp(.*):\s*(.*)/i) { $record->{'modify-date'} = $self->date($2,$1?$1:$record->{'timezone'});
+} elsif (/^dtstart(.*):\s*(.*)/i) { $record->{'date'} = $self->date($2,$1?$1:$record->{'timezone'});
+} elsif (/^duration:\s*(.*)/i) { $self->duration($record,$1);
+} elsif (/^email(.*):\s*(.*)/i) { $self->items($record,'mail',$1,$2);
+} elsif (/^end:\s*vcard/i) { $self->vcard($record);
+} elsif (/^end:\s*vevent/i) { 
+    next if ($record->{'memo'} =~ /^\s+$/);
+    $self->event($record);
+} elsif (/^fn:\s*(.*)/i) { $self->name($record,$1);
+} elsif (/^label(.*):\s*(.*)/i) { $self->items($record,'address',$1,$2);
+} elsif (/^method:\s*(.*)/i) {  $record->{'publish'} = $1;
+} elsif (/^n:\s*(.*)/i) {  $self->name($record,split(/;/,$1));
+} elsif (/^org:\s*(.*)/i) { $record->{'office'} = $1;
+} elsif (/^sequence:\s*(.*)/i) { $record->{'sequence'} = $1;
+} elsif (/^categories:\s*(.*)/i) { $record->{'group'} = $1;
+} elsif (/^summary:\s*(.*)/i) { $record->{'summary'} = $1;
+} elsif (/^tel(.*):\s*(.*)/i) { $self->items($record,'tel',$1,$2);
+} elsif (/^title:\s*/i) { $record->{'title'} = $1;
+} elsif (/^version:\s*(.*)/i) { $record->{'version'} = $1;
+} elsif (/^X-PHONETIC-LAST-NAME:\s*(.*)/i) { $record->{'name-yomi'} .= "$1 ";
+} elsif (/^X-PHONETIC-FIRST-NAME:\s*(.*)/i) { $record->{'name-yomi'} .= "$1 ";
+} elsif (/^SOUND.*:\s*(.*)/i) { $record->{'name-yomi'} .= "$1 "; 
+    $record->{'name-yomi'} =~ s/;/ /g;
+} elsif (/^x-custom1:\s*(.*)/i) { $record->{'name-yomi'} = $1;
+} elsif (/^x-custom2:\s*(.*)/i) { $record->{'office-yomi'} = $1;
+} elsif (/^x-wr-calname.*:\s*(.*)/i) { $record->{'calendar'} = $1;
+} elsif (/^x-wr-timezone.*:\s*(.*)/i) { $record->{'timezone'} = $1;
+} elsif (/^item\d+(.*):\s*(.*)/i) { $self->items($record,'address',$1,$2);
+} else {
+    chop;
+    if ($record->{'extra'}) { $record->{'extra'} .= "\n "; }
+    $record->{'extra'} .= $_;
+}
+    }
+    $out->end_file('');
+}
+
+sub duration {
+    my ($self,$record,$duration)=@_;
+    if ($duration =~ /pt(\d+)h/) {
+	$record->{'duration'} = "$1:00";
+    }
+}
+
+sub date {
+    my ($self,$date,$timezone)=@_;
+    if ($date =~ /(\d\d\d\d)(\d\d)(\d\d)t(\d\d)(\d\d)(\d\d)/i) {
+	return $self->make_date("$1/$2/$3 $4:$5");
+    } elsif ($date =~ /(\d\d\d\d)(\d\d)(\d\d)/i) {
+	return $self->make_date("$1/$2/$3");
+    } else  {
+	return "";
+    }
+}
+
+sub event {
+    my ($self,$record)=@_;
+    my $out = $self->{'-output'};
+    my $keys = [];
+    push(@$keys,keys %{$record});
+    $out->record($keys,$record);
+}
+
+sub vcard {
+    my ($self,$record)=@_;
+    my $out = $self->{'-output'};
+    my $keys = [];
+    push(@$keys,keys %{$record});
+    $out->record($keys,$record);
+}
+
+sub items {
+    my ($self,$record,$label,$type,$value)=@_;
+# $record->{''} = $1;;type=work;type=pref;
+# $adr1;$adr2;$adr_state;$adr_zip;$adr_country
+    if ($type =~ /home/i) {
+	$label = "home-".$label;
+    } elsif ($type =~ /voice/i) {
+    } elsif ($type =~ /internet/i) {
+    } elsif ($type =~ /fax/i) {
+	$label = "fax";
+    } elsif ($type =~ /work/i) {
+    }
+    $record->{$label} = $value;
+}
+
+sub name {
+    my ($self,$record,@names)=@_;
+    $record->{'name'} = "@names";
+}
+
+1;
+
+__END__
+
+=cut
+
+=head1 NAME
+
+Calcon.pm -- Convert Various Calendar/Address data format
+
+=head1 SYNOPSIS
+
+  use Calcon;
+
+=head1 ABSTRACT
+
+abstract
+
+=head1 DESCRIPTION
+
+=head2 EXPORT
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Shinji KONO, E<lt>kono@ie.u-ryukyu.ac.jpE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+#######################################################################/
+##
+##  Calendar/Address Format Converter
+##
+##  Copyright (C) 2002  Shinji Kono
+##
+##    このソースのいかなる複写，改変，修正も許諾します。ただし、
+##    その際には、誰が貢献したを示すこの部分を残すこと。
+##    再配布や雑誌の付録などの問い合わせも必要ありません。
+##    営利利用も上記に反しない範囲で許可します。
+##    バイナリの配布の際にはversion messageを保存することを条件とします。
+##    このプログラムについては特に何の保証もしない、悪しからず。
+##
+##    Everyone is permitted to do anything on this program 
+##    including copying, modifying, improving,
+##    as long as you don't try to pretend that you wrote it.
+##    i.e., the above copyright notice has to appear in all copies.  
+##    Binary distribution requires original version messages.
+##    You don't have to ask before copying, redistribution or publishing.
+##    THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE.
+##
+##
+## $Id: Calcon.pm,v 1.14 2008/11/08 05:24:55 kono Exp $
+#######################################################################/
+
+
+=cut
diff -r 000000000000 -r 1fc0675b44cd Changes
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Changes	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,187 @@
+Revision history for Perl extension Calcon.
+
+Fri Mar 24 16:52:32 JST 2006
+
+N702iD �Ѥ� Vcard ���դ��ä��ޤ�����
+
+ʣ���ե�����򰷤��ʤ���ľ���������ϤϤ��Ƥߤ�����
+���ޤ����äƤʤ��ߤ�����
+
+Sat Jan 25 15:25:12 JST 2003
+
+warning �Ϥ��뤵�����Ǥ⡢�빽������ɡ��¹Ի��ˤ�����ޤ����ʤ�
+warning �Ϥ�����ʤ���
+
+test �ǡ�������ʤ��Ȥ�����ʡ�
+
+�ʤ�ȡ����쥯�饹��initialize ����Ƥ��������ޤä���Τ���
+
+0.01  Fri Jan 24 13:35:34 2003
+	- original version; created by h2xs 1.22 with options
+		-AX -n Calcon
+
+Mon Jan 20 14:34:10 JST 2003
+
+Merge �����
+
+buffer read ���Τ� shift jis ���֤��ߤ�����
+
+output flie �����Ǥ�������������
+
+Fri Jan 17 21:18:12 JST 2003
+
+Pool �����
+
+��äѤꡢ$record ���Τ����֥������ȤǤ���٤�����͡�
+
+Tue Jan 14 16:52:23 JST 2003
+
+Zaurus �θŤ��Хå����åפΥ쥳���ɤ�255���¿���Ȥ�����ä��Τ�����
+
+Fri Dec 27 16:42:06 JST 2002
+
+����Ʊ�������äơ�
+   ~/Todo 
+��Xcalendar ������ ~/Calendar ��Ʊ�����ơ������insigna��
+�ۤ롣�����ơ������
+    iCal��main.ics
+�˥��ԡ�����äƤ�����������͡������ơ�
+   pxcal.pl
+�ǡ�ɽ�����ơ������ ~/bin/pxcal.daily -m �ǥ᡼��ˤ���
+����äƤ櫓�������λ��ˡ�
+   ~/etc/zaurus
+��Ǥ��뤫�顢���� Linux Zaurus �˥��ԡ������Zaurus��Ʊ���Ǥ��롣
+
+�थ��Address Book �ϼ�ư�Ǥ����Ǥ��ʤ���vcard ���ɤߤ��ʤ����顣
+
+�����calcon.pl �����ǽ���ʤ���?
+
+
+Sat Nov 23 13:36:22 JST 2002
+
+��äѤ� module �������Ȥ���ȡ�module make ���ʤ���
+������͡����ɤ���...
+
+Fri Nov 22 07:54:57 JST 2002
+
+Address Book ��Applescript �ˤ���ɤ߹��ߤϡ���������������
+
+Thu Nov 21 12:38:26 JST 2002
+
+Mac::Applescript �ǥǡ������ɤ߽Ф��ȡ����ʤ� \001 ��
+�Ϥޤ��Τ˲����롣�ʤ�Ǥ�����?
+
+Applescript ���٤���  
+   Calendar/Address ���ɤ߹��ߤ�ʬ����
+   Calendar �ϡ�̤��Τ�Τ�����������option��Ĥ���
+�äƤΤϡ��ɤ��Ǥ��礦?
+
+���ȡ����դΥǡ����ϡ���ư�Ѵ��ˤ�����? �Ѵ���[]���Ѵ���"2002/9/11"
+�ߤ����ʡ�
+
+Wed Nov 20 14:56:05 JST 2002
+
+Applescript �� Entourage X �Υǡ������ɤ߽Ф��Τϡ��٤�����
+
+Mon Nov 18 18:49:29 JST 2002
+
+����������500 record �äƤΤϤ狼��ޤ������ʤ�ʣ���ڡ�����
+ʬ��������äƤ���ߤ��������ޤä����Τ��ʡ�
+
+�ɤ��� index ���褬 0xfff0 ���ȡ�����Ͽ�����index�ǡ�
+    �Ť��Ǥ��� 3byte length
+    0103  ���� 4byte length
+�ȤʤäƤ���餷�����äƤ��Ȥϡ���������Τ���... �����ࡣ
+
+Mon Nov 18 13:13:04 JST 2002
+
+ʣ����Email address �ΰ�����ɬ�פ�
+
+����������ˤ��줿�����äˤ��줿�ꡢŬ���ʤ��Ȥ��Ƥ��Τ͡�
+
+Sun Nov 17 21:32:59 JST 2002
+
+Entourage ��applescript �ǽ񤭽Ф��äƤΤ��դ������ޤ���
+Applescript �Τ����ˤ��ĸ����롣
+
+�쥶���륹�ν񤭽Ф��Ϥ�äѤ�̵�����衣����ˤĤ���äƤ����
+���������äƤ��ޤ���
+
+������Perl�Ѥ�Applescript �⥸�塼����դ����Τǡ�����
+��ͳ�ǥǡ������ɤ߽Ф��롼�����񤳤���
+
+���ȡ���ʬ�⡼�ɤ���äѤ��ߤ�����͡������ν����򡢤⤦
+����ľ���ʤ��Ȥ�����ʡ�
+
+setOutput �ǡ�
+    input-1 -> differ-1 (add mode)
+    input-2 -> differ-2 (subtract mode)
+�Ȥ��ơ�differ-1,differ-2 �������ʤ����֥������Ȥ�
+��ͭ���ơ��������麹ʬ��׻�����äƷ��Ǥ����͡�
+ʣ�������Ϥ�and/or���뤳�Ȥ��ǽ�����ɡ������ޤǤ�
+����ʤ�����
+
+Mon Oct  7 22:57:40 JST 2002
+
+date �� unix time ���Ѥ���������ɡ���äѤ� enbug ���ޤ���...
+���⤽�⡢�ʤ�ǡ�����ʤ��Ȥ������?
+
+Sat Oct  5 21:25:13 JST 2002
+
+Zaurus �ν񤭽Ф���...
+
+�ޤ�������������ɡ�title record ��version�ˤ�ä�length��
+������Ȥ����Ǥʤ���礬����Τ͡�
+
+�񤭽Ф�����������Ǥ������ɡ��٤���Ĵ����ɬ�ס����ȡ�
+IDX �ϡ��ɡ�����?
+
+1030 ��⤦����Ĵ�٤������������⡣IDX���Ѥ�äƤ��뤫��
+�Τ�ʤ�����
+
+Tue Oct  1 23:00:54 JST 2002
+
+Zaurus BOX �Υǡ�����¤
+
+0      version (1020,1030)
+8      4byte       title index offset
+0x10   4byte       record index length
+0x20   4byte       BOX type ID  "SRDA"
+0x50 - 4byte * n   record index ( offset ) 4byte
+0x
+
+title index
+    0     2 byte length
+    2     1 byte index count
+    3     title record * n
+title record
+    0     2 byte length (1030�Ǥϡ��ʤ�)
+    2     title count
+    3     title length
+    4     4byte  ID (string)
+    8     length-6 byte title name (string)
+record index
+    0     index number
+    2     2 byte length (0xf0ff end)
+    6     field count
+  0xa     dummy
+
+  field length (if > 0x80, 2byte length) string
+
+
+Sat Sep 28 13:02:40 JST 2002
+
+Summary: ��������� iCal ��Vcal���ɤ߹���Ǥ���ʤ�
+
+������ Unix Time ���ݻ�����٤������ɡ�
+    date �ΤߤΥǡ��� (����ȴ��)
+�����ޤ�ɽ���Ǥ��ʤ��������ľ���ȡ����ʤ�enbug����������
+
+Sun Mar  2 18:57:33 JST 2003
+
+���Υǡ����ˤʤ��Ѥʡֳִ֡פ����äƤ���nkf -Z �Ǥ���ʤ���
+nkf �ä� utf16���ɤ�ʤ�����ä�? ���� file read �� double quote
+������Ȥ�����͡�
+
+calcon.pl �� file-out �ϡ��夫����ꤷ�Ƥ���٤졣initialize
+�����Ǥʤ��ȡ�options ��initialize �����˸ƤФʤ��Ȥ��ᡣ
diff -r 000000000000 -r 1fc0675b44cd MANIFEST
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MANIFEST	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,9 @@
+Calcon.pm
+Changes
+Makefile.PL
+MANIFEST
+README
+t/1.t
+calcon.pl
+pool.pl
+META.yml                                 Module meta-data (added by MakeMaker)
diff -r 000000000000 -r 1fc0675b44cd Makefile.PL
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile.PL	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,15 @@
+use 5.008;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Calcon',
+    'VERSION_FROM'	=> 'Calcon.pm', # finds $VERSION
+    'PREREQ_PM'		=> {
+	'NKF'=>2.0,
+	'Mac::AppleScript'=>0.03,
+    }, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (  # ABSTRACT_FROM => 'Calcon.pm', # retrieve abstract from module
+       AUTHOR     => 'Shinji KONO <kono@ie.u-ryukyu.ac.jp>') : ()),
+);
diff -r 000000000000 -r 1fc0675b44cd README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,135 @@
+Calcon version 0.01
+
+Calendar/Address Book converter
+
+    �����
+
+Zaurus �ʤ󤫤Υ��ɥ쥹Ģ�䥹�����塼��� Mac OS X�Υ��ɥ쥹�֥å���
+iCal�˰�ư����Τ˽񤭤ޤ�����Entourage��applescript ��ͳ�ǤǤ��ޤ���
+�񤭽Ф��ϡ�Mac::Applescript module ��ɬ�פǤ���CPAN�ˤ���ޤ���
+Applescript ������äƥ��ץꥱ��������Ω���夲��ɬ�פ��������
+����ߤ�����
+
+���ϥե����ޥå�
+    'Zaurus' 	=> 'Calcon::Zaurus_read',
+           �����륹�Υǡ��� CF�˥��ԡ����뤫�Ǽ��Ф��� *.BOX �ե�����
+           SCHEDULE1.BOX, ADDRESS1.BOX �ʤɤǤ���MI-C1,MI-110 �ϻ�ޤ�����
+    'Backup Zaurus' 	=> 'Calcon::Zaurus_backup_read',
+           �����륹�ΥХå����åץǡ��� *.BCK �Ǥ������ꥢ���ͳ�Ǽ�ä�
+           ��Τ��ɤ�ޤ���
+    'Xcalendar' => 'Calcon::Xcalendar_read',
+           Unix X Window �� xcalendar �ε�ե����ޥå�
+    'Vcard' 	=> 'Calcon::Vcard_read',
+           VCARD 
+    'SLA300' 	=> 'Calcon::Sla300_read',
+           ��ʥå��������륹
+    'iApp' 	=> 'Calcon::iApp_read',
+           Mac OS X ��iCal, Address Book, Applescript ��ͳ�Ǥ�
+  'Entourage'	=> 'Calcon::Entourage_read',
+           Mac OS X ��Entourage X, Applescript ��ͳ�Ǥ�
+           ���ɥ쥹�� export �����ե�������ɤ�ޤ����������������®��
+    'File' 	=> 'Calcon::File_read',
+           �ȼ��Υե�åȥե�����ե����ޥå� (EUC)
+
+���ϥե����ޥå�
+    'Xcalendar'	=> 'Calcon::Xcalendar_write',
+           Unix X Window �� xcalendar �ε�ե����ޥå�
+    'Vcard' 	=> 'Calcon::Vcard_write',
+           VCARD 
+    'SLA300'	=> 'Calcon::Sla300_write',
+           ��ʥå��������륹
+  'Address Book'=> 'Calcon::Vcard_Apple_write',
+  'AppleScript'	=> 'Calcon::iApp_write',
+    'iApp' 	=> 'Calcon::iApp_write',
+           Mac OS X ��iCal, Address Book, Applescript ��ͳ�Ǥ�
+  'Entourage'	=> 'Calcon::Entourage_write',
+           Mac OS X ��Entourage X, Applescript ��ͳ�Ǥ�
+    'N702'      => 'Calcon::Vcard_N702iD_write',
+	   Docomo �������ä�Vcard 
+    'File' 	=> 'Calcon::File_write',
+           �ȼ��Υե�åȥե�����ե����ޥå� (EUC)
+
+
+�Ȥ���
+    perl calcon.pl -f from-format -t to-format file
+�ե�����̾�ϺǸ�Ǥʤ��Ȥ��ᡣgetops.pm �����¤��ʡ�perl calcon.pl -h 
+���б�����ե����ޥåȤΰ������Ǥޤ���format �ϼ��̤Ǥ���ǽ��
+��ʸ���Ǥ���
+
+Ʊ�����եȤǤϤʤ��Τ������Ѵ�����ޤ���Ʊ���������Ȥ��ϡ���ư����ǡ���
+�����򤹤��Τ��̤˽񤫤ʤ��Ȥ�����͡���ʬ�Ǥ� Xcalendar �Ѥϻ��äƤ���
+�������...
+
+����
+    Xcalendar ���� iCal �˥��åץ륹����ץȷ�ͳ�ǥǡ������ư
+	perl calcon.pl -f x -t i ~/Calendar
+    Zaurus CF�����ɤ��顢vcard format ������
+	perl calcon.pl -f z -t v /Voluemes/NO_NAME/__zaurus/S*.BOX > all.vcs
+	perl calcon.pl -f z -t v /Voluemes/NO_NAME/__zaurus/A*.BOX > all.vcf
+    ��ʬ�Υƥ����ȷ����Υ��ɥ쥹Ģ����Mac OS X �� Address Book ��
+	perl calcon.pl  -t Add > all.vcf
+	open all.vcf
+
+tips
+
+    Address Book, iCal �˰ܤ����ˤ� vcard ��ͳ��������®�Ǥ���
+    (��)Address Book �˰ܤ��Ȥ��ˤϡ��ɤߤ��ʤδط��ǥ��åץ륹����ץȤ�Ȥ��٤���
+
+    iCal���Ѥʴ��������ɤ��Ҵ����ɤ���ΤǤϤʤ����ɤ������褦�Ǥ���
+    �Ȥꤢ�������ɤ���ߤ�����͡�
+
+    SLA300���������줿�ե������
+          /home/root/Applications/addressbook/addressbook.xml
+          /home/root/Applications/datebook/datebook.xml
+    �˥��ԡ����ޤ������λ��ˡ����������Ȥ����ɥ쥹�֥å���ư���Ƥ��Ƥ�
+    �����ޤ���
+
+    Zaurus ��BOX format ��version ��¸�����빽����Τ��ɤ�ʤ��Τ�
+    ¿�����⡣�񤭽Ф��ϡ���äѤ�Ǥ��ޤ���
+
+option
+
+    -d  �ǥХå��������Ϥ���
+    -F  ����������̤��ξ���Τߤ���Ϥ��� (Applescript ���٤��Τ�)
+    -c  ������������Τߤ���Ϥ���
+    -a  ���ɥ쥹����Τߤ���Ϥ���
+
+
+
+===================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2003 Shinji KONO
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself. 
+
diff -r 000000000000 -r 1fc0675b44cd calcon.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/calcon.pl	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,134 @@
+#!/usr/bin/perl 
+
+use Calcon;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK 
+    $opt_f $opt_t $opt_n $opt_d $opt_h $opt_F $opt_O $opt_a $opt_c $opt_T
+);
+
+my %input = (
+    'Zaurus' 	=> 'Calcon::Zaurus_read',
+    'Backup Zaurus' 	=> 'Calcon::Zaurus_backup_read',
+    'Xcalendar' => 'Calcon::Xcalendar_read',
+    'Vcard' 	=> 'Calcon::Vcard_read',
+    'SLA300' 	=> 'Calcon::Sla300_read',
+    'iApp' 	=> 'Calcon::iApp_read',
+  'Entourage'	=> 'Calcon::Entourage_read',
+    'File' 	=> 'Calcon::File_read',
+);
+
+my %output = (
+    'Xcalendar'	=> 'Calcon::Xcalendar_write',
+    'Vcard' 	=> 'Calcon::Vcard_write',
+    'SLA300'	=> 'Calcon::Sla300_write',
+  'AppleScript'	=> 'Calcon::iApp_write',
+    'iApp' 	=> 'Calcon::iApp_write',
+ 'Address Book' => 'Calcon::Vcard_Apple_write',
+  'Entourage'	=> 'Calcon::Entourage_write',
+    'Print'     => 'Calcon::Print_write',
+    'File' 	=> 'Calcon::File_write',
+    'N702' 	=> 'Calcon::Vcard_N702iD_write',
+);
+
+use Getopt::Std;
+
+getopts('f:t:ndhO:acFT'); 
+
+if ($opt_h) {
+    print "Usage: $0 [-d -n] -f input_type -t output_type inputfile\n";
+    print "  input  type: ",join(" ",keys %input),"\n";
+    print "  output type: ",join(" ",keys %output),"\n";
+    exit 0;
+}
+
+# print "option: $opt_f $opt_t\n";
+my $from_opts;
+my $to_opts;
+
+if (! @ARGV) { @ARGV = ('/dev/stdin'); }
+foreach my $file ( @ARGV ) {
+    my ($obj,$out);
+
+    $opt_f = 'file' if (!$opt_f);
+    $opt_t = 'file' if (!$opt_t);
+
+    if ($opt_f =~ s/:.*//) { $from_opts = $&; }
+    $opt_f =~ s/(\W)/\\$1/g;
+    foreach my $key ( keys %input) {
+	if ($key =~ /^$opt_f/i) {
+	    $obj  = $input{$key}; 
+	    last;
+	}
+    }
+    $obj = $obj->new($from_opts);
+
+    if ($opt_t =~ s/:.*//) { $to_opts = $&; }
+    $to_opts .= '-n' if ($opt_n);
+    $opt_t =~ s/(\W)/\\$1/g;
+    foreach my $key ( keys %output) {
+	if ($key =~ /^$opt_t/i) {
+	    $out  = $output{$key}; 
+	    last;
+	}
+    }
+    $out = $out->new($to_opts); 
+# print "$obj $out\n";
+    $obj->set_output($out);
+
+    # $out->{'-file-out'} = $opt_n; too late
+
+    foreach my $o ( $obj, $out) {
+	$o->set_debug(1) if ($opt_d);
+	$o->{'-address-only'} = 1 if ($opt_a);
+	$o->{'-calendar-only'} = 1 if ($opt_c);
+	$o->{'-future-only'} = 1 if ($opt_F);
+	$o->{'-tomorrow'} = 1 if ($opt_T);
+    }
+
+# print "option: $opt_f $opt_t\n";
+    $obj -> decode($file);
+}
+
+#
+
+__END__
+
+=head1 NAME
+
+calcon.pl -- Convert Various Calendar/Address data format
+
+=head1 SYNOPSIS
+
+    perl calcon.pl -f from -t form [-d] [-n]
+
+=head1 DESCRIPTION
+
+ -f from-format
+    File format
+    Zaurus Read Zaurus MI C1 Compact Flast
+    Xcalendar
+    vCal/vCard
+    iApp via Applescript
+    Entourage via Applescript
+    
+
+ -t from-format
+    File format
+    iCal and Addres Book Applescript execution (-f put result into files in script-out )
+    vCal/vCard
+    Zaurus SLA-300
+    Entourage via Applescript
+    Address Book  (Mac OS X 10.4 Address Book)
+
+ -a addres only
+ -c calendar only
+ -F future only
+ -T tomorrow only
+
+ -h   show help
+ -d debug
+ -n non-execution mode for applescript
+      scripts are put into script-out directory
+
+=cut
diff -r 000000000000 -r 1fc0675b44cd pool.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/pool.pl	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,175 @@
+#!/usr/bin/perl 
+
+use Calcon;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK 
+);
+
+my %input = (
+    'Zaurus' 	=> 'Calcon::Zaurus_read',
+    'Backup Zaurus' 	=> 'Calcon::Zaurus_backup_read',
+    'Xcalendar' => 'Calcon::Xcalendar_read',
+    'Vcard' 	=> 'Calcon::Vcard_read',
+    'SLA300' 	=> 'Calcon::Sla300_read',
+    'iApp' 	=> 'Calcon::iApp_read',
+  'Entourage'	=> 'Calcon::Entourage_read',
+    'File' 	=> 'Calcon::File_read',
+);
+
+my %output = (
+    'Xcalendar'	=> 'Calcon::Xcalendar_write',
+    'Vcard' 	=> 'Calcon::Vcard_write',
+    'SLA300'	=> 'Calcon::Sla300_write',
+  'AppleScript'	=> 'Calcon::iApp_write',
+    'iApp' 	=> 'Calcon::iApp_write',
+ 'Address Book' => 'Calcon::Vcard_Apple_write',
+  'Entourage'	=> 'Calcon::Entourage_write',
+    'Print' 	=> 'Calcon::Print_write',
+    'N702' 	=> 'Calcon::Vcard_N702iD_write',
+    'File' 	=> 'Calcon::File_write',
+);
+
+
+sub find_input {
+    my ($input) = @_;
+    my ($obj);
+
+    $input =~ s/(\W)/\\$1/g;
+    foreach my $key ( keys %input) {
+	if ($key =~ /^$input/i) {
+	    $obj  = $input{$key}; 
+	    last;
+	}
+    }
+    $obj;
+}
+
+sub find_output {
+    my ($output) = @_;
+    my ($obj);
+
+    $output =~ s/(\W)/\\$1/g;
+    foreach my $key ( keys %output) {
+	if ($key =~ /^$output/i) {
+	    $obj  = $output{$key}; 
+	    last;
+	}
+    }
+    $obj;
+}
+
+&usage if (! @ARGV); 
+
+my $mode = "input";
+my $type = "file";
+my $pool = Calcon::Pool->new();
+my $last_flag = 0;
+my $first_flag = 1;
+
+while(my $file = shift( @ARGV )) {
+    my ($obj,$out,$opt);
+
+    if ($file =~ /^-([^-]*)-([^-]*)((-[^-]*)*)/) {
+	$mode = $1;
+	$type = $2;
+	$opt = $3;
+	$file = shift(@ARGV);
+	$first_flag = 0;
+    } else {
+	&usage_die();
+
+#
+#       decode を呼び出しても処理は繰り返し行われないらしい
+#
+#	if ($first_flag) {
+#	    &usage_die();
+#	} else {
+#	    $file = shift(@ARGV);
+#	}
+    }
+
+    if (0 && $#ARGV==1 && $ARGV[0]=~/^-output/) {
+	# we need not pool interface for this case
+        # It does not help speed so we abandon it.
+	print "Simple Case\n";
+	my $output = $ARGV[1];
+
+	$obj = &find_input($type);
+	$obj = $obj->new($opt);
+
+        $ARGV[0] =~ /^-([^-]*)-([^-]*)((-[^-]*)*)/;
+	$mode = $1;
+	$type = $2;
+	$opt = $3;
+
+	my $out = &find_output($type);
+	$out = $out->new($opt,$output);
+	$obj->set_output($out);
+	$obj -> decode($file);
+
+	$last_flag = 1;
+	last;
+    }
+#    print "$mode $type $opt $file\n";
+    if ($mode eq 'input') {
+	$obj = &find_input($type);
+	$obj = $obj->new($opt);
+	$obj->set_output($pool);
+	$obj -> decode($file);
+    } elsif ($mode eq 'merge') {
+	$obj = &find_input($type);
+	$obj = $obj->new($opt);
+	$obj->set_output($pool);
+	$pool->merge_mode();
+	$obj -> decode($file);
+    } elsif ($mode eq 'delete') {
+	$obj = &find_input($type);
+	$obj = $obj->new($opt);
+	$obj->set_output($pool);
+	$pool->delete_mode();
+	$obj -> decode($file);
+    } elsif ($mode eq 'output') {
+	$obj = &find_output($type);
+	$obj = $obj->new($opt,$file);
+	$pool->set_output($obj);
+	$pool->output($obj);
+	$last_flag = 1;
+	last;
+    }
+}
+
+if (! $last_flag) {
+	my $opt = '';
+	my $obj = &find_output('File');
+	$obj = $obj->new($opt);
+	$pool->set_output($obj);
+	$pool->output($obj);
+	$last_flag = 1;
+}
+
+
+sub usage_die {
+    &usage();
+    die();
+}
+
+sub usage {
+    print "Usage: $0 -input-xcal ~/Calendar -output-print-FC /dev/stdout\n";
+    print "     -[mode]-[type][-options] file-name\n";
+    print "  mode:  input, merge, delete\n";
+    print "  input  type: ",join(" ",keys %input),"\n";
+    print "  output type: ",join(" ",keys %output),"\n";
+    print
+      "\t-n\tfile-out\n",
+      "\t-d\tdebug\n",
+      "\t-a\taddress only\n",
+      "\t-c\tcalendar only\n",
+      "\t-F\tfuture only\n",
+      "\t-t\ttommorrow\n",
+      "\t-C\tdisplay count\n",
+      "";
+}
+
+#
+
diff -r 000000000000 -r 1fc0675b44cd t/1.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/1.t	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,15 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 1.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('Calcon') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
diff -r 000000000000 -r 1fc0675b44cd t/CVS/Entries
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/CVS/Entries	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,2 @@
+/1.t/1.1.1.1/Fri Jan 24 04:35:34 2003//
+D
diff -r 000000000000 -r 1fc0675b44cd t/CVS/Repository
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/CVS/Repository	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,1 @@
+Calcon/t
diff -r 000000000000 -r 1fc0675b44cd t/CVS/Root
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/CVS/Root	Fri Sep 02 18:29:56 2011 +0900
@@ -0,0 +1,1 @@
+/Users/kono/src/CVS