Mercurial > hg > Applications > Calcon
annotate pool.pl @ 25:98d017d452c6 default tip
add sqlite3 based iCal
| author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Sun, 19 Feb 2023 10:36:01 +0900 |
| parents | 12ddd9dd9fc6 |
| children |
| rev | line source |
|---|---|
| 17 | 1 #!/usr/bin/perl |
| 2 | |
| 3 use Calcon; | |
| 4 | |
| 5 use strict; | |
| 6 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK | |
| 7 ); | |
| 8 | |
| 9 my %input = ( | |
| 10 'Zaurus' => 'Calcon::Zaurus_read', | |
| 11 'Backup Zaurus' => 'Calcon::Zaurus_backup_read', | |
| 12 'Xcalendar' => 'Calcon::Xcalendar_read', | |
| 13 'Vcard' => 'Calcon::Vcard_read', | |
| 14 'SLA300' => 'Calcon::Sla300_read', | |
| 15 'iApp' => 'Calcon::iApp_read', | |
| 25 | 16 'iCal' => 'Calcon::iApps_read', |
| 17 | 17 'Entourage' => 'Calcon::Entourage_read', |
| 18 'File' => 'Calcon::File_read', | |
| 19 ); | |
| 20 | |
| 21 my %output = ( | |
| 22 'Xcalendar' => 'Calcon::Xcalendar_write', | |
| 23 'Vcard' => 'Calcon::Vcard_write', | |
| 24 'SLA300' => 'Calcon::Sla300_write', | |
| 25 'AppleScript' => 'Calcon::iApp_write', | |
| 26 'iApp' => 'Calcon::iApp_write', | |
| 27 'Address Book' => 'Calcon::Vcard_Apple_write', | |
| 28 'Entourage' => 'Calcon::Entourage_write', | |
| 29 'Print' => 'Calcon::Print_write', | |
| 30 'N702' => 'Calcon::Vcard_N702iD_write', | |
| 31 'File' => 'Calcon::File_write', | |
| 32 ); | |
| 33 | |
| 34 | |
| 35 sub find_input { | |
| 36 my ($input) = @_; | |
| 37 my ($obj); | |
| 38 | |
| 39 $input =~ s/(\W)/\\$1/g; | |
| 40 foreach my $key ( keys %input) { | |
| 41 if ($key =~ /^$input/i) { | |
| 42 $obj = $input{$key}; | |
| 43 last; | |
| 44 } | |
| 45 } | |
| 46 $obj; | |
| 47 } | |
| 48 | |
| 49 sub find_output { | |
| 50 my ($output) = @_; | |
| 51 my ($obj); | |
| 52 | |
| 53 $output =~ s/(\W)/\\$1/g; | |
| 54 foreach my $key ( keys %output) { | |
| 55 if ($key =~ /^$output/i) { | |
| 56 $obj = $output{$key}; | |
| 57 last; | |
| 58 } | |
| 59 } | |
| 60 $obj; | |
| 61 } | |
| 62 | |
| 63 &usage if (! @ARGV); | |
| 64 | |
| 65 my $mode = "input"; | |
| 66 my $type = "file"; | |
| 67 my $pool = Calcon::Pool->new(); | |
| 68 my $last_flag = 0; | |
| 69 my $first_flag = 1; | |
| 70 | |
| 71 while(my $file = shift( @ARGV )) { | |
| 72 my ($obj,$out,$opt); | |
| 73 | |
| 74 if ($file =~ /^-([^-]*)-([^-]*)((-[^-]*)*)/) { | |
| 75 $mode = $1; | |
| 76 $type = $2; | |
| 77 $opt = $3; | |
| 78 $file = shift(@ARGV); | |
| 79 $first_flag = 0; | |
| 80 } else { | |
|
18
12ddd9dd9fc6
use BEGIN:VCARD to make OS X happy
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
81 print STDERR "bad option $file\n"; |
| 17 | 82 &usage_die(); |
| 83 | |
| 84 # | |
| 85 # decode を呼び出しても処理は繰り返し行われないらしい | |
| 86 # | |
| 87 # if ($first_flag) { | |
| 88 # &usage_die(); | |
| 89 # } else { | |
| 90 # $file = shift(@ARGV); | |
| 91 # } | |
| 92 } | |
| 93 | |
| 94 if (0 && $#ARGV==1 && $ARGV[0]=~/^-output/) { | |
| 95 # we need not pool interface for this case | |
| 96 # It does not help speed so we abandon it. | |
| 97 print "Simple Case\n"; | |
| 98 my $output = $ARGV[1]; | |
| 99 | |
| 100 $obj = &find_input($type); | |
| 101 $obj = $obj->new($opt); | |
| 102 | |
| 103 $ARGV[0] =~ /^-([^-]*)-([^-]*)((-[^-]*)*)/; | |
| 104 $mode = $1; | |
| 105 $type = $2; | |
| 106 $opt = $3; | |
| 107 | |
| 108 my $out = &find_output($type); | |
| 109 $out = $out->new($opt,$output); | |
| 110 $obj->set_output($out); | |
| 111 $obj -> decode($file); | |
| 112 | |
| 113 $last_flag = 1; | |
| 114 last; | |
| 115 } | |
| 116 # print "$mode $type $opt $file\n"; | |
| 117 if ($mode eq 'input') { | |
| 118 $obj = &find_input($type); | |
| 119 $obj = $obj->new($opt); | |
| 120 $obj->set_output($pool); | |
| 121 $obj -> decode($file); | |
| 122 } elsif ($mode eq 'merge') { | |
| 123 $obj = &find_input($type); | |
| 124 $obj = $obj->new($opt); | |
| 125 $obj->set_output($pool); | |
| 126 $pool->merge_mode(); | |
| 127 $obj -> decode($file); | |
| 128 } elsif ($mode eq 'delete') { | |
| 129 $obj = &find_input($type); | |
| 130 $obj = $obj->new($opt); | |
| 131 $obj->set_output($pool); | |
| 132 $pool->delete_mode(); | |
| 133 $obj -> decode($file); | |
| 134 } elsif ($mode eq 'output') { | |
| 135 $obj = &find_output($type); | |
| 136 $obj = $obj->new($opt,$file); | |
| 137 $pool->set_output($obj); | |
| 138 $pool->output($obj); | |
| 139 $last_flag = 1; | |
| 140 last; | |
| 141 } | |
| 142 } | |
| 143 | |
| 144 if (! $last_flag) { | |
| 145 my $opt = ''; | |
| 146 my $obj = &find_output('File'); | |
| 147 $obj = $obj->new($opt); | |
| 148 $pool->set_output($obj); | |
| 149 $pool->output($obj); | |
| 150 $last_flag = 1; | |
| 151 } | |
| 152 | |
| 153 | |
| 154 sub usage_die { | |
| 155 &usage(); | |
| 156 die(); | |
| 157 } | |
| 158 | |
| 159 sub usage { | |
| 160 print "Usage: $0 -input-xcal ~/Calendar -output-print-FC /dev/stdout\n"; | |
| 161 print " -[mode]-[type][-options] file-name\n"; | |
| 162 print " mode: input, merge, delete\n"; | |
| 163 print " input type: ",join(" ",keys %input),"\n"; | |
| 164 print " output type: ",join(" ",keys %output),"\n"; | |
| 165 print | |
| 166 "\t-n\tfile-out\n", | |
| 167 "\t-d\tdebug\n", | |
| 168 "\t-a\taddress only\n", | |
| 169 "\t-c\tcalendar only\n", | |
| 170 "\t-F\tfuture only\n", | |
| 171 "\t-t\ttommorrow\n", | |
| 172 "\t-C\tdisplay count\n", | |
| 173 ""; | |
| 174 } | |
| 175 | |
| 176 # | |
| 177 |