Mercurial > hg > Applications > Calcon
comparison pool.pl @ 17:1fc0675b44cd
hg init
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 02 Sep 2011 18:29:56 +0900 |
parents | |
children | 12ddd9dd9fc6 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 17:1fc0675b44cd |
---|---|
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 { | |
80 &usage_die(); | |
81 | |
82 # | |
83 # decode を呼び出しても処理は繰り返し行われないらしい | |
84 # | |
85 # if ($first_flag) { | |
86 # &usage_die(); | |
87 # } else { | |
88 # $file = shift(@ARGV); | |
89 # } | |
90 } | |
91 | |
92 if (0 && $#ARGV==1 && $ARGV[0]=~/^-output/) { | |
93 # we need not pool interface for this case | |
94 # It does not help speed so we abandon it. | |
95 print "Simple Case\n"; | |
96 my $output = $ARGV[1]; | |
97 | |
98 $obj = &find_input($type); | |
99 $obj = $obj->new($opt); | |
100 | |
101 $ARGV[0] =~ /^-([^-]*)-([^-]*)((-[^-]*)*)/; | |
102 $mode = $1; | |
103 $type = $2; | |
104 $opt = $3; | |
105 | |
106 my $out = &find_output($type); | |
107 $out = $out->new($opt,$output); | |
108 $obj->set_output($out); | |
109 $obj -> decode($file); | |
110 | |
111 $last_flag = 1; | |
112 last; | |
113 } | |
114 # print "$mode $type $opt $file\n"; | |
115 if ($mode eq 'input') { | |
116 $obj = &find_input($type); | |
117 $obj = $obj->new($opt); | |
118 $obj->set_output($pool); | |
119 $obj -> decode($file); | |
120 } elsif ($mode eq 'merge') { | |
121 $obj = &find_input($type); | |
122 $obj = $obj->new($opt); | |
123 $obj->set_output($pool); | |
124 $pool->merge_mode(); | |
125 $obj -> decode($file); | |
126 } elsif ($mode eq 'delete') { | |
127 $obj = &find_input($type); | |
128 $obj = $obj->new($opt); | |
129 $obj->set_output($pool); | |
130 $pool->delete_mode(); | |
131 $obj -> decode($file); | |
132 } elsif ($mode eq 'output') { | |
133 $obj = &find_output($type); | |
134 $obj = $obj->new($opt,$file); | |
135 $pool->set_output($obj); | |
136 $pool->output($obj); | |
137 $last_flag = 1; | |
138 last; | |
139 } | |
140 } | |
141 | |
142 if (! $last_flag) { | |
143 my $opt = ''; | |
144 my $obj = &find_output('File'); | |
145 $obj = $obj->new($opt); | |
146 $pool->set_output($obj); | |
147 $pool->output($obj); | |
148 $last_flag = 1; | |
149 } | |
150 | |
151 | |
152 sub usage_die { | |
153 &usage(); | |
154 die(); | |
155 } | |
156 | |
157 sub usage { | |
158 print "Usage: $0 -input-xcal ~/Calendar -output-print-FC /dev/stdout\n"; | |
159 print " -[mode]-[type][-options] file-name\n"; | |
160 print " mode: input, merge, delete\n"; | |
161 print " input type: ",join(" ",keys %input),"\n"; | |
162 print " output type: ",join(" ",keys %output),"\n"; | |
163 print | |
164 "\t-n\tfile-out\n", | |
165 "\t-d\tdebug\n", | |
166 "\t-a\taddress only\n", | |
167 "\t-c\tcalendar only\n", | |
168 "\t-F\tfuture only\n", | |
169 "\t-t\ttommorrow\n", | |
170 "\t-C\tdisplay count\n", | |
171 ""; | |
172 } | |
173 | |
174 # | |
175 |