« back to all changes in this revision
Viewing changes to src/sync-plan.PL
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Bazaar Package Importer
- Author(s): Ludovic Rousseau
- Date: 2006-09-22 11:51:36 UTC
- mfrom: (3.1.8 edgy)
- Revision ID: james.westby@ubuntu.com-20060922115136-qqmy17bx8j5x0y72
Tags: 0.12.1-5
* urgency medium since libpisock-dev was not usable to build any package
* libpisock-dev now depends on libusb-dev
* libpisock-dev now depends on libusb-dev
- files added:
- autogen.sh
- bindings/Python/test
- darwin
- doc/xml
- m4
- popt
- files removed:
- acinclude.m4
- debian/po
- libpisock++
- src/pilot-datebook
- files modified:
- ChangeLog
added
removed
src/sync-plan.PL
6
6
use IO::Socket;
7
7
use IO::Select;
8
8
use Time::Local;
9
use MD5;
9
use Digest::MD5;
10
10
use PDA::Pilot;
11
11
use Carp;
12
use strict;
13
14
my ($controldir, $dlp, $info, $db, $port);
15
my (%control, %pilothash, %pilotID, %planID, %exceptID, %planRecord,
16
%dbname, %sawName);
17
my ($slowsync, $file, $pilotname, $maxseed, $netplanversion);
18
19
my $PREFS = {
20
NetplanPort => 5444,
21
Debug => 1,
22
};
23
24
my @plversion; # pilot-link version (version, major, minor, patch)
25
26
# any or alll of these may be undefined, depending on the
27
# pilot-link version.
28
eval {
29
$plversion[0] = PDA::Pilot::PILOT_LINK_VERSION();
30
$plversion[1] = PDA::Pilot::PILOT_LINK_MAJOR();
31
$plversion[2] = PDA::Pilot::PILOT_LINK_MINOR();
32
$plversion[3] = PDA::Pilot::PILOT_LINK_PATCH();
33
};
34
35
# msg and status are here to localize the differences between the
36
# standalone sync-plan.PL and the SyncPlan.pm module for PilotManager.
37
38
############################################################
39
#
40
############################################################
41
sub msg {
42
print @_;
43
}
44
45
sub status {
46
}
47
48
############################################################
49
# CheckErrNotFound: Argument is a PDA::Pilot::DLP or a
50
# PDA::Pilot::DLP::DB. It's in its own package so that croak will
51
# give more useful information. I'm not using the equivalent function
52
# from the PilotMgr package because there is a stand-alone version of
53
# this conduit in the pilot-link distribution.
54
############################################################
55
BEGIN {
56
package ErrorCheck;
57
use Carp;
58
sub checkErrNotFound
59
{
60
my($obj) = @_;
61
my $errno = $obj->errno();
62
if (defined $plversion[0]) { # pilot-link version is >= 0.12.0-pre2
63
if ($errno != PDA::Pilot::PI_ERR_DLP_PALMOS()) {
64
croak "Error $errno";
65
}
66
if (($errno = $obj->palmos_errno()) != PDA::Pilot::dlpErrNotFound()) {
67
croak "Error $errno: " . PDA::Pilot::errorText($errno);
68
}
69
} else {
70
croak "Error $errno" if ($errno != -5); # dlpErrNotFound
71
}
72
}
73
}
74
*checkErrNotFound = \&ErrorCheck::checkErrNotFound;
75
76
77
############################################################
78
#
79
############################################################
12
80
sub DatePlanToPerl {
13
my($PlanDate) = @_;
14
my($m,$d,$y) = split(m!/!,$PlanDate);
15
if ($y<40) {
16
$y+=100;
81
my ($PlanDate) = @_;
82
my ($m,$d,$y) = split(m!/!,$PlanDate);
83
if ($y < 40) {
84
$y += 100;
17
85
}
18
if ($y>1900) {
19
$y-=1900;
86
if ($y > 1900) {
87
$y -= 1900;
20
88
}
21
89
$m--;
22
90
23
timelocal(0,0,0,$d,$m,$y);
91
timegm(0,0,0,$d,$m,$y);
24
92
}
25
93
94
############################################################
95
#
96
############################################################
26
97
sub TimePlanToPerl {
27
my($PlanTime) = @_;
28
my($h,$m,$s) = split(m!:!,$PlanTime);
98
my ($PlanTime) = @_;
99
my ($h,$m,$s) = split(m!:!,$PlanTime);
29
100
30
101
return undef if $h == 99 and $m == 99 and $s == 99;
31
102
32
$s + ($m*60) + ($h*60*60);
103
$s + ($m * 60) + ($h * 60 * 60);
33
104
}
34
105
106
############################################################
107
#
108
############################################################
35
109
sub TimePerlToPlan {
36
my($PerlDT) = @_;
110
my ($PerlDT) = @_;
37
111
return "99:99:99" if not defined $PerlDT;
38
112
39
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
40
localtime($PerlDT);
113
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
114
gmtime($PerlDT);
41
115
42
116
"$hour:$min:$sec";
43
117
}
44
118
119
############################################################
120
#
121
############################################################
45
122
sub TimeRelPerlToPlan {
46
my($PerlDT) = @_;
123
my ($PerlDT) = @_;
47
124
return "99:99:99" if not defined $PerlDT;
48
125
49
my($sec,$min,$hour);
126
my ($sec,$min,$hour);
50
127
51
128
$hour = int($PerlDT/ (60*60));
52
129
$PerlDT -= $hour*60*60;
60
137
"$hour:$min:$sec";
61
138
}
62
139
140
############################################################
141
#
142
############################################################
143
sub DatePilotToPerl {
144
my ($s,$m,$h, $mday,$mon,$year) = @_;
145
146
if (ref $s eq 'ARRAY') {
147
($s,$m,$h, $mday,$mon,$year) = @$s;
148
}
149
my ($date, $time);
150
151
if ($year >= 70 and $year <= 138) {
152
$date = eval { timegm($s,$m,$h,$mday,$mon,$year) };
153
msg("Trouble converting date: $mon/$mday/$year $h:$m$s")
154
if $@;
155
$time = $s + 60 * ($m + 60 * $h);
156
}
157
else {
158
msg("Bad year: $year");
159
}
160
161
return wantarray ? ($date, $time) : $date;
162
}
163
164
############################################################
165
#
166
############################################################
63
167
sub DatePerlToPlan {
64
my($PerlDT) = @_;
65
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
66
localtime($PerlDT);
168
my ($PerlDT) = @_;
169
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
170
gmtime($PerlDT);
67
171
68
172
$year += 1900;
69
173
$mon++;
71
175
"$mon/$mday/$year";
72
176
}
73
177
178
############################################################
179
#
180
############################################################
74
181
sub RecordPlanToPilot {
75
my($plan,$pilot) = @_;
182
my ($plan,$pilot) = @_;
76
183
if (not defined $pilot) {
77
184
$pilot = PDA::Pilot::AppointmentDatabase->record;
78
185
}
79
186
80
$pilot->{id} = $plan->{pilotid};
81
$pilot->{description} = join("\xA", @{$plan->{note}}) if defined $plan->{note};
82
$pilot->{note} = join("\xA", @{$plan->{message}}) if defined $plan->{message};
83
$pilot->{description} ||= "";
187
$pilot->{'id'} = $plan->{'pilotid'};
188
$pilot->{'description'} = join("\xA", @{$plan->{'note'}}) if defined $plan->{'note'};
189
$pilot->{'note'} = join("\xA", @{$plan->{'message'}}) if defined $plan->{'message'};
190
$pilot->{'description'} ||= "";
84
191
85
if (defined $plan->{time}) {
86
$pilot->{begin} = [localtime($plan->{date}+$plan->{time})];
87
$pilot->{end} = [localtime($plan->{date}+$plan->{time}+$plan->{length})];
88
$pilot->{event}=0;
192
if (defined $plan->{'time'}) {
193
$pilot->{'begin'} = [gmtime($plan->{'date'}+$plan->{'time'})];
194
$pilot->{'end'} = [gmtime($plan->{'date'}+$plan->{'time'}+$plan->{'length'})];
195
$pilot->{'event'}=0;
89
196
} else {
90
$pilot->{begin} = [localtime($plan->{date})];
91
$pilot->{event} = 1;
92
$plan->{early} = 0;
93
$plan->{late} = 0;
197
$pilot->{'begin'} = [gmtime($plan->{'date'})];
198
$pilot->{'event'} = 1;
199
$plan->{'early'} = 0;
200
$plan->{'late'} = 0;
94
201
}
95
202
96
if ($plan->{early} and $plan->{late} and ($plan->{early} != $plan->{late})) {
97
return undef;
203
if ($plan->{'early'} and $plan->{'late'} and ($plan->{'early'} != $plan->{'late'})) {
204
msg( "Two alarms - using earlier one." );
205
$plan->{'late'} = $plan->{'early'};
98
206
}
99
if ($plan->{early} or $plan->{late}) {
100
my($alarm) = $plan->{early} || $plan->{late};
207
if ($plan->{'early'} or $plan->{'late'}) {
208
my ($alarm) = $plan->{'early'} || $plan->{'late'};
101
209
if ($alarm > (60*60*24)) {
102
$pilot->{alarm}->{units} = "days";
103
$pilot->{alarm}->{advance} = int($alarm / (60*60*24));
210
$pilot->{'alarm'}->{'units'} = "days";
211
$pilot->{'alarm'}->{'advance'} = int($alarm / (60*60*24));
104
212
} elsif ($alarm > (60*60)) {
105
$pilot->{alarm}->{units} = "hours";
106
$pilot->{alarm}->{advance} = int($alarm / (60*60));
213
$pilot->{'alarm'}->{'units'} = "hours";
214
$pilot->{'alarm'}->{'advance'} = int($alarm / (60*60));
107
215
} else {
108
$pilot->{alarm}->{units} = "minutes";
109
$pilot->{alarm}->{advance} = int($alarm / 60);
216
$pilot->{'alarm'}->{'units'} = "minutes";
217
$pilot->{'alarm'}->{'advance'} = int($alarm / 60);
110
218
}
111
219
}
112
220
113
if (defined $plan->{exceptions}) {
114
foreach (@{$plan->{exceptions}}) {
115
push @{$pilot->{exceptions}}, [localtime($_)];
221
if (defined $plan->{'exceptions'}) {
222
foreach (@{$plan->{'exceptions'}}) {
223
push @{$pilot->{'exceptions'}}, [gmtime($_)];
116
224
}
117
225
} else {
118
delete $pilot->{exceptions};
226
delete $pilot->{'exceptions'};
119
227
}
120
228
121
if (defined $plan->{repeat}) {
122
print "Converting repetition...\n";
123
delete $pilot->{repeat};
124
if ($plan->{repeat}->[1]) {
125
$pilot->{repeat}->{end} = [gmtime($plan->{repeat}->[1])];
229
if (defined $plan->{'repeat'}) {
230
msg( "Converting repetition...\n" ) if ($PREFS->{'Debug'} > 2);
231
delete $pilot->{'repeat'};
232
if ($plan->{'repeat'}->[1]) {
233
$pilot->{'repeat'}->{'end'} = [gmtime($plan->{'repeat'}->[1])];
126
234
}
127
my($days,$end,$weekday,$mday,$yearly) = @{$plan->{repeat}};
128
print "Days: $days, End: $end, Weekday: $weekday, Mday: $mday, Yearly: $yearly\n";
129
$pilot->{repeat}->{weekstart} = 0;
130
$pilot->{repeat}->{frequency} = 1;
235
my ($days,$end,$weekday,$mday,$yearly) = @{$plan->{'repeat'}};
236
msg( "Days: $days, End: $end, Weekday: $weekday, Mday: $mday, Yearly: $yearly\n" ) if ($PREFS->{'Debug'} > 2);
237
$pilot->{'repeat'}->{'weekstart'} = 0;
238
$pilot->{'repeat'}->{'frequency'} = 1;
131
239
if ($days and !$weekday and !$mday and !$yearly) {
132
$pilot->{repeat}->{type} = "Daily";
133
$pilot->{repeat}->{frequency} = $days / (60*60*24);
240
$pilot->{'repeat'}->{'type'} = "Daily";
241
$pilot->{'repeat'}->{'frequency'} = $days / (60*60*24);
134
242
} elsif(!$days and !$weekday and !$mday and $yearly) {
135
$pilot->{repeat}->{type} = "Yearly";
136
} elsif(!$days and !$weekday and ($mday == (1 << $pilot->{begin}[3])) and !$yearly) {
137
$pilot->{repeat}->{type} = "MonthlyByDate";
243
$pilot->{'repeat'}->{'type'} = "Yearly";
244
} elsif(!$days and !$weekday and ($mday == (1 << $pilot->{'begin'}[3])) and !$yearly) {
245
$pilot->{'repeat'}->{'type'} = "MonthlyByDate";
138
246
139
247
} elsif(!$days and $weekday and (($weekday & 0xff80) == 0) and !$mday and !$yearly) {
140
$pilot->{repeat}->{type} = "Weekly";
141
foreach $i (0..6) {
142
$pilot->{repeat}->{days}[$i] = !! ($weekday & (1<<$i));
248
$pilot->{'repeat'}->{'type'} = "Weekly";
249
foreach my $i (0..6) {
250
$pilot->{'repeat'}->{'days'}[$i] = !! ($weekday & (1<<$i));
143
251
}
144
252
# If the weekday list does include the day the event is one, abort
145
if (!$pilot->{repeat}{days}[$pilot->{begin}[6]]) {
253
if (!$pilot->{'repeat'}{'days'}[$pilot->{'begin'}[6]]) {
146
254
return undef;
147
255
}
148
256
} elsif(not $days and $weekday and not $mday and not $yearly) {
149
my($wday) = $pilot->{begin}[6];
150
my($week) = int(($pilot->{begin}[3]-1)/7);
151
print "weekday = $weekday, wday = $wday, week = $week\n";
257
my ($wday) = $pilot->{'begin'}[6];
258
my ($week) = int(($pilot->{'begin'}[3]-1)/7);
259
msg( "weekday = $weekday, wday = $wday, week = $week\n" ) if ($PREFS->{'Debug'} > 2);
152
260
if (($weekday & 0x7f) != (1<<$wday)) {
153
261
return undef;
154
262
}
165
273
$week = 4;
166
274
}
167
275
168
$pilot->{repeat}->{type} = "MonthlyByDay";
169
$pilot->{repeat}->{day} = $week*7+$wday;
276
$pilot->{'repeat'}->{'type'} = "MonthlyByDay";
277
$pilot->{'repeat'}->{'day'} = $week*7+$wday;
170
278
} else {
171
279
return undef;
172
280
}
173
281
} else {
174
delete $pilot->{repeat};
282
delete $pilot->{'repeat'};
175
283
}
176
284
177
285
$pilot;
178
286
}
179
287
288
############################################################
289
#
290
############################################################
180
291
sub RecordPilotToPlan {
181
my($pilot,$plan) = @_;
292
my ($pilot,$plan) = @_;
182
293
$plan = {color => 0} if not defined $plan;
183
294
184
$plan->{pilotid} = $pilot->{id};
185
$plan->{id} ||= 0;
186
$plan->{message} = [split("\xA", $pilot->{note})] if defined $pilot->{note};
187
$plan->{note} = [split("\xA", $pilot->{description})] if defined $pilot->{description};
188
189
my($date) = timelocal(@{$pilot->{begin}});
190
my($time) = $pilot->{begin}[0]+$pilot->{begin}[1]*60+$pilot->{begin}[2]*60*60;
191
$plan->{date} = $date;
192
if ($pilot->{event}) {
193
$plan->{time} = undef;
194
$plan->{length} = 0;
295
$plan->{'pilotid'} = $pilot->{'id'};
296
$plan->{'id'} ||= 0;
297
$plan->{'message'} = [split("\xA", $pilot->{'note'})] if defined $pilot->{'note'};
298
$plan->{'note'} = [split("\xA", $pilot->{'description'})] if defined $pilot->{'description'};
299
300
my ($date, $time) = DatePilotToPerl($pilot->{'begin'});
301
unless ($date) {
302
msg("Begin time in Palm record untranslatable.");
303
return undef;
304
}
305
306
$plan->{'date'} = $date;
307
if ($pilot->{'event'}) {
308
$plan->{'time'} = undef;
309
$plan->{'length'} = 0;
195
310
} else {
196
$plan->{time} = $time;
197
$plan->{length} = timelocal(@{$pilot->{end}}) - $date;
311
$plan->{'time'} = $time;
312
my $end = DatePilotToPerl($pilot->{'end'});
313
unless ($end) {
314
msg("End time in Palm record untranslatable.");
315
return undef;
316
}
317
$plan->{'length'} = $end - $date;
198
318
}
199
319
200
if (exists $pilot->{alarm}) {
201
my($alarm)=0;
202
$plan->{noalarm} = 0;
203
if ($pilot->{alarm}{units} eq "days") {
204
$alarm = $pilot->{alarm}->{advance} * (60*60*24);
205
} elsif ($pilot->{alarm}{units} eq "hours") {
206
$alarm = $pilot->{alarm}->{advance} * (60*60);
207
} elsif ($pilot->{alarm}{units} eq "minutes") {
208
$alarm = $pilot->{alarm}->{advance} * (60);
320
if (exists $pilot->{'alarm'}) {
321
my($alarm) = 0;
322
if ($pilot->{'alarm'}{'units'} eq "days") {
323
$alarm = $pilot->{'alarm'}->{'advance'} * (60*60*24);
324
} elsif ($pilot->{'alarm'}{'units'} eq "hours") {
325
$alarm = $pilot->{'alarm'}->{'advance'} * (60*60);
326
} elsif ($pilot->{'alarm'}{'units'} eq "minutes") {
327
$alarm = $pilot->{'alarm'}->{'advance'} * (60);
209
328
}
210
if ($plan->{late}) {
211
$plan->{late} = $alarm;
212
$plan->{early} = 0;
329
if ($plan->{'late'}) {
330
$plan->{'late'} = $alarm;
331
$plan->{'early'} = 0;
213
332
} else {
214
$plan->{late} = 0;
215
$plan->{early} = $alarm;
333
$plan->{'late'} = 0;
334
$plan->{'early'} = $alarm;
216
335
}
217
336
} else {
218
$plan->{noalarm} = 1;
219
$plan->{late}=0;
220
$plan->{early}=0;
337
$plan->{'late'}=0;
338
$plan->{'early'}=0;
221
339
}
222
340
223
if (exists $pilot->{exceptions}) {
341
if (exists $pilot->{'exceptions'}) {
224
342
# Plan records can only deal with four exceptions,
225
if (@{$pilot->{exceptions}} > 4) {
343
if (@{$pilot->{'exceptions'}} > 4) {
344
msg("Too many exceptions.");
226
345
return undef;
227
346
}
228
foreach (@{$pilot->{exceptions}}) {
229
push @{$plan->{exceptions}}, timelocal(@{$_});
347
foreach (@{$pilot->{'exceptions'}}) {
348
push @{$plan->{'exceptions'}}, timegm(@{$_});
230
349
}
231
350
}
232
351
233
delete $plan->{repeat};
352
delete $plan->{'repeat'};
234
353
235
if (exists $pilot->{repeat}) {
236
$plan->{repeat} = [0,0,0,0,0];
237
if ($pilot->{repeat}->{type} eq "Daily") {
238
$plan->{repeat}->[0] = (60*60*24) * $pilot->{repeat}->{frequency};
239
$plan->{repeat}->[4] = 0;
240
} elsif ($pilot->{repeat}->{type} eq "Yearly" and ($pilot->{repeat}->{frequency}==1)) {
241
$plan->{repeat}->[4] = 1;
354
if (exists $pilot->{'repeat'}) {
355
$plan->{'repeat'} = [0,0,0,0,0];
356
if ($pilot->{'repeat'}->{'type'} eq "Daily") {
357
$plan->{'repeat'}->[0] = (60*60*24) * $pilot->{'repeat'}->{'frequency'};
358
$plan->{'repeat'}->[4] = 0;
359
} elsif ($pilot->{'repeat'}->{'type'} eq "Yearly" and ($pilot->{'repeat'}->{'frequency'}==1)) {
360
$plan->{'repeat'}->[4] = 1;
242
361
243
} elsif ($pilot->{repeat}->{type} eq "Weekly" and ($pilot->{repeat}->{frequency}==1)) {
244
my($r)=0;
245
foreach $i (0..6) {
246
if ($pilot->{repeat}->{days}[$i]) {
362
} elsif ($pilot->{'repeat'}->{'type'} eq "Weekly" and ($pilot->{'repeat'}->{'frequency'}==1)) {
363
my ($r) = 0;
364
foreach my $i (0..6) {
365
if ($pilot->{'repeat'}->{'days'}[$i]) {
247
366
$r |= (1<<$i);
248
367
}
249
368
}
250
$plan->{repeat}->[2] = $r;
251
} elsif ($pilot->{repeat}->{type} eq "Weekly" and ($pilot->{repeat}->{frequency}>1)) {
252
$plan->{repeat}->[0] = (60*60*24) * $pilot->{repeat}->{frequency} * 7;
253
$plan->{repeat}->[4] = 0;
254
} elsif ($pilot->{repeat}->{type} eq "MonthlyByDate" and ($pilot->{repeat}->{frequency}==1)) {
255
$plan->{repeat}->[3] = 1 << $pilot->{begin}[3];
256
} elsif ($pilot->{repeat}->{type} eq "MonthlyByDay" and ($pilot->{repeat}->{frequency}==1)) {
257
my($day) = $pilot->{repeat}{day} % 7;
258
my($week) = int($pilot->{repeat}{day} / 7);
259
$week=5 if $week == 4;
260
$plan->{repeat}->[2] = (1 << $day) | (256 << $week);
369
$plan->{'repeat'}->[2] = $r;
370
} elsif ($pilot->{'repeat'}->{'type'} eq "Weekly" and ($pilot->{'repeat'}->{'frequency'}>1)) {
371
# Weekly repeat, not every week. If it repeats only once per week, convert it to a daily
372
# repeat with frequency a multiple of 7. If it repeats more than once a week, bail.
373
my $count = 0;
374
foreach my $i (0..6) {
375
$count ++ if ($pilot->{repeat}->{days}[$i]);
376
}
377
if ($count == 1) {
378
$plan->{'repeat'}->[0] = (60*60*24) * $pilot->{'repeat'}->{'frequency'} * 7;
379
$plan->{'repeat'}->[4] = 0;
380
} else {
381
msg("Repeat pattern too complex.");
382
return undef;
383
}
384
} elsif ($pilot->{'repeat'}->{'type'} eq "MonthlyByDate" and ($pilot->{'repeat'}->{'frequency'}==1)) {
385
$plan->{'repeat'}->[3] = 1 << $pilot->{'begin'}[3];
386
} elsif ($pilot->{'repeat'}->{'type'} eq "MonthlyByDay" and ($pilot->{'repeat'}->{'frequency'}==1)) {
387
my ($day) = $pilot->{'repeat'}{'day'} % 7;
388
my ($week) = int($pilot->{'repeat'}{'day'} / 7);
389
$week = 5 if $week == 4;
390
$plan->{'repeat'}->[2] = (1 << $day) | (256 << $week);
261
391
} else {
392
msg("Repeat pattern too complex.");
262
393
return undef;
263
394
}
264
if (defined $pilot->{repeat}->{end}) {
265
$plan->{repeat}->[1] = timelocal(@{$pilot->{repeat}->{end}});
395
if (defined $pilot->{'repeat'}->{'end'}) {
396
$plan->{'repeat'}->[1] = timegm(@{$pilot->{'repeat'}->{'end'}});
266
397
}
267
398
}
268
399
269
400
$plan;
270
401
}
271
402
403
############################################################
404
#
405
############################################################
272
406
sub generaterecord {
273
my($rec) = @_;
274
my(@output);
407
my ($rec) = @_;
408
my (@output);
275
409
276
410
#print "Generating Plan record: ", Dumper($rec),"\n";
277
411
278
push(@output, DatePerlToPlan($rec->{date})." ".
279
TimeRelPerlToPlan($rec->{time})." ".
280
TimeRelPerlToPlan($rec->{length})." ".
281
TimeRelPerlToPlan($rec->{early})." ".
282
TimeRelPerlToPlan($rec->{late})." ".
283
($rec->{suspended} ? "S" : "-").
284
($rec->{private} ? "P" : "-").
285
($rec->{noalarm} ? "N" : "-").
286
($rec->{hide_month} ? "M" : "-").
287
($rec->{hide_year} ? "Y" : "-").
288
($rec->{hide_week} ? "W" : "-").
289
($rec->{hide_yearover} ? "O" : "-").
290
($rec->{d_flag} ? "D" : "-").
291
"-".
292
"-".
293
" ".$rec->{color});
412
push(@output, DatePerlToPlan($rec->{'date'})." ".
413
TimeRelPerlToPlan($rec->{'time'})." ".
414
TimeRelPerlToPlan($rec->{'length'})." ".
415
TimeRelPerlToPlan($rec->{'early'})." ".
416
TimeRelPerlToPlan($rec->{'late'})." ".
417
($rec->{'suspended'} ? "S" : "-").
418
($rec->{'private'} ? "P" : "-").
419
($rec->{'noalarm'} ? "N" : "-").
420
($rec->{'hide_month'} ? "M" : "-").
421
($rec->{'hide_year'} ? "Y" : "-").
422
($rec->{'hide_week'} ? "W" : "-").
423
($rec->{'hide_yearover'} ? "O" : "-").
424
($rec->{'d_flag'} ? "D" : "-").
425
"-".
426
"-".
427
" ".$rec->{'color'});
294
428
295
if (defined $rec->{repeat}) {
296
push @output, "R\t".join(" ",@{$rec->{repeat}});
429
if (defined $rec->{'repeat'}) {
430
push @output, "R\t".join(" ",@{$rec->{'repeat'}});
297
431
}
298
if (defined $rec->{exceptions}) {
299
foreach (@{$rec->{exceptions}}) {
432
if (defined $rec->{'exceptions'}) {
433
foreach (@{$rec->{'exceptions'}}) {
300
434
push @output, "E\t".DatePerlToPlan($_);
301
435
}
302
436
}
303
if (defined $rec->{note}) {
304
push @output, map("N\t$_", @{$rec->{note}});
305
}
306
if (defined $rec->{message}) {
307
push @output, map("M\t$_", @{$rec->{message}});
308
}
309
if (defined $rec->{script}) {
310
push @output, map("S\t$_", @{$rec->{script}});
311
}
312
if (defined $rec->{other}) {
313
foreach (@{$rec->{other}}) {
437
if (defined $rec->{'note'}) {
438
push @output, map("N\t$_", @{$rec->{'note'}});
439
}
440
if (defined $rec->{'message'}) {
441
push @output, map("M\t$_", @{$rec->{'message'}});
442
}
443
if (defined $rec->{'script'}) {
444
push @output, map("S\t$_", @{$rec->{'script'}});
445
}
446
if (defined $rec->{'other'}) {
447
foreach (@{$rec->{'other'}}) {
314
448
push @output, $_;
315
449
}
316
450
}
317
451
318
my($hash) = new MD5;
452
my ($hash) = new Digest::MD5;
319
453
foreach (@output) {
320
454
#print "Adding |$_| to hash\n";
321
455
$hash->add($_);
322
456
}
323
$rec->{pilothash} = $hash->hexdigest;
457
$rec->{'pilothash'} = $hash->hexdigest;
324
458
{
325
my($i);
326
for($i=0;$i<@output;$i++) {
459
my ($i);
460
for ($i=0;$i<@output;$i++) {
327
461
last if $output[$i] =~ /^S/;
328
462
}
329
$rec->{pilotexcept} += 0;
330
my(@US) = @{$rec->{unhashedscript}};
331
unshift @US, "S\t#Pilot: 1 $pilotname $rec->{pilothash} $rec->{pilotexcept} $rec->{pilotid}";
463
$rec->{'pilotexcept'} += 0;
464
my (@US);
465
@US = @{$rec->{'unhashedscript'}} if defined $rec->{'unhashedscript'};
466
unshift @US, "S\t#Pilot: 1 $pilotname $rec->{'pilothash'} $rec->{'pilotexcept'} $rec->{'pilotid'}";
332
467
splice @output, $i, 0, @US;
333
468
}
334
469
335
print "Generated record |",join("\n", @output),"|\n";
470
msg( "Generated record |" . join("\n", @output). "|\n" ) if ($PREFS->{'Debug'} > 2);
336
471
337
472
join("\n",@output);
338
473
}
339
474
475
############################################################
476
#
477
############################################################
340
478
sub PrintPlanRecord {
341
my($rec) = @_;
342
my($output);
479
my ($rec) = @_;
480
my ($output);
343
481
344
$output = DatePerlToPlan($rec->{date});
345
if ($rec->{time}) {
346
$output .= " ".TimePerlToPlan($rec->{time})."-".
347
TimePerlToPlan($rec->{time}+$rec->{length});
482
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
483
gmtime($rec->{'date'});
484
$year += 1900;
485
$mon++;
486
$output = "$year/$mon/$mday";
487
488
if ($rec->{'time'}) {
489
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
490
gmtime($rec->{'time'});
491
$output .= sprintf(" %02d:%02d-", $hour, $min);
492
493
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
494
gmtime($rec->{'time'}+$rec->{'length'});
495
$output .= sprintf("%02d:%02d", $hour, $min);
348
496
}
349
$output .= " '".join("\\n",@{$rec->{note}})."'";
350
$output .= " (".join("\\n",@{$rec->{message}}).")" if defined $rec->{message};
497
$output .= " '".join("\\n",@{$rec->{'note'}})."'" if defined $rec->{'note'};
498
$output .= " (".join("\\n",@{$rec->{'message'}}).")" if defined $rec->{'message'};
351
499
352
if ($rec->{repeat}) {
353
my(@r);
354
if ($rec->{repeat}[0]) {
355
push @r, "every " . ($rec->{repeat}[0] / (60*60*24)) . " days";
500
if ($rec->{'repeat'}) {
501
my (@r);
502
if ($rec->{'repeat'}[0]) {
503
push @r, "every " . ($rec->{'repeat'}[0] / (60*60*24)) . " days";
356
504
}
357
505
358
if ($rec->{repeat}[4]) {
506
if ($rec->{'repeat'}[4]) {
359
507
push @r, "every year";
360
508
}
361
if ($rec->{repeat}[3]) {
362
my($i) = $rec->{repeat}[3];
509
if ($rec->{'repeat'}[3]) {
510
my ($i) = $rec->{'repeat'}[3];
363
511
if ($i & 1) {
364
512
push @r, "the last day of each month";
365
513
}
367
515
push @r, "the $_ of each month" if $i & (1<<$_);
368
516
}
369
517
}
370
if ($rec->{repeat}[2]) {
371
push @r, "until ".scalar(localtime($rec->{repeat}[2]));
518
if ($rec->{'repeat'}[2]) {
519
push @r, "until ".scalar(gmtime($rec->{'repeat'}[2]));
372
520
}
373
521
if (@r) {
374
522
$output .= " repeat ".join(", ", @r);
375
523
}
376
524
}
377
525
378
$output .= " {ID:$rec->{pilotid}, Except:$rec->{pilotexcept}, Changed:$rec->{modified}, Deleted:$rec->{deleted}}";
526
# $output .= " {ID:$rec->{'pilotid'}, Except:";
527
# $output .= $rec->{'pilotexcept'} if (defined $rec->{'pilotexcept'});
528
# $output .= ", Changed:";
529
# $output .= $rec->{'modified'} if (defined $rec->{'modified'});
530
# $output .= ", Deleted:";
531
# $output .= $rec->{'deleted'} if (defined $rec->{'deleted'});
532
# $output .= "}";
379
533
380
534
$output;
381
535
}
382
536
537
############################################################
538
#
539
############################################################
383
540
sub PrintPilotRecord {
384
my($rec) = @_;
385
my($output);
386
387
$output = ($rec->{begin}[5]+1900)."/".($rec->{begin}[4]+1)."/".$rec->{begin}[3];
388
389
if (!$rec->{event}) {
541
my ($rec) = @_;
542
my ($output);
543
544
$output = ($rec->{'begin'}[5]+1900)."/".($rec->{'begin'}[4]+1)."/".$rec->{'begin'}[3];
545
546
if (!$rec->{'event'}) {
390
547
$output .= " ";
391
$output .= ($rec->{begin}[2]).":".($rec->{begin}[1]).":".$rec->{begin}[0];
392
$output .= "-";
393
$output .= ($rec->{end}[2]).":".($rec->{end}[1]).":".$rec->{end}[0];
548
$output .= sprintf("%02d:%02d-%02d:%02d",
549
$rec->{'begin'}[2],
550
$rec->{'begin'}[1],
551
$rec->{'end'}[2],
552
$rec->{'end'}[1]);
394
553
}
395
554
396
$output .= " '$rec->{description}'";
397
$output .= " ($rec->{message})" if not defined $rec->{message};
555
$output .= " '$rec->{'description'}'";
556
$output .= " ($rec->{'message'})" if (defined $rec->{'message'});
398
557
399
$output .= " {ID:$rec->{id}, Except:$exceptID{$rec->{id}}, Changed:$rec->{modified}, Deleted:$rec->{deleted}}";
558
# $output .= " {ID:$rec->{'id'}, Except:";
559
# $output .= $exceptID{$rec->{'id'}} if (defined $exceptID{$rec->{'id'}});
560
# $output .= ", Changed:";
561
# $output .= $rec->{'modified'} if (defined $rec->{'modified'});
562
# $output .= ", Deleted:";
563
# $output .= $rec->{'deleted'} if (defined $rec->{'deleted'});
564
# $output .= "}";
400
565
401
566
$output =~ s/\r/\\r/g;
402
567
$output =~ s/\n/\\n/g;
404
569
$output;
405
570
}
406
571
407
# takes a Plan record in hash format
572
############################################################
573
#
574
# Takes a Plan record in hash format
575
#
576
############################################################
408
577
sub WritePlanRecord {
409
my($socket, $record) = @_;
410
my($raw) = generaterecord($record);
411
my($reply);
412
$record->{id} ||= 0;
413
#print "ID is $record->{id}\n";
578
my ($socket, $record) = @_;
579
my ($raw) = generaterecord($record);
580
my ($reply);
581
$record->{'id'} ||= 0;
582
#print "ID is $record->{'id'}\n";
414
583
$raw =~ s/\n/\\\n/g;
415
$raw = "w$file $record->{id} $raw\n";
416
$record->{raw} = $raw;
584
$raw = "w$file $record->{'id'} $raw\n";
585
$record->{'raw'} = $raw;
417
586
SendPlanCommand($socket, $raw);
418
587
$reply = ReadPlanReply($socket);
419
#print "Installing record $record->{id} (PilotID: $record->{pilotid}) in Plan: ", Dumper($record);
588
#print "Installing record $record->{'id'} (PilotID: $record->{'pilotid'}) in Plan: ", Dumper($record);
420
589
# syswrite $socket, $raw, length($raw);
421
590
# sysread $socket, $reply, 1024;
422
591
# print "Reply to installation: |$reply|\n";
423
592
if ($reply =~ /^w[tf](\d+)/) {
424
$record->{id} = $1;
593
$record->{'id'} = $1;
425
594
$planRecord{$1} = $record;
426
595
# print "New record id: $1\n";
427
596
} else {
428
print "Failed write: $reply\n";
597
msg( "Failed write: $reply\n" );
429
598
}
430
599
}
431
600
432
601
602
############################################################
603
#
604
############################################################
433
605
sub LoadPilotRecord {
434
my($db, $i) = @_;
435
my($record) = $db->getRecord($i);
606
my ($db, $i) = @_;
607
my ($record) = $db->getRecord($i);
436
608
if ($record) {
437
$pilotID{$record->{id}} = $record;
609
$pilotID{$record->{'id'}} = $record;
610
} else {
611
checkErrNotFound($db);
438
612
}
439
613
$record;
440
614
}
441
615
616
############################################################
617
#
442
618
# takes a Plan record in hash format
619
#
620
############################################################
443
621
sub DeletePlanRecord {
444
my($socket, $record) = @_;
445
my($raw);
446
$raw = "d$file $record->{id}\n";
447
# print "Deleting record $record->{id} (PilotID: $record->{pilotid}) in Plan\n";
622
my ($socket, $record) = @_;
623
my ($raw);
624
$raw = "d$file $record->{'id'}\n";
625
# print "Deleting record $record->{'id'} (PilotID: $record->{'pilotid'}) in Plan\n";
448
626
# syswrite $socket, $raw, length($raw);
449
627
SendPlanCommand($socket, $raw);
450
628
}
451
629
630
############################################################
631
#
452
632
# takes a Palm record in hash format
633
#
634
############################################################
453
635
sub WritePilotRecord {
454
my($db, $control, $record) = @_;
636
my ($db, $control, $record) = @_;
455
637
456
$record->{id} ||= 0;
638
$record->{'id'} ||= 0;
639
$record->{'category'} ||= 0;
457
640
458
641
#print "Installing record in Palm: ",Dumper($record);
459
642
460
my($id) = $db->setRecord($record);
643
my ($id) = $db->setRecord($record);
461
644
462
645
if ($id) {
463
$pilotID{$id} = $record;
464
my ($hash) = HashPilotRecord($record);
646
$pilotID{$id} = $record;
647
my ($hash) = HashPilotRecord($record);
465
648
$pilothash{$id} = $hash;
466
$dbname{$id} = $control->{name};
467
$record->{id} = $id;
468
$execptID{$id} = 0;
649
$dbname{$id} = $control->{'name'};
650
$record->{'id'} = $id;
651
$exceptID{$id} = 0;
469
652
}
470
653
471
654
$id;
472
655
}
473
656
657
############################################################
658
#
659
############################################################
474
660
sub DeletePilotRecord {
475
my($db, $id) = @_;
476
my($result) = $db->deleteRecord($id);
661
my ($db, $id) = @_;
662
my ($result) = $db->deleteRecord($id);
477
663
if ($result>=0) {
478
664
delete $pilothash{$id};
479
665
delete $pilotID{$id};
486
672
487
673
$maxseed = 0;
488
674
675
############################################################
676
#
677
############################################################
489
678
sub dorecord {
490
my($db,$socket,$control, $i,$r) = @_;
679
my ($db,$socket,$control, $i,$r) = @_;
491
680
# print "Record: $r\n";
492
my(@l) = split(/\n/,$r);
493
my($rec) = { raw => [@l], other => [] };
494
my(@E,@R,@N,@M,@S,@US);
495
my($hash) = new MD5;
681
my (@l) = split(/\n/,$r);
682
my ($rec) = { raw => [@l], other => [] };
683
my (@E,@R,@N,@M,@S,@US);
684
my ($hash) = new Digest::MD5;
496
685
$l[0] =~ s/\s+/ /g;
497
686
$hash->add($l[0]);
498
my($date, $time, $length, $early, $late, $flags, $color) = split(/\s+/, shift @l);
499
$rec->{pilotrec} = "";
687
my ($date, $time, $length, $early, $late, $flags, $color) = split(/\s+/, shift @l);
688
$rec->{'pilotrec'} = "";
500
689
foreach (@l) {
501
690
if (/^E\t/) {
502
691
push @E, $';
508
697
my ($s) = $';
509
698
if ($s =~ /^\s*#Pilot:\s+(\d+)\s*(.*)$/) {
510
699
if ($1 == 1) { # version number
511
my($name,$hash,$except,$id) = split(/\s+/, $2);
700
my ($name,$hash,$except,$id) = split(/\s+/, $2);
512
701
#print Dumper({Name=>$name,Hash=>$hash,Except=>$except,ID=>$id});
513
702
if ($name eq $pilotname) {
514
$rec->{pilotid} = $id;
515
$rec->{pilotexcept} = $except || 0;
516
$rec->{pilothash} = $hash;
703
$rec->{'pilotid'} = $id;
704
$rec->{'pilotexcept'} = $except || 0;
705
$rec->{'pilothash'} = $hash;
517
706
$planID{$id} = $rec;
518
707
next;
519
708
}
524
713
push @S, $s;
525
714
}
526
715
} elsif (/^R\t/) {
527
my($r) = $';
716
my ($r) = $';
528
717
$r =~ s/\s+/ /g;
529
$rec->{repeat} = [split(/\s+/, $r)];
718
$rec->{'repeat'} = [split(/\s+/, $r)];
530
719
} else {
531
push @{$rec->{other}}, $_;
720
push @{$rec->{'other'}}, $_;
532
721
}
533
722
#print "Adding |$_| to hash\n";
534
723
$hash->add($_);
535
724
}
536
725
$hash = $hash->hexdigest;
537
#print "Old hash: $hash, New hash: $rec->{pilothash}\n";
538
$rec->{modified} = ($rec->{pilothash} ne $hash);
539
$rec->{note} = \@N if @N;
540
$rec->{script} = \@S if @S;
541
$rec->{unhashedscript} = \@US if @US;
542
$rec->{message} = \@M if @M;
543
$rec->{date} = DatePlanToPerl($date);
544
$rec->{time} = TimePlanToPerl($time);
545
$rec->{length} = TimePlanToPerl($length);
546
$rec->{early} = TimePlanToPerl($early);
547
$rec->{late} = TimePlanToPerl($late);
548
$rec->{color} = $color;
726
#print "Old hash: $hash, New hash: $rec->{'pilothash'}\n";
727
$rec->{'modified'} = (!defined($rec->{'pilothash'}) ||
728
($rec->{'pilothash'} ne $hash));
729
$rec->{'note'} = \@N if @N;
730
$rec->{'script'} = \@S if @S;
731
$rec->{'unhashedscript'} = \@US if @US;
732
$rec->{'message'} = \@M if @M;
733
$rec->{'date'} = DatePlanToPerl($date);
734
$rec->{'time'} = TimePlanToPerl($time);
735
$rec->{'length'} = TimePlanToPerl($length);
736
$rec->{'early'} = TimePlanToPerl($early);
737
$rec->{'late'} = TimePlanToPerl($late);
738
$rec->{'color'} = $color;
549
739
550
$rec->{suspended} = substr($flags,0,1) ne "-";
551
$rec->{private} = substr($flags,1,1) ne "-";
552
$rec->{noalarm} = substr($flags,2,1) ne "-";
553
$rec->{hide_month} = substr($flags,3,1) ne "-";
554
$rec->{hide_year} = substr($flags,4,1) ne "-";
555
$rec->{hide_week} = substr($flags,5,1) ne "-";
556
$rec->{hide_yearover} = substr($flags,6,1) ne "-";
557
$rec->{d_flag} = substr($flags,7,1) ne "-";
558
$rec->{locked} = 1;
559
$rec->{id} = $i;
740
$rec->{'suspended'} = substr($flags,0,1) ne "-";
741
$rec->{'private'} = substr($flags,1,1) ne "-";
742
$rec->{'noalarm'} = substr($flags,2,1) ne "-";
743
$rec->{'hide_month'} = substr($flags,3,1) ne "-";
744
$rec->{'hide_year'} = substr($flags,4,1) ne "-";
745
$rec->{'hide_week'} = substr($flags,5,1) ne "-";
746
$rec->{'hide_yearover'} = substr($flags,6,1) ne "-";
747
$rec->{'d_flag'} = substr($flags,7,1) ne "-";
748
$rec->{'locked'} = 1;
749
$rec->{'id'} = $i;
560
750
561
$rec->{exceptions} = [map(DatePlanToPerl($_), @E)] if @E;
751
$rec->{'exceptions'} = [map(DatePlanToPerl($_), @E)] if @E;
562
752
563
753
$planRecord{$i} = $rec;
564
754
566
756
#print Dumper($rec);
567
757
}
568
758
759
############################################################
760
#
761
############################################################
569
762
sub HashPilotRecord {
570
my($record) = @_;
571
my($hash) = new MD5;
572
$hash->add($record->{raw});
763
my ($record) = @_;
764
my ($hash) = new Digest::MD5;
765
$hash->add($record->{'raw'});
573
766
$hash->hexdigest;
574
767
}
575
768
576
769
770
############################################################
771
#
772
############################################################
577
773
sub doafterplan {
578
579
$ticklecount = 0; # Reset ticklecount
580
$doticklecount = 100; # Tickle every 100 loop
581
582
my($db,$socket,$control) = @_;
583
print "After stuff:\n";
584
585
# This batch of code scans for Plan records with identical Pilot IDs,
586
# presumambly caused by duplicating a plan record. We remove the ids
587
# from the duplicates. The weird sort is magic to prefer keeping the id
588
# (and thus leaving unmodified) of an otherwise unmodified record.
774
my ($db,$socket,$control) = @_;
775
msg( "After stuff:\n" ) if ($PREFS->{'Debug'} > 2);
776
777
##################################################################
778
# This batch of code scans for Plan records with identical Pilot
779
# IDs, presumambly caused by duplicating a plan record. We remove
780
# the ids from the duplicates. The weird sort is magic to prefer
781
# keeping the id (and thus leaving unmodified) of an otherwise
782
# unmodified record.
783
##################################################################
589
784
590
my (@uniq) = sort {$a->{pilotid} <=> $b->{pilotid} or $a->{modified} <=> $b->{modified}} grep {exists $_->{pilotid}} values %planRecord;
591
my($i)=0;
785
my (@uniq) = sort {$a->{'pilotid'} <=> $b->{'pilotid'} or $a->{'modified'} <=> $b->{'modified'}} grep {exists $_->{'pilotid'}} values %planRecord;
786
my ($i) = 0;
592
787
for($i=@uniq-1;$i>=1;$i--) {
593
788
#print "Checking plan record: ", Dumper($uniq[$i]),"\n";
594
if ($uniq[$i]->{pilotid} == $uniq[$i-1]->{pilotid}) {
595
delete $uniq[$i]->{pilotid};
596
$planID{$uniq[$i-1]->{pilotid}} = $uniq[$i-1];
789
if ($uniq[$i]->{'pilotid'} == $uniq[$i-1]->{'pilotid'}) {
790
delete $uniq[$i]->{'pilotid'};
791
$planID{$uniq[$i-1]->{'pilotid'}} = $uniq[$i-1];
597
792
#print "... A dup, blessed be ye without id, and be ye modified.\n";
598
$uniq[$i]->{modified} = 1;
793
$uniq[$i]->{'modified'} = 1;
599
794
}
600
795
}
601
796
602
# Use our saved Pilot ID cache to detect deleted Plan records.
603
# This will not catch deleted Plan records that were never assigned
604
# a Pilot ID, but that is OK because such records do not have to be removed
605
# from the Palm.
797
######################################################################
798
# Use our saved Pilot ID cache to detect deleted Plan records. This
799
# will not catch deleted Plan records that were never assigned a
800
# Pilot ID, but that is OK because such records do not have to be
801
# removed from the Palm.
802
######################################################################
803
my ($loop_count) = (0);
606
804
607
my($del)=-1;
805
my ($del) = -1;
608
806
foreach (keys %pilothash) {
609
807
610
808
# Palm records originally downloaded from a different Plan database
611
809
# are off-limits during this pass.
612
810
613
next if $dbname{$_} ne $control->{name};
811
next if $dbname{$_} ne $control->{'name'};
614
812
615
813
616
814
# print "Palm cached ID: $_\n";
617
815
if (not defined $planID{$_} and not $exceptID{$_}) {
618
816
#print "Deleted plan record, with Pilot ID $_\n";
619
$planID{$_}->{deleted} = 1;
620
$planID{$_}->{pilotid} = $_;
621
$planID{$_}->{id} = $del;
817
$planID{$_}->{'deleted'} = 1;
818
$planID{$_}->{'pilotid'} = $_;
819
$planID{$_}->{'id'} = $del;
622
820
$planRecord{$del} = $planID{$_};
623
821
$del--;
624
822
}
625
823
}
626
824
627
print "Palm loop\n";
825
msg( "Palm loop\n" ) if ($PREFS->{'Debug'} > 2);
628
826
629
827
foreach (keys %pilotID) {
828
$dlp->tickle unless (++$loop_count % 50);
630
829
631
# Tickle the pilot so it will not time out during this
632
$ticklecount++;
633
if ($ticklecount >= $doticklecount) {
634
$dlp->tickle();
635
$ticklecount = 0;
636
}
637
638
830
# Palm records originally downloaded from a different Plan database
639
831
# are off-limits during this pass.
640
832
641
next if $dbname{$_} ne $control->{name};
642
643
644
print "Palm record: ",PrintPilotRecord($pilotID{$_}),"\n";
833
next if $dbname{$_} ne $control->{'name'};
834
835
836
msg( "Palm record: " . PrintPilotRecord($pilotID{$_}) . "\n" ) if ($PREFS->{'Debug'} > 1);
645
837
#print "Palm record: ",Dumper($pilotID{$_}),"\n";
646
if ($pilotID{$_}->{deleted} || $pilotID{$_}->{archived}) {
838
if ($pilotID{$_}->{'deleted'} || $pilotID{$_}->{'archived'}) {
647
839
#
648
840
# # At this point are seeing Palm records marked as deleted or
649
841
# # archived. In the case of a slow sync, deleted records may not
652
844
# # Action: If there is an associated Plan record that has not
653
845
# # already been deleted, delete it.
654
846
#
655
# if (defined $planID{$_} and not $planID{$_}->{deleted}) {
847
# if (defined $planID{$_} and not $planID{$_}->{'deleted'}) {
656
848
# DeletePlanRecord($planID{$_});
657
# delete $planRecord{$planID{$_}->{id}};
849
# delete $planRecord{$planID{$_}->{'id'}};
658
850
# delete $planID{$_};
659
851
# }
660
852
#
665
857
#
666
858
# delete $pilothash{$_};
667
859
} else {
668
my($hash) = HashPilotRecord($pilotID{$_});
860
my ($hash) = HashPilotRecord($pilotID{$_});
669
861
670
# If the pilot record ID is not cached, then it is definitely
671
# new. If the MD5 hash of the record is different from the
672
# cached hash, then it is definitely different. These checks are
673
# only needed during a slow sync (which will have inaccurate
862
######################################################
863
# If the pilot record ID is not cached, then it is
864
# definitely new. If the MD5 hash of the record is
865
# different from the cached hash, then it is
866
# definitely different. These checks are only needed
867
# during a slow sync (which will have inaccurate
674
868
# flags), but are harmless during a fast sync.
869
######################################################
675
870
676
871
#print "Old hash: $pilothash{$_}, new hash: $hash\n";
677
872
if ((not exists $pilothash{$_}) or ($hash ne $pilothash{$_})) {
678
$pilotID{$_}->{modified} = 1;
873
$pilotID{$_}->{'modified'} = 1;
679
874
#print "Note: cache indicates record is changed\n";
680
875
}
681
876
$pilothash{$_} = $hash; # Record the hash and ID for the next sync
683
878
# Remove the record from the exception cache if it has been
684
879
# modified: perhaps it is not exceptional any more
685
880
686
delete $exceptID{$_} if $pilotID{$_}->{modified};
881
delete $exceptID{$_} if $pilotID{$_}->{'modified'};
687
882
688
883
#print "Matching plan record: ", Dumper($planID{$_}),"\n";
689
884
694
889
# Action: Install the Palm record in Plan, regardless of
695
890
# changed status
696
891
697
print "Action: Install Palm record in Plan.\n";
892
msg( "Installing Palm record in Plan: ".
893
PrintPilotRecord($pilotID{$_}). "\n" ) if ($PREFS->{'Debug'});
698
894
699
895
#print "Installing pilot record in plan: ",Dumper($pilotID{$_});
700
896
701
my($record) = RecordPilotToPlan($pilotID{$_});
897
my ($record) = RecordPilotToPlan($pilotID{$_});
702
898
if (not defined $record) {
703
899
# The record is not translatable to a Plan record.
704
900
709
905
710
906
$exceptID{$_} = 1;
711
907
712
print "Log: Palm record unsyncable\n";
908
msg( "Palm record unsyncable\n" );
713
909
714
910
} else {
715
911
716
912
WritePlanRecord($socket, $record);
717
913
}
718
914
}
719
} elsif ($pilotID{$_}->{modified} and $planID{$_}->{deleted}) {
915
} elsif ($pilotID{$_}->{'modified'} and $planID{$_}->{'deleted'}) {
720
916
721
# The Palm record has a matching _deleted_ Plan record.
917
############################################
918
# The Palm record has a matching _deleted_
919
# Plan record.
722
920
723
# This is collision, with a relatively simple solution.
724
# replace the Plan record with the Palm record. As the Plan
725
# record has already been permanently deleted, we need only copy
726
# the Palm record over.
921
# This is collision, with a relatively
922
# simple solution. replace the Plan record
923
# with the Palm record. As the Plan record
924
# has already been permanently deleted, we
925
# need only copy the Palm record over.
727
926
728
927
# Action: Install the Palm record in Plan
928
############################################
929
729
930
730
my($record) = RecordPilotToPlan($pilotID{$_}, $planID{$_});
931
my ($record) = RecordPilotToPlan($pilotID{$_}, $planID{$_});
731
932
if (not defined $record) {
732
933
# The record is not translatable to a Plan record.
733
934
736
937
737
938
$exceptID{$_} = 1;
738
939
739
print "Log: Palm record modified while Plan record deleted, but new Palm record unsyncable\n";
940
msg( "Palm record modified while Plan record deleted, but new Palm record unsyncable\n" );
740
941
} else {
741
942
742
943
WritePlanRecord($socket, $record);
743
944
744
print "Log: Palm record modified while Plan record deleted\n";
945
msg( "Palm record modified while Plan record deleted\n" ) if ($PREFS->{'Debug'} > 1);
745
946
}
746
947
747
} elsif ($pilotID{$_}->{modified} and $planID{$_}->{modified}) {
748
749
# The Palm record has a matching _modified_ Plan record.
750
751
# TODO: Use a comparator function to verify that the records
752
# are actually substantially different. If not, simply skip
753
# any action.
754
755
# This is collision with an ugly, but lossless, solution.
756
# Neither the Palm or Plan record is inherantly preferable,
757
# so we duplicate each record on the other side, severing
758
# the link between the original new records, forging two new
759
# links and two new records, one on each side.
760
761
# Action: Install the Palm record in Plan as a new,
762
# distinct, record, and install the Plan record on the Palm
763
# as a new, distinct, record.
764
765
print "Log: Conflicting modified Plan and Palm records\n";
948
} elsif ($pilotID{$_}->{'modified'} and $planID{$_}->{'modified'}) {
949
950
951
############################################
952
# The Palm record has a matching _modified_
953
# Plan record.
954
955
# TODO: Use a comparator function to verify
956
# that the records are actually
957
# substantially different. If not, simply
958
# skip any action.
959
960
# This is collision with an ugly, but
961
# lossless, solution. Neither the Palm or
962
# Plan record is inherantly preferable, so
963
# we duplicate each record on the other
964
# side, severing the link between the
965
# original new records, forging two new
966
# links and two new records, one on each
967
# side.
968
969
# Action: Install the Palm record in Plan as
970
# a new, distinct, record, and install the
971
# Plan record on the Palm as a new,
972
# distinct, record.
973
############################################
974
975
976
msg( "Conflicting modified Plan and Palm records\n" );
766
977
767
978
{
768
my($record) = RecordPlanToPilot($planID{$_});
979
my ($record) = RecordPlanToPilot($planID{$_});
769
980
if (not defined $record) {
770
981
# The Plan record is not translatable to a Palm record.
771
982
772
983
# Action: Abort the install.
773
984
774
print "Log: Conflicting Plan record unsyncable.\n";
985
msg( "Conflicting Plan record unsyncable.\n" );
775
986
} else {
776
$record->{id} = 0;
777
my($id) = WritePilotRecord($db, $control, $record);
987
$record->{'id'} = 0;
988
my ($id) = WritePilotRecord($db, $control, $record);
778
989
779
990
#$db->setRecord($record);
780
991
#
781
992
#my ($hash) = HashPilotRecord($record);
782
993
#$pilothash{$id} = $hash;
783
994
#
784
#$record->{id} = $id;
995
#$record->{'id'} = $id;
785
996
#$pilotID{$id} = $record;
786
997
#$dbname{$id} = $dbname;
787
998
788
$planID{$_}->{pilotid} = $id;
999
$planID{$_}->{'pilotid'} = $id;
789
1000
790
$planID{$_}->{modified} = 0;
1001
$planID{$_}->{'modified'} = 0;
791
1002
792
1003
WritePlanRecord($socket, $planID{$_});
793
1004
794
print "ID of new Palm record is $id\n";
1005
msg( "ID of new Palm record is $id\n" ) if ($PREFS->{'Debug'} > 2);
795
1006
}
796
1007
}
797
1008
798
1009
{
799
my($record) = RecordPilotToPlan($pilotID{$_});
1010
my ($record) = RecordPilotToPlan($pilotID{$_});
800
1011
if (not defined $record) {
801
1012
# The Palm record is not translatable to a Plan record.
802
1013
804
1015
805
1016
$exceptID{$_} = 1;
806
1017
807
print "Log: Conflicting Palm record unsyncable.\n";
1018
msg( "Conflicting Palm record unsyncable.\n" );
808
1019
} else {
809
1020
810
$record->{modified} = 0;
1021
$record->{'modified'} = 0;
811
1022
812
my($id) = WritePlanRecord($socket, $record);
1023
my ($id) = WritePlanRecord($socket, $record);
813
1024
814
print "ID of new Plan record is $id\n";
1025
msg( "ID of new Plan record is $id\n" ) if ($PREFS->{'Debug'} > 2);
815
1026
816
1027
}
817
1028
}
818
} elsif($pilotID{$_}->{modified}) {
1029
} elsif($pilotID{$_}->{'modified'}) {
819
1030
820
# At this point, we have a changed Palm record with an
821
# existing unmodified Plan record.
1031
##########################################
1032
# At this point, we have a changed Palm
1033
# record with an existing unmodified Plan
1034
# record.
822
1035
823
# Action: Install the Palm record in Plan, overwriting the
824
# Plan record.
1036
# Action: Install the Palm record in Plan,
1037
# overwriting the Plan record.
1038
##########################################
825
1039
826
my($record) = RecordPilotToPlan($pilotID{$_}, $planID{$_});
1040
my ($record) = RecordPilotToPlan($pilotID{$_}, $planID{$_});
827
1041
if (not defined $record) {
828
1042
# The record is not translatable to a Plan record.
829
1043
835
1049
$exceptID{$_} = 1;
836
1050
DeletePlanRecord($socket, $planID{$_});
837
1051
838
print "Log: Palm record modified while Plan record unchanged, but new Palm record unsyncable. Plan record has been deleted.\n";
1052
msg( "Palm record modified while Plan record unchanged, but new Palm record unsyncable. Plan record has been deleted.\n" );
839
1053
} else {
840
1054
841
1055
#print "Overwriting plan record: ",Dumper($planID{$_});
843
1057
#print "As plan record: ",Dumper($record);
844
1058
845
1059
WritePlanRecord($socket, $record);
846
print "Log: Overwriting unchanged Plan record with modified Palm record.\n";
1060
msg( "Updating Plan record with modified Palm record: ".PrintPilotRecord($pilotID{$_})."\n" ) if ($PREFS->{'Debug'});
847
1061
#print "New plan record state: ",Dumper($planID{$_}),"\n";
848
1062
}
849
1063
}
850
1064
}
851
1065
}
852
853
print "Plan loop\n";
1066
$dlp->tickle;
1067
msg( "Plan loop\n" ) if ($PREFS->{'Debug'} > 2);
854
1068
855
1069
foreach (keys %planRecord) {
856
857
# Tickle the pilot so it will not time out during this
858
$ticklecount++;
859
if ($ticklecount >= $doticklecount) {
860
$dlp->tickle();
861
$ticklecount = 0;
862
}
863
864
print "Plan record: ",PrintPlanRecord($planRecord{$_}),"\n";
865
my($record) = $planRecord{$_};
866
my($pid) = $planRecord{$_}->{pilotid};
1070
$dlp->tickle unless (++$loop_count % 100);
1071
1072
msg( "Plan record: " . PrintPlanRecord($planRecord{$_}),"\n" ) if ($PREFS->{'Debug'} > 1);
1073
my ($record) = $planRecord{$_};
1074
my ($pid) = $planRecord{$_}->{'pilotid'};
867
1075
868
1076
#print "Plan record: ",Dumper($record),"\n";
869
if ($record->{deleted}) {
1077
if ($record->{'deleted'}) {
870
1078
#
871
1079
# # At this point are seeing Palm records marked as deleted or
872
1080
# # archived. In the case of a slow sync, deleted records may not
875
1083
# # Action: If there is an associated Plan record that has not
876
1084
# # already been deleted, delete it.
877
1085
#
878
# if (defined $planID{$_} and not $planID{$_}->{deleted}) {
1086
# if (defined $planID{$_} and not $planID{$_}->{'deleted'}) {
879
1087
# DeletePlanRecord($planID{$_});
880
# delete $planRecord{$planID{$_}->{id}};
1088
# delete $planRecord{$planID{$_}->{'id'}};
881
1089
# delete $planID{$_};
882
1090
# }
883
1091
#
892
1100
# Remove the record from the exception cache if it has been
893
1101
# modified: perhaps it is not exceptional any more
894
1102
895
delete $record->{pilotexcept} if $record->{modified};
1103
delete $record->{'pilotexcept'} if $record->{'modified'};
896
1104
897
1105
# If this is a fast sync, it's possible the record hasn't been
898
1106
# fetched yet.
899
1107
1108
# This is dead code. Fast sync was never
1109
# implemented, so $slowsync is always 1. I'm
1110
# leaving it here as a hint in case someone
1111
# ever gets around to implementing fast sync.
1112
# But it looks incorrect to me:
1113
# LoadPilotRecord takes an index, not an
1114
# id. -ANK
1115
900
1116
if (!$slowsync and defined $pid and not exists $pilotID{$pid}) {
901
my($precord) = LoadPilotRecord($db, $pid);
1117
my ($precord) = LoadPilotRecord($db, $pid);
902
1118
#$db->getRecord($pid);
903
1119
if (defined $precord) {
904
1120
if (not defined $dbname{$pid}) {
905
$dbname{$pid} = $control->{defaultname};
1121
$dbname{$pid} = $control->{'defaultname'};
906
1122
}
907
1123
$pilotID{$pid} = $precord;
908
1124
}
909
1125
}
910
1126
911
if (defined $pid and defined $pilotID{$pid} and ($dbname{$pid} ne $control->{name})) {
912
print "Weird: Plan database $control->{name} claims to own Palm record $pid,\n";
913
print "but my ID database says it is owned by $dbname{$pid}. I'll skip it.\n";
1127
if (defined $pid and defined $pilotID{$pid} and ($dbname{$pid} ne $control->{'name'})) {
1128
msg( "Weird: Plan database $control->{'name'} claims to own Palm record $pid,\n" );
1129
msg( "but my ID database says it is owned by $dbname{$pid}. I'll skip it.\n" );
914
1130
next;
915
1131
}
916
1132
917
1133
#print "Matching pilot record: ", Dumper($pilotID{$pid}),"\n";
918
1134
919
1135
if (not defined $pid or not defined $pilotID{$pid}) {
920
if (!$record->{pilotexcept}) {
1136
if (!$record->{'pilotexcept'}) {
921
1137
# The Plan record has no matching Palm record
922
1138
923
1139
# Action: Install the Plan record in Palm, regardless of
924
1140
# changed status
925
1141
926
print "Action: Install Plan record in Palm.\n";
1142
msg( "Installing Plan record in Palm: ".
1143
PrintPlanRecord($record). "\n" ) if ($PREFS->{'Debug'});
927
1144
928
1145
#print "Installing plan record in pilot: ",Dumper($record);
929
1146
#print "Trying to install Plan record: ",Dumper($record),"\n";
930
1147
931
my($newrecord) = RecordPlanToPilot($record);
1148
my ($newrecord) = RecordPlanToPilot($record);
932
1149
if (not defined $newrecord) {
933
1150
# The record is not translatable to a Palm record.
934
1151
937
1154
# Code above will remove the exception flag when the
938
1155
# record is changed.
939
1156
940
$record->{pilotexcept} = 1;
941
$record->{modified} = 1;
1157
$record->{'pilotexcept'} = 1;
1158
$record->{'modified'} = 1;
942
1159
943
print "Log: Plan record unsyncable\n";
1160
msg( "Plan record unsyncable\n" );
944
1161
945
1162
} else {
946
1163
#print "Installing Palm record: ", Dumper($newrecord),"\n";
947
1164
948
$newrecord->{id} = 0;
949
$newrecord->{secret} = 0;
950
my($id) = WritePilotRecord($db,$control,$newrecord);
1165
$newrecord->{'id'} = 0;
1166
$newrecord->{'secret'} = 0;
1167
my ($id) = WritePilotRecord($db,$control,$newrecord);
951
1168
#$db->setRecord($newrecord);
952
1169
953
print "ID of new Palm record is $id\n";
1170
msg( "ID of new Palm record is $id\n" ) if ($PREFS->{'Debug'} > 2);
954
1171
955
1172
#my ($hash) = HashPilotRecord($newrecord);
956
1173
#$pilothash{$id} = $hash;
957
1174
#
958
#$newrecord->{id} = $id;
1175
#$newrecord->{'id'} = $id;
959
1176
#$pilotID{$id} = $newrecord;
960
1177
#$dbname{$id} = $dbname;
961
1178
962
$record->{pilotid} = $id; # Match the Palm record to the Plan record
963
$record->{modified} = 1; # and make sure it is written back out
1179
$record->{'pilotid'} = $id; # Match the Palm record to the Plan record
1180
$record->{'modified'} = 1; # and make sure it is written back out
964
1181
}
965
1182
}
966
} elsif ($record->{modified} and $pilotID{$pid}->{deleted}) {
1183
} elsif ($record->{'modified'} and $pilotID{$pid}->{'deleted'}) {
967
1184
968
1185
# The Plan record has a matching _deleted_ Palm record.
969
1186
972
1189
973
1190
# Action: Install the Plan record in Palm
974
1191
975
my($newrecord) = RecordPlanToPilot($record, $pilotID{$pid});
1192
my ($newrecord) = RecordPlanToPilot($record, $pilotID{$pid});
976
1193
if (not defined $newrecord) {
977
1194
# The record is not translatable to a Palm record.
978
1195
979
1196
# Action: Abort the install, and mark the record as
980
1197
# uninstallable so that it will not be tried each sync.
981
1198
982
$record->{pilotexcept} = 1;
1199
$record->{'pilotexcept'} = 1;
983
1200
984
print "Log: Plan record modified while Palm record deleted, but new Plan record unsyncable\n";
1201
msg( "Plan record modified while Palm record deleted, but new Plan record unsyncable\n" );
985
1202
} else {
986
1203
987
1204
#print "Installing Palm record: ", Dumper($newrecord),"\n";
990
1207
#my ($hash) = HashPilotRecord($newrecord);
991
1208
#$pilothash{$pid} = $hash;
992
1209
993
print "Log: Plan record modified while Palm record deleted\n";
1210
msg( "Plan record modified while Palm record deleted\n" ) if ($PREFS->{'Debug'} > 1);
994
1211
}
995
1212
996
} elsif ($record->{modified} and $pilotID{$pid}->{modified}) {
997
die("This shouldn't happen...");
998
} elsif ($record->{modified}) {
1213
} elsif ($record->{'modified'} and $pilotID{$pid}->{'modified'}) {
1214
croak("This shouldn't happen...");
1215
} elsif ($record->{'modified'}) {
999
1216
1000
1217
# At this point, we have a changed Plan record with an
1001
1218
# existing unmodified Palm record.
1004
1221
# Palm record.
1005
1222
1006
1223
#print "Trying to install Plan record: ",Dumper($record),"\n";
1007
my($newrecord) = RecordPlanToPilot($record, $pilotID{$pid});
1224
my ($newrecord) = RecordPlanToPilot($record, $pilotID{$pid});
1008
1225
if (not defined $newrecord) {
1009
1226
# The record is not translatable to a Plan record.
1010
1227
1013
1230
# Code above will remove the exception flag when the
1014
1231
# record is changed.
1015
1232
1016
$record->{pilotexcept} = 1;
1233
$record->{'pilotexcept'} = 1;
1017
1234
1018
1235
DeletePilotRecord($db,$pid);
1019
#$db->deleteRecord($record->{pilotid});
1020
#delete $pilothash{$record->{pilotid}};
1021
#delete $exceptID{$record->{pilotid}};
1236
#$db->deleteRecord($record->{'pilotid'});
1237
#delete $pilothash{$record->{'pilotid'}};
1238
#delete $exceptID{$record->{'pilotid'}};
1022
1239
1023
print "Log: Plan record modified while Palm record unchanged, but new Plan record unsyncable. Palm record has been deleted.\n";
1240
msg( "Plan record modified while Palm record unchanged, but new Plan record unsyncable. Palm record has been deleted.\n" );
1024
1241
} else {
1025
1242
1026
1243
#print "Overwriting pilot record: ",Dumper($pilotID{$_});
1033
1250
#my ($hash) = HashPilotRecord($newrecord);
1034
1251
#$pilothash{$pid} = $hash;
1035
1252
1036
print "Log: Overwriting unchanged Palm record with modified Plan record.\n";
1253
msg( "Updating Palm record with modified Plan record: ".PrintPlanRecord($record)."\n" ) if ($PREFS->{'Debug'});
1037
1254
}
1038
1255
}
1039
1256
}
1040
if ($record->{modified}) {
1257
if ($record->{'modified'}) {
1041
1258
WritePlanRecord($socket, $record);
1042
1259
}
1043
1260
}
1044
1261
1045
print "Palm delete loop\n";
1262
msg( "Palm delete loop\n" ) if ($PREFS->{'Debug'} > 2);
1046
1263
1047
1264
foreach (keys %pilotID) {
1048
1049
# Tickle the pilot so it will not time out during this
1050
$ticklecount++;
1051
if ($ticklecount >= $doticklecount) {
1052
$dlp->tickle();
1053
$ticklecount = 0;
1054
}
1055
1056
1057
# Palm records originally downloaded from a different Plan database
1058
# are off-limits during this pass.
1059
1060
next if $dbname{$_} ne $control->{name};
1265
$dlp->tickle unless (++$loop_count % 100);
1266
1267
############################################################
1268
# Palm records originally downloaded from a different Plan
1269
# database are off-limits during this pass.
1270
############################################################
1271
next if $dbname{$_} ne $control->{'name'};
1061
1272
1062
1273
#print "Palm record: ",Dumper($pilotID{$_}),"\n";
1063
print "Palm record: ",PrintPilotRecord($pilotID{$_}),"\n";
1064
if ($pilotID{$_}->{deleted} || $pilotID{$_}->{archived}) {
1274
msg( "Palm record: " . PrintPilotRecord($pilotID{$_}) . "\n" ) if ($PREFS->{'Debug'} > 1);
1275
if ($pilotID{$_}->{'deleted'} || $pilotID{$_}->{'archived'}) {
1065
1276
1066
1277
# At this point are seeing Palm records marked as deleted or
1067
1278
# archived. In the case of a slow sync, deleted records may not
1070
1281
# Action: If there is an associated Plan record that has not
1071
1282
# already been deleted, delete it.
1072
1283
1073
print "Log: Deleting Palm record.\n";
1284
msg( "Deleting Palm record.\n" ) if ($PREFS->{'Debug'} > 1);
1074
1285
1075
if (defined $planID{$_} and not $planID{$_}->{deleted}) {
1076
print "Log: ... and associated Plan record.\n";
1286
if (defined $planID{$_} and not $planID{$_}->{'deleted'}) {
1287
msg( "... and associated Plan record.\n" ) if ($PREFS->{'Debug'} > 1);
1288
msg( "Deleting from Plan: ". PrintPlanRecord($planRecord{$planID{$_}->{'id'}}) ."\n") if ($PREFS->{'Debug'});
1077
1289
DeletePlanRecord($socket, $planID{$_});
1078
delete $planRecord{$planID{$_}->{id}};
1290
delete $planRecord{$planID{$_}->{'id'}};
1079
1291
delete $planID{$_};
1080
1292
}
1081
1293
1090
1302
}
1091
1303
}
1092
1304
1093
print "Plan delete loop\n";
1305
msg( "Plan delete loop\n" ) if ($PREFS->{'Debug'} > 2);
1094
1306
1095
1307
foreach (keys %planRecord) {
1096
1097
# Tickle the pilot so it will not time out during this
1098
$ticklecount++;
1099
if ($ticklecount >= $doticklecount) {
1100
$dlp->tickle();
1101
$ticklecount = 0;
1102
}
1308
$dlp->tickle unless (++$loop_count % 100);
1103
1309
1104
my($record) = $planRecord{$_};
1105
my($pid) = $planRecord{$_}->{pilotid};
1310
my ($record) = $planRecord{$_};
1311
my ($pid) = $planRecord{$_}->{'pilotid'};
1106
1312
#print "Plan record: ",Dumper($record),"\n";
1107
print "Plan record: ",PrintPlanRecord($planRecord{$_}),"\n";
1313
msg( "Plan record: " . PrintPlanRecord($planRecord{$_}) . "\n" ) if ($PREFS->{'Debug'} > 1);
1108
1314
1109
1315
# In a fast sync, we might not have loaded the record yet.
1110
1316
1317
# This is dead code. Fast sync was never implemented,
1318
# so $slowsync is always 1. I'm leaving it here as a
1319
# hint in case someone ever gets around to
1320
# implementing fast sync. But it looks incorrect to
1321
# me: LoadPilotRecord takes an index, not an id. -ANK
1322
1111
1323
if (!$slowsync and defined $pid and not exists $pilotID{$pid}) {
1112
my($precord) = LoadPilotRecord($db, $pid);
1324
my ($precord) = LoadPilotRecord($db, $pid);
1113
1325
#$db->getRecord($pid);
1114
1326
if (defined $precord) {
1115
1327
if (not defined $dbname{$pid}) {
1116
$dbname{$pid} = $control->{defaultname};
1328
$dbname{$pid} = $control->{'defaultname'};
1117
1329
}
1118
1330
$pilotID{$pid} = $precord;
1119
1331
}
1120
1332
}
1121
1333
1122
if (defined $pid and defined $pilotID{$pid} and ($dbname{$pid} ne $control->{name})) {
1123
print "Weird: Plan database $control->{name} claims to own Palm record $pid,\n";
1124
print "but my ID database says it is owned by $dbname{$pid}. I'll skip it.\n";
1334
if (defined $pid and defined $pilotID{$pid} and ($dbname{$pid} ne $control->{'name'})) {
1335
msg( "Weird: Plan database $control->{'name'} claims to own Palm record $pid,\n" );
1336
msg( "but my ID database says it is owned by $dbname{$pid}. I'll skip it.\n" );
1125
1337
next;
1126
1338
}
1127
1339
1128
if ($record->{deleted}) {
1340
if ($record->{'deleted'}) {
1129
1341
1130
1342
# At this point are seeing Palm records marked as deleted or
1131
1343
# archived. In the case of a slow sync, deleted records may not
1134
1346
# Action: If there is an associated Plan record that has not
1135
1347
# already been deleted, delete it.
1136
1348
1137
print "Log: Deleting Plan record.\n";
1138
if (defined $pid and defined $pilotID{$pid} and not $pilotID{$_}->{deleted}) {
1139
print "Log: ... and associated Palm record.\n";
1349
msg( "Deleting Plan record.\n" ) if ($PREFS->{'Debug'} > 1);
1350
if (defined $pid and defined $pilotID{$pid} and not $pilotID{$_}->{'deleted'}) {
1351
msg( "... and associated Palm record.\n" ) if ($PREFS->{'Debug'} > 1);
1352
msg( "Deleting from Palm: " . PrintPilotRecord($pilotID{$pid}) ."\n" ) if ($PREFS->{'Debug'});
1140
1353
DeletePilotRecord($db, $pid);
1141
1354
#$db->deleteRecord($pid);
1142
1355
#delete $pilotID{$pid};
1153
1366
1154
1367
}
1155
1368
1369
############################################################
1370
#
1371
############################################################
1156
1372
sub loadpilotrecords {
1157
print "Loading pilot records:\n";
1373
msg( "Loading pilot records:\n" );
1158
1374
1159
print "Please start HotSync now.\n";
1160
$psocket = PDA::Pilot::openPort($port);
1161
if (!$psocket) {
1162
die "Unable to open port $port\n";
1163
}
1164
$dlp = PDA::Pilot::accept($psocket);
1165
1166
1375
if ($dlp->getStatus<0) {
1167
die "Cancelled.\n";
1376
croak "Cancelled.\n";
1168
1377
}
1169
1378
1170
$info = $dlp->getUserInfo;
1171
1172
$pilotname = $info->{name} . "_ " . $info->{userID};
1173
$pilotname =~ s/[^A-Za-z0-9]+/_/g;
1174
1175
print "Synchronizing pilot called '$pilotname'\n";
1379
msg( "Synchronizing pilot called '$pilotname'\n" ) if ($PREFS->{'Debug'} > 1);
1176
1380
1177
1381
if (not defined $control{$pilotname}) {
1178
print "Database access list for Palm has not been defined!\n\n";
1179
print "Palm '$pilotname' has been added to $controldir/control.\n";
1180
print "Please edit $controldir/control and add the names of the Plan databases\n";
1181
print "that this Palm should synchronize with.\n";
1382
msg( "Database access list for Palm has not been defined!\n\n" );
1383
msg( "Palm '$pilotname' has been added to $controldir/control.\n" );
1384
msg( "Please edit $controldir/control and add the names of the Plan databases\n" );
1385
msg( "that this Palm should synchronize with.\n" );
1182
1386
1183
1387
open (C, ">>$controldir/control");
1184
1388
print C "$pilotname\n";
1186
1390
return 0;
1187
1391
}
1188
1392
1189
1190
1393
$db = $dlp->open("DatebookDB");
1191
1394
1395
my ($r, $i);
1192
1396
$i=0;
1397
my $max = $db->getRecords();
1398
$max ||= 1;
1399
status("Reading Palm Appointments", 0);
1193
1400
while(defined($r = LoadPilotRecord($db,$i++))) {
1194
push @pilotRecord, $r;
1195
#print "Palm Record: ",Dumper($r),"\n";
1196
# $pilotID{$r->{id}} = $r;
1401
status("Reading Palm Appointments", int(100*$i/$max))
1402
if ($i % (int($max/20)+1) == 0);
1197
1403
}
1198
print "Done reading records\n";
1404
status("Reading Palm Appointments", 100);
1405
msg( "Done reading records\n" ) if ($PREFS->{'Debug'} > 1);
1199
1406
1200
1201
1407
$slowsync = 1;
1202
1408
1203
1409
if ($slowsync) {
1204
1410
foreach (keys %pilothash) {
1205
1411
if (not exists $pilotID{$_}) {
1206
$pilotID{$_}->{deleted} = 1;
1412
$pilotID{$_}->{'deleted'} = 1;
1207
1413
}
1208
1414
}
1209
1415
}
1210
1416
return 1;
1211
1417
}
1212
1418
1419
############################################################
1420
#
1421
############################################################
1213
1422
sub SendPlanCommand {
1214
my($socket,$text) = @_;
1423
my ($socket,$text) = @_;
1424
my ($len);
1215
1425
#print "Sending |$text|\n";
1216
1426
while (length($text)) {
1217
1427
$len = syswrite $socket, $text, length($text);
1219
1429
}
1220
1430
}
1221
1431
1222
my($partialReply) = "";
1432
my ($partialReply) = "";
1433
1434
############################################################
1435
#
1436
############################################################
1223
1437
sub ReadPlanReply {
1224
my($socket) = @_;
1225
my($reply) = "";
1438
my ($socket) = @_;
1439
my ($reply) = "";
1440
my ($buf);
1226
1441
1227
1442
while (1) {
1228
while ($partialReply =~ /^(.+?)(\\)?\n/m) {
1443
while ($partialReply =~ /\A(.*?)(\\)?\n/m) {
1229
1444
$reply .= $1."\n";
1230
1445
$partialReply = $';
1231
1446
if (not defined($2)) {
1235
1450
if ($reply =~ /\AR/) { # Discard
1236
1451
next;
1237
1452
} elsif ($reply =~ /\A\?/) { # Discard
1238
print "Plan message: $'";
1453
msg( "Plan message: $'" );
1239
1454
next;
1240
1455
} else {
1241
1456
#print "Reply: |$reply|\n";
1244
1459
$reply = "";
1245
1460
}
1246
1461
}
1247
while (sysread($socket,$partialReply,1024,length($partialReply))==1024 or /\\\Z/) {
1248
}
1462
do {
1463
sysread($socket,$buf,1024);
1464
$partialReply .= $buf;
1465
} while ($buf !~ /[^\\]\n|\A\n/);
1466
# ^^ the regexp matches if $buf contains an unescaped
1467
# newline, i.e. a newline that's either the first
1468
# character, or preceded by a non-escape character.
1249
1469
}
1250
1470
}
1251
1471
1252
1472
1473
############################################################
1474
#
1475
############################################################
1253
1476
sub SyncDB {
1254
my($db, $control) = @_;
1255
1256
$dbname = $control->{dbname};
1257
1258
#print "Opening database $control->{name}\@$control->{host}:$control->{port}.\n";
1259
1260
$socket = IO::Socket::INET->new(PeerPort => $control->{port}, PeerAddr => $control->{host}, Proto => 'tcp');
1477
my ($db, $control) = @_;
1478
1479
my $dbname = $control->{'dbname'};
1480
1481
#print "Opening database $control->{'name'}\@$control->{'host'}:$control->{'port'}.\n";
1482
1483
my $socket = IO::Socket::INET->new(PeerPort => $control->{'port'}, PeerAddr => $control->{'host'}, Proto => 'tcp');
1261
1484
1262
1485
if (not defined $socket) {
1263
die "Unable to open plan socket on $control->{host}:$control->{port}\n";
1486
croak "Unable to open plan socket on $control->{'host'}:$control->{'port'}\n";
1264
1487
}
1265
1488
1266
1489
$socket->autoflush(1);
1267
1490
1268
$select = IO::Select->new();
1269
1491
my $select = IO::Select->new();
1492
1270
1493
$select->add($socket);
1271
1494
1272
$reply=ReadPlanReply($socket);
1273
1495
my $reply=ReadPlanReply($socket);
1496
1274
1497
if ($reply !~ /^!/) {
1275
die "Unknown response from netplan: $reply\n";
1498
croak "Unknown response from netplan: $reply\n";
1276
1499
}
1277
1500
1278
1501
$netplanversion = $reply;
1279
1502
1280
# Authenticate
1281
SendPlanCommand($socket, "=plan<uid=$<,gid=$>,pid=$$>\n");
1503
# Authenticate
1504
SendPlanCommand($socket, "=sync-plan<uid=$<,gid=$>,pid=$$>\n");
1282
1505
1283
1506
SendPlanCommand($socket, "o$dbname\n");
1284
1507
$reply = ReadPlanReply($socket);
1285
1508
1286
1509
if ($reply !~ /^otw(\d+)/) {
1287
die "Failed to open database $control->{name}\@$control->{host}:$control->{port}.\n";
1510
croak "Failed to open database $control->{'name'}\@$control->{'host'}:$control->{'port'}.\n";
1288
1511
}
1289
1512
$file = $1;
1290
1513
1292
1515
$reply = ReadPlanReply($socket);
1293
1516
1294
1517
if ($reply !~ /^n\d+\s+(\d+)/) {
1295
die "Failed to get record count.\n";
1518
croak "Failed to get record count.\n";
1296
1519
}
1297
$records = $1;
1298
1299
1300
@id= ();
1520
my $records = $1;
1521
1522
1523
my @id= ();
1301
1524
1302
1525
SendPlanCommand($socket, "r$file 0\n");
1303
1526
while ($records) {
1309
1532
}
1310
1533
}
1311
1534
1535
my ($loop_count) = (0);
1312
1536
foreach (@id) {
1537
$dlp->tickle unless (++$loop_count % 50);
1313
1538
SendPlanCommand($socket, "l$file $_\n");
1314
1539
$reply = ReadPlanReply($socket);
1315
1540
1316
1541
if ($reply !~ /^lt/) {
1317
die "Failed to lock record $_.\n";
1542
croak "Failed to lock record $_.\n";
1318
1543
}
1319
1544
1320
1545
SendPlanCommand($socket, "r$file $_\n");
1321
1546
$reply = ReadPlanReply($socket);
1322
1547
1323
1548
if ($reply !~ /\Art\d+\s+(\d+)\s+/s) {
1324
die "Didn't get record I was looking for.\n";
1549
croak "Didn't get record I was looking for.\n";
1325
1550
}
1326
1551
1327
1552
dorecord($db, $socket, $control, $_, $');
1336
1561
$socket->close;
1337
1562
}
1338
1563
1339
1340
$controldir = (getpwuid($>))[7] . "/.sync-plan";
1341
1342
if (@ARGV<2) {
1343
die "Usage: $0 <pilot port> <control directory>\n\n<control directory> is where various information is stored. You might wish to use $controldir.\n";
1344
}
1345
1346
$port = $ARGV[0];
1347
$controldir = $ARGV[1];
1348
1349
$controldir =~ s/\/+$//;
1350
1351
if (! -d $controldir) {
1352
die "Directory $controldir does not exist. It must be created before $0 is run.\n\n";
1353
}
1354
1355
if (! -f "$controldir/control") {
1356
open(C, ">$controldir/control") || die "Unable to write to $controdir/control";
1564
############################################################
1565
#
1566
############################################################
1567
sub readControlfile
1568
{
1569
if (! -d $controldir) {
1570
croak "Directory $controldir does not exist. It must be created before $0 is run.\n\n";
1571
}
1572
1573
if (! -f "$controldir/control") {
1574
open(C, ">$controldir/control") || croak "Unable to write to $controldir/control";
1357
1575
print C "# this file is used to control which Palms are allowed to sync, and what databases\n";
1358
1576
print C "# each Palm will sync with. Each line consists of whitespace-separated fields, the\n";
1359
1577
print C "# first one being the name (and ID) of the Palm, and subsequent fields listing\n";
1367
1585
print C "# default) or read only access. If a database is read-only, any record changes\n";
1368
1586
print C "# on the Palm will be discarded. However, for technical reasons, you must have\n";
1369
1587
print C "# read/write access to the plan database itself.\n";
1370
}
1588
close(C);
1589
}
1371
1590
1372
open(C,"<$controldir/control");
1373
while(<C>) {
1591
open(C,"<$controldir/control");
1592
while (<C>) {
1374
1593
chomp;
1375
1594
next if /^#/;
1376
my($i,@i) = split(/\s+/, $_);
1377
my(@I);
1378
my($first)=1;
1379
my($defaultname);
1595
my ($i,@i) = split(/\s+/, $_);
1596
my (@I);
1597
my ($first) = 1;
1598
my ($defaultname);
1380
1599
foreach (@i) {
1381
my($mode, $name, $host) = m/^(?:(wr|ro|rw):)?([^\@]+)(?:\@(.+))?$/;
1382
if (not defined $mode) {
1383
$mode = "rw";
1384
}
1385
if (not defined $host) {
1386
$host = "localhost";
1387
}
1388
if ($mode !~ /^rw$/) {
1389
die "Access mode $mode (for Palm '$i') at line $. of $controldir/control unknown or unsupported.\n";
1390
}
1391
if ($first) {
1392
$defaultname = $name.'@'.$host;
1393
}
1394
push @I, {mode => $mode, name => $name.'@'.$host, dbname => $name, host => $host, port => 5444, read => ($mode =~ /r/), write => ($mode =~ /w/), default => $first, defaultname => $defaultname};
1395
$first = 0;
1600
my ($mode, $name, $host) = m/^(?:(wr|ro|rw):)?([^\@]+)(?:\@(.+))?$/;
1601
if (not defined $mode) {
1602
$mode = "rw";
1603
}
1604
if (not defined $host) {
1605
$host = "localhost";
1606
}
1607
if ($mode !~ /^rw$/) {
1608
croak "Access mode $mode (for Palm '$i') at line $. of $controldir/control unknown or unsupported.\n";
1609
}
1610
if ($first) {
1611
$defaultname = $name.'@'.$host;
1612
}
1613
push @I, {mode => $mode, name => $name.'@'.$host, dbname => $name, host => $host, port => $PREFS->{'NetplanPort'}, 'read' => ($mode =~ /r/), 'write' => ($mode =~ /w/), default => $first, defaultname => $defaultname};
1614
$first = 0;
1396
1615
}
1397
1616
$control{$i} = [@I];
1617
}
1618
close(C);
1398
1619
}
1399
1620
1400
if (loadpilotrecords) {
1401
1402
foreach (@{$control{$pilotname}}) {
1403
$sawName{$_->{name}} = 1;
1404
}
1405
1406
if (!@{$control{$pilotname}}) {
1407
print "No plan databases are registered for the '$pilotname' Palm. Please\n";
1408
print "edit $controldir/control and add one or more databases.\n";
1409
}
1410
1411
open (I, "<$controldir/ids.$pilotname");
1621
############################################################
1622
#
1623
############################################################
1624
sub conduitSync
1625
{
1626
$dlp = $_[1];
1627
$info = $_[2];
1628
1629
# initialize variables that may still be set from last sync (which
1630
# can happen when conduitSync is called from PilotManager).
1631
%control = ();
1632
%pilothash = ();
1633
%pilotID = ();
1634
%planID = ();
1635
%exceptID = ();
1636
%planRecord = ();
1637
%dbname = ();
1638
%sawName = ();
1639
$pilotname = $db = $slowsync = $file = $maxseed = $netplanversion = undef;
1640
1641
readControlfile;
1642
1643
$pilotname = $info->{'name'} . "_ " . $info->{'userID'};
1644
$pilotname =~ s/[^A-Za-z0-9]+/_/g;
1645
1646
foreach (@{$control{$pilotname}}) {
1647
$sawName{$_->{'name'}} = 1;
1648
}
1649
1650
if (open (I, "<$controldir/ids.$pilotname")) {
1412
1651
foreach (<I>) {
1413
chop;
1414
my($id, $hash, $except, $dbname) = split(/\s+/, $_);
1415
$pilothash{$id} = $hash;
1416
$exceptID{$id} = $except;
1417
if (not defined $dbname or not length $dbname) {
1418
$dbname = $control{$pilotname}->[0]->{name};
1419
}
1420
$dbname{$id} = $dbname if defined $dbname and length $dbname;
1421
#print Dumper({dbname=>$dbname{$id}});
1422
if (not defined $sawName{$dbname}) {
1423
print "Warning! The ID file, $controldir/ids.$pilotname, lists a record as belonging\n";
1424
print "to database $dbname, but the control file $controldir/control does not list this\n";
1425
print "this database. If you have renamed a database, please edit $controldir/ids.$pilotname\n";
1426
print "so all references to this database match the new name.\n";
1427
print "\nIf you wish to delete all on the Palm that were originally from $dbname, then\n";
1428
print "delete the database name from the end of each record's line.\n";
1429
print "To merge the records into the default database, delete each affected line entriely.\n";
1652
chop;
1653
my ($id, $hash, $except, $dbname) = split(/\s+/, $_);
1654
$pilothash{$id} = $hash;
1655
$exceptID{$id} = $except;
1656
if (not defined $dbname or not length $dbname) {
1657
$dbname = $control{$pilotname}->[0]->{'name'};
1658
}
1659
$dbname{$id} = $dbname if defined $dbname and length $dbname;
1660
#print Dumper({dbname=>$dbname{$id}});
1661
if (not defined $sawName{$dbname}) {
1662
msg( "Warning! The ID file, $controldir/ids.$pilotname, lists a record as belonging\n" );
1663
msg( "to database $dbname, but the control file $controldir/control does not list this\n" );
1664
msg( "this database. If you have renamed a database, please edit $controldir/ids.$pilotname\n" );
1665
msg( "so all references to this database match the new name.\n" );
1666
msg( "\nIf you wish to delete all on the Palm that were originally from $dbname, then\n" );
1667
msg( "delete the database name from the end of each record's line.\n" );
1668
msg( "To merge the records into the default database, delete each affected line entirely.\n" );
1430
1669
1431
$sawName{$dbname} = 1;
1432
}
1433
}
1434
1435
1436
foreach (keys %pilotID) {
1437
if (not defined $dbname{$_}) {
1438
$dbname{$_} = $control{$pilotname}->[0]->{name};
1439
}
1440
}
1441
1670
$sawName{$dbname} = 1;
1671
}
1672
}
1673
1442
1674
close (I);
1443
1444
1675
}
1676
1677
1678
if (loadpilotrecords) {
1679
1680
if (!@{$control{$pilotname}}) {
1681
msg( "No plan databases are registered for the '$pilotname' Palm. Please\n" );
1682
msg( "edit $controldir/control and add one or more databases.\n" );
1683
}
1684
1685
foreach (keys %pilotID) {
1686
if (not defined $dbname{$_}) {
1687
$dbname{$_} = $control{$pilotname}->[0]->{'name'};
1688
}
1689
}
1690
1445
1691
foreach (@{$control{$pilotname}}) {
1446
next if not defined $_->{host}; # Sigh. Autoviv problem.
1447
SyncDB($db, $_);
1692
next if not defined $_->{'host'}; # Sigh. Autoviv problem.
1693
SyncDB($db, $_);
1448
1694
}
1449
1695
1450
1696
# Delete deleted & archived records
1457
1703
1458
1704
open (I, ">$controldir/ids.$pilotname");
1459
1705
foreach (keys %pilothash) {
1460
if ($dbname{$_} eq $control{$pilotname}->[0]{name}) {
1461
$dbname{$_}="";
1462
}
1463
$exceptID{$_} += 0;
1464
print I "$_ $pilothash{$_} $exceptID{$_} $dbname{$_}\n";
1706
if ($dbname{$_} eq $control{$pilotname}->[0]{'name'}) {
1707
$dbname{$_}="";
1708
}
1709
$exceptID{$_} = 0 unless (defined $exceptID{$_});
1710
print I "$_ $pilothash{$_} $exceptID{$_} $dbname{$_}\n";
1465
1711
}
1466
1712
close(I);
1467
1713
1468
$dlp->close;
1469
1470
}
1471
1472
1473
close(C);
1714
1715
}
1716
}
1717
1718
############################################################
1719
# main
1720
############################################################
1721
1722
my ($tempdlp, $tempinfo);
1723
1724
if (@ARGV<2) {
1725
croak "Usage: $0 <pilot port> <control directory>\n\n<control directory> is where various information is stored.\nYou might wish to use " .
1726
(getpwuid($>))[7] . "/.sync-plan\n";
1727
}
1728
1729
$port = $ARGV[0];
1730
$controldir = $ARGV[1];
1731
1732
$controldir =~ s/\/+$//;
1733
1734
msg "Please start HotSync now.\n";
1735
my $psocket = PDA::Pilot::openPort($port);
1736
1737
if (!$psocket) {
1738
croak "Unable to open port $port\n";
1739
}
1740
($tempdlp = PDA::Pilot::accept($psocket)) || croak "Can't connect to Palm";
1741
1742
($tempinfo = $tempdlp->getUserInfo) || croak "Lost connection to Palm";
1743
1744
conduitSync(undef, $tempdlp, $tempinfo);
1745
1746
$dlp->close();
1747
PDA::Pilot::close($psocket);
Loggerhead is a web-based interface for Breezy
Version: 2.0.1