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