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