Applications/Calcon: Calcon.pm comparison

comparison Calcon.pm @ 1:144819f5d2f6

Initial revision

author	kono
date	Fri, 24 Jan 2003 13:41:18 +0900
parents
children	cb79baed256e

comparison

equal deleted inserted replaced

-:111809a2ea45
+:144819f5d2f6
+package Calcon;
+## $Id$
+use 5.008;
+use strict;
+use warnings;
+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.01';
+# 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->initialize();
+$self->option($opts);
+return $self;
+}
+# 下位クラスから呼び出される初期化。ここでは何もしない。しかし、
+# 呼び出されるのだから用意しておく必要がある。
+sub initialize {
+my ($self) = @_;
+}
+# option 関係。
+sub set_debug {
+my ($self,$flag) = @_;
+$self->{'-debug'} = $flag;
+}
+sub option {
+my ($self,$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);
+$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";
+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 = $items->{'memo'};
+	$memo =~ s/\n+$//;
+	if ($self->{'-tomorrow'}) {
+	    print nkf('-e',"$date:\t$memo\n");
+	} else {
+	    $memo =~ s/^/$date:\t/mg;
+	    print nkf('-e',"$memo\n");
+	}
+} else {
+	foreach my $key (@keys) {
+	    my $value = $items{$key};
+	    if (ref $value) {
+		$value = $value->value();
+	    }
+	    print nkf('-e',"$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 $r;
+	return unless ($r = $self->new_info($list,$record));
+	push(@$list,$r);
+} 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 ( $self->{'-date-max'} > 0);
+$self->write_addressbook() if ( $self->{'-adr-max'} > 0);
+}
+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);
+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 = nkf('-eS',$address);
+# my ($street , $zip , $state , $country , $city);
+$address =~ /street:"([^"]*)"/ && ($street = $1);
+$zip =~ /zip:"([^"]*)"/ && ($zip = $1);
+$state =~ /state:"([^"]*)"/ && ($state = $1);
+$city =~ /city:"([^"]*)"/ && ($city = $1);
+$country =~ /country:"([^"]*)"/ && ($country = $1);
+my ($label) = ($address =~ /label:"(.*?)"/);
+if (! defined($self->{'-labels'}->{$phone.$label})) {
+print "## $phone$label not defined\n";
+}
+$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";
+}
+$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,'email',$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 ($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;
+	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'=>'email',
+'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 ($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,"|nkf --utf8 >datebook.xml") or croak($!);
+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'})
+	}
+	$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'}) ;}
+	foreach my $key ( keys %$adr ) {
+	    $adr->{$adr} = nkf('-w -Z3',$adr->{$adr});
+	}
+	my ($address) 		= $adr->{'address'};
+	my ($birth) 		= $adr->{'birth'};
+	my ($company) 		= $adr->{'office'};
+	my ($email) 		= $adr->{'email'};
+	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=\"$email\" " ) if ($email);
+	$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("--utf8",@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'} = 1;
+$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,$dtstamp);
+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'});
+}
+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'};
+	$summary =~ s/[\r\n].*$//; $description = $&;
+	$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,$sec) = $self->localtime($date);
+$date = sprintf("%04d%02d%02dT%02d%02d%02d",
+	$year,$month,$day,$hour,$min,$sec);
+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{'birth'}) {
+	$data =  $record{'birth'};
+	print "bday:$data\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::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';
+	}
+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 = $self->{'-directory'}."/".
+	$date->xcalendar_file_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 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>) {
+if (/^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 (/^description:\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,'email',$1,$2);
+} elsif (/^end:\s*vcard/i) { $self->vcard($record);
+} elsif (/^end:\s*vevent/i) { $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 (/^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-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;
+} else { $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
+=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$
+#######################################################################/
+=cut

Mercurial > hg > Applications > Calcon

comparison Calcon.pm @ 1:144819f5d2f6