1# -*- perl -*- 2 3# 4# Author: Slaven Rezic 5# 6# Copyright (C) 2000, 2006, 2008, 2009, 2012 Slaven Rezic. All rights reserved. 7# This package is free software; you can redistribute it and/or 8# modify it under the same terms as Perl itself. 9# 10# Mail: slaven@rezic.de 11# WWW: http://bbbike.sourceforge.net/ 12# 13 14package BBBikeAlarm; 15 16use FindBin; 17use vars qw($VERSION 18 $can_leave $can_at $can_tk $can_palm $can_ical 19 $can_bluetooth 20 $alarms_file 21 @baddr 22 ); 23use strict; 24use lib "$FindBin::RealBin/lib"; 25 26BEGIN { 27 if (!eval ' 28use Msg qw(frommain); 291; 30') { 31 #warn $@ if $@; 32 eval 'sub M ($) { $_[0] }'; 33 eval 'sub Mfmt { sprintf(shift, @_) }'; 34 } 35} 36 37# XXX 38my $install_datebook_additions = 1; 39 40use File::Basename qw(basename); 41use Time::Local; 42 43$VERSION = sprintf("%d.%02d", q$Revision: 1.43 $ =~ /(\d+)\.(\d+)/); 44 45# XXX S25 Termin (???) 46# XXX Terminal-Alarm unter Windows? Linux? 47# XXX Leave funktioniert nur f�r max. 12 Stunden (testen!) 48 49sub my_die ($) { 50 my $msg = shift; 51 if (defined &main::status_message) { 52 main::status_message($msg, "die"); 53 } else { 54 require Carp; 55 Carp::croak($msg); 56 } 57} 58 59sub enter_alarm { 60 my($top, $time_ref, %args) = @_; 61 my $time = $$time_ref; 62 if ($time =~ /(\d+):(\d+)/) { 63 my($h,$m) = ($1,$2); 64 my $t = $top->Toplevel(-title => "Alarm"); 65 $t->transient($top) if $main::transient; 66 my $do_close = 0; 67 68 # XXX Tk::Date verwenden? 69 my $ankunft; 70 my $ankunft_epoch; 71 my $abfahrt_epoch; 72 my $pre_alarm_seconds; 73 my $end_zeit_epoch; 74 my $vorbereitung = "00:10"; # XXX BBBike-Option 75 my $vorbereitung_s; 76 my $text = ""; 77 $text = main::get_route_description() 78 if defined &main::get_route_description; 79 80 $t->Label(-text => M("Ankunft").":")->grid(-row => 0, -column => 0, 81 -sticky => "e"); 82 my $sunset_choice; 83 my $om; 84 my $e = $t->Entry(-textvariable => \$ankunft, 85 -width => 6, 86 )->grid(-row => 0, -column => 1, 87 -sticky => "w"); 88 $e->focus; 89 if (defined $args{-location} && eval { require Astro::Sunrise; Astro::Sunrise->VERSION(0.85); 1 }) { 90 my($px,$py) = (ref $args{-location} eq 'ARRAY' 91 ? @{ $args{-location} } 92 : split /,/, $args{-location} 93 ); 94 my $get_sun_set = sub { 95 my $alt = shift; 96 Astro::Sunrise::sun_set($px,$py, $alt); 97 }; 98 my $sunset_real = $get_sun_set->(); 99 my $sunset_civil = $get_sun_set->(-6); 100 $om = $t->Optionmenu 101 (-variable => \$sunset_choice, 102 -options => [["" => ""], 103 ["Sonnenuntergang" => $sunset_real], 104 ["Ende der b�rgerl. D�mmerung" => $sunset_civil], 105 ], 106 -command => sub { 107 $ankunft = $sunset_choice 108 if $sunset_choice ne ""; 109 }, 110 )->grid(-row => 0, -column => 2); 111 } 112 113 $t->Label(-text => M("Abfahrt").":")->grid(-row => 1, -column => 0, 114 -sticky => "e"); 115 my $ab_l = $t->Label->grid(-row => 1, -column => 1, 116 -sticky => "w"); 117 118 $t->Label(-text => M("Vorbereitung").":")->grid(-row => 2, -column => 0, 119 -sticky => "e"); 120 my $vb_e = $t->Entry(-textvariable => \$vorbereitung, 121 -width => 6, 122 )->grid(-row => 2, -column => 1, 123 -sticky => "w"); 124 125 $t->Label(-text => M("Alarmtext").":")->grid(-row => 3, -column => 0, 126 -sticky => "e"); 127 $t->Entry(-textvariable => \$text, 128 )->grid(-row => 3, -column => 1, -sticky => "w"); 129 130 my $get_end_zeit = sub { 131 my $check_errors = shift; 132 return undef if !defined $ankunft || $ankunft eq ""; 133 if (!defined $vorbereitung || $vorbereitung eq "") { 134 $vorbereitung = "00:00"; 135 } 136 137 my($h_a, $m_a) = $ankunft =~ /(\d{1,2})[:.](\d{2})/; 138 if (!defined $h_a || !defined $m_a) { 139 if ($check_errors) { 140 $top->messageBox(-message => "Wrong time format (ankunft)", 141 -icon => "error", 142 -type => "OK"); 143 } 144 return undef; 145 } 146 147 my($h_vb, $m_vb) = $vorbereitung =~ /(\d{1,2})[:.](\d{2})/; 148 $vorbereitung_s = 0; 149 if (defined $h_vb && defined $m_vb) { 150 $vorbereitung_s = $h_vb*60*60 + $m_vb*60; 151 } 152 153 my @l = localtime; 154 $l[1] = $m_a; 155 $l[2] = $h_a; 156 $ankunft_epoch = timelocal(@l); 157 if ($ankunft_epoch <= time) { 158 # adjust to next day 159 $ankunft_epoch+=86400; # XXX Sommerzeit 160 } 161 162 my $fahrzeit = $h*60*60 + $m*60; 163 $pre_alarm_seconds = $fahrzeit + $vorbereitung_s; 164 $abfahrt_epoch = $ankunft_epoch - $fahrzeit; 165 $end_zeit_epoch = $ankunft_epoch - $pre_alarm_seconds; 166 # XXX Abzug vorbereitung? 167 @l = localtime $end_zeit_epoch; 168 my $end_zeit = sprintf("%02d%02d", $l[2], $l[1]); 169 170 my $diff = $end_zeit_epoch - time; 171 my $diff_text = sprintf "(in %d:%02d h)", $diff/3600, ($diff%3600)/60; 172 173 $ab_l->configure(-text => sprintf("%02d:%02d $diff_text", $l[2], $l[1])); 174 return $end_zeit; 175 }; 176 177 if ($Tk::VERSION > 800.016) { # XXX ca. for -validation 178 foreach my $w ($e, $vb_e) { 179 $w->configure 180 (-vcmd => 181 sub { 182 my $adjust_subset_choice; $adjust_subset_choice = 1 183 if ($_[4] == 0 || $_[4] == 1) && $w eq $e; # INSERT or DELETE 184 $w->after(10, sub { 185 $get_end_zeit->(0); 186 if ($adjust_subset_choice) { 187 $sunset_choice = ""; 188 $om->setOption("","") 189 if $om; 190 } 191 }); 192 1; 193 }, 194 -validate => "all"); 195 } 196 } 197 198 my $row = 4; 199 200 capabilities(); 201 202 my($use_tk, $use_leave, $use_palm, $use_at, $use_ical, 203 $use_bluetooth); 204 if ($can_tk) { 205 $use_tk = 1; 206 } elsif ($can_leave) { 207 $use_leave = 1; 208 } elsif ($can_at) { 209 $use_at = 1; 210 } elsif ($can_palm) { 211 $use_palm = 1; 212 } elsif ($can_ical) { 213 $use_ical = 1; 214 } elsif ($can_bluetooth) { 215 $use_bluetooth = 1; 216 } 217 218 if ($can_tk) { 219 $t->Checkbutton(-text => "Tk", 220 -variable => \$use_tk)->grid(-row => $row++, 221 -column => 0, 222 -columnspan => 2, 223 -sticky => "w"); 224 } else { 225 $use_tk = 0; 226 } 227 228 if ($can_leave) { 229 $t->Checkbutton(-text => "Console (leave)", 230 -variable => \$use_leave)->grid(-row => $row++, 231 -column => 0, 232 -columnspan => 2, 233 -sticky => "w"); 234 } else { 235 $use_leave = 0; 236 } 237 238 if ($can_at) { 239 $t->Checkbutton(-text => "Console (at)", 240 -variable => \$use_at)->grid(-row => $row++, 241 -column => 0, 242 -columnspan => 2, 243 -sticky => "w"); 244 } else { 245 $use_at = 0; 246 } 247 248 if ($can_palm) { 249 $t->Checkbutton(-text => "Palm", 250 -variable => \$use_palm)->grid(-row => $row++, 251 -column => 0, 252 -columnspan => 2, 253 -sticky => "w"); 254 } else { 255 $use_palm = 0; 256 } 257 258 if ($can_bluetooth) { 259 $t->Checkbutton(-text => "VCal via Bluetooth", 260 -variable => \$use_bluetooth)->grid(-row => $row++, 261 -column => 0, 262 -columnspan => 2, 263 -sticky => "w"); 264 } else { 265 $use_bluetooth = 0; 266 } 267 268 if ($can_ical) { 269 $t->Checkbutton(-text => "ical", 270 -variable => \$use_ical)->grid(-row => $row++, 271 -column => 0, 272 -columnspan => 2, 273 -sticky => "w"); 274 } else { 275 $use_ical = 0; 276 } 277 278 { 279 $t->Button(-padx => 1, -pady => 1, 280 -text => "emacs org-mode date", 281 -command => sub { 282 $get_end_zeit->(); 283 emacs_org_mode_date(-toplevel => $t, 284 -text => $text, 285 -dtstart => $ankunft_epoch, 286 -alarmdelta => $pre_alarm_seconds, 287 ); 288 }, 289 )->grid(-row => $row++, -column => 0, -columnspan => 2, 290 -sticky => 'w'); 291 } 292 293 my $f = $t->Frame->grid(-row => $row++, -column => 0, 294 -columnspan => 2, -sticky => "ew"); 295 $f->Button(-text => M"Alarm setzen", 296 -command => sub { 297 my $end_zeit = $get_end_zeit->(1); 298 if (!defined $end_zeit) { 299 $t->messageBox(-message => "Die Ankunftszeit ist nicht definiert.", 300 -icon => "error", 301 -type => "OK", 302 ); 303 return; 304 } 305 306 tk_leave($end_zeit, -text => $text) 307 if $use_tk; 308 grabbing_leave($end_zeit, -text => $text) 309 if $use_leave; 310 grabbing_at($end_zeit, -text => $text) 311 if $use_at; 312 palm_leave($ankunft_epoch, $pre_alarm_seconds, 313 -text => $text) 314 if $use_palm; 315 bluetooth_leave($top, $abfahrt_epoch, $ankunft_epoch, $vorbereitung_s) 316 if $use_bluetooth; 317 add_ical_entry($abfahrt_epoch, $text, -prealarm => $vorbereitung_s) 318 if $use_ical; 319 $do_close = 1; 320 $t->destroy; 321 })->pack(-side => "left", -fill => "x", -expand => 1); 322 $f->Button(Name => "close", 323 -text => M"Schlie�en", 324 -command => sub { 325 $do_close = 1; 326 $t->destroy; 327 })->pack(-side => "left", -fill => "x", -expand => 1); 328 329 if ($args{-dialog}) { 330 $t->waitVariable(\$do_close); 331 } 332 } 333} 334 335sub enter_alarm_small_dialog { 336 my($top, %args) = @_; 337 my $t = $top->Toplevel(-title => "Alarm"); 338 $t->transient($top) if $main::transient; 339 my $row = 0; 340 my $time; 341 my $text = "Leave"; 342 $t->Label(-text => "Time (HH:MM)")->grid(-column => 0, -row => $row, 343 -sticky => "w"); 344 my @e; 345 push @e, $t->Entry(-textvariable => \$time, 346 -width => 6, 347 )->grid(-row => $row, -column => 1, 348 -sticky => "we"); 349 $e[0]->focus; 350 $row++; 351 352 if ($args{-withtext}) { 353 $t->Label(-text => "Alarm text")->grid(-column => 0, -row => $row, 354 -sticky => "w"); 355 push @e, $t->Entry(-textvariable => \$text, 356 -width => 20, 357 )->grid(-row => $row, -column => 1, 358 -sticky => "we"); 359 $row++; 360 } 361 362 my $weiter; 363 my $bf = $t->Frame->grid(-row => $row, -column => 0, -columnspan => 2); 364 my $okb = 365 $bf->Button(-text => "OK", 366 -command => sub { 367 my($h_a, $m_a); 368 if (my($delta_h, $delta_m) = $time =~ /(?:^|\s)\+(\d{1,2})[:.]?(\d{2})(?:$|\s)/) { 369 my @l = localtime; 370 $m_a = $l[1] + $delta_m; 371 if ($m_a >= 60) { 372 $m_a %= 60; 373 $delta_h++; 374 } 375 $h_a = $l[2] + $delta_h; 376 if ($h_a >= 24) { 377 $h_a %= 24; 378 # overflows are hopefully handled by tk_leave 379 } 380 } else { 381 ($h_a, $m_a) = $time =~ /(?:^|\s)(\d{1,2})[:.]?(\d{2})(?:$|\s)/; 382 } 383 if (!defined $h_a || !defined $m_a) { 384 $top->messageBox(-message => "Wrong time format, should be HH:MM or +HH:MM", 385 -icon => "error", 386 -type => "OK"); 387 $e[0]->focus; 388 return undef; 389 } 390 tk_leave(sprintf("%02d%02d", $h_a, $m_a), 391 -text => $text); 392 $weiter = 1; 393 })->grid(-row => 0, -column => 0); 394 for my $e_i (0 .. $#e-1) { 395 $e[$e_i]->bind("<Return>" => [ sub { my $i = $_[1]; $e[$i]->focus }, $e_i+1]); 396 } 397 $e[-1]->bind("<Return>" => sub { $okb->invoke }); 398 my $cb = $bf->Button(-text => "Cancel", 399 -command => sub { 400 $weiter = 1; 401 })->grid(-row => 0, -column => 1); 402 $t->bind("<Escape>" => sub { $cb->invoke }); 403 $t->Popup(-popover => "cursor"); 404 $t->OnDestroy(sub { $weiter = 1 }); 405 $t->waitVariable(\$weiter); 406 $t->destroy if Tk::Exists($t); 407} 408 409sub get_all_terms { 410 my @tty; 411 my $who_am_i = (getpwuid($<))[0]; 412 open(WHO, "who|"); 413 while(<WHO>) { 414 chomp; 415 my($user, $tty) = split /\s+/; 416 if ($user eq $who_am_i) { 417 push @tty, "/dev/$tty"; # XXX use _PATH_DEV 418 } 419 } 420 close WHO; 421 @tty; 422} 423 424sub grabbing_leave { 425 my($time, %args) = @_; 426 # -text is ignored in leave 427 my @tty = get_all_terms(); 428 if (!@tty) { 429 my_die "No tty found for current user!"; 430 } 431 system("leave $time | tee @tty &"); 432} 433 434sub grabbing_at { 435 my($time, %args) = @_; 436 # -text is ignored in leave 437 my $text = $args{-text} || "Alarm!"; 438 $time = substr($time,0,2) . ":" . substr($time,2,2); 439 my @tty = get_all_terms(); 440 if (!@tty) { 441 my_die "No tty found for current user!"; 442 } 443 system(qq{echo 'echo "$time: $text" | tee @tty' | at $time}); 444} 445 446sub tk_leave { 447 my($time, %args) = @_; 448 my $end_time = $args{-epoch} || end_time($time); 449 my $text = $args{-text}; 450 $text = "Leave" if !defined $text || $text eq ""; 451 bg_system($^X, "$FindBin::RealBin/BBBikeAlarm.pm", "-tk", "-time", $end_time, "-text", $text, "-encoding", "utf-8"); 452} 453 454sub palm_leave { 455 return unless $main::devel_host; 456 my($ankunft_epoch, $pre_alarm_seconds, %args) = @_; 457 my $tmpdir = $main::tmpdir; 458 $tmpdir = "/tmp" if !defined $tmpdir || !-d $tmpdir; 459 my $leave_file = "$tmpdir/BBBikeAlarm.txt"; 460 461 my(@begin) = localtime $ankunft_epoch; 462 my(@end) = localtime $ankunft_epoch + 60*60; # 1 hour default length 463 my $alarm_min = $pre_alarm_seconds/60; 464 465 my $now = time; 466 my $gm_offset = $now - timelocal(gmtime $now); 467 my $gm_offset_h = int($gm_offset/3600); 468 if ($gm_offset_h >= 0) { 469 $gm_offset_h = "+" . $gm_offset_h; 470 } 471 my $gm_offset_m = ($gm_offset/60)%60; 472 $gm_offset_m = sprintf "%02d", $gm_offset_m; 473 474 my $time_format = "%04d/%02d/%02d %02d:%02d:%02d GMT" . $gm_offset_h . $gm_offset_m; 475 476 $begin[4]++; 477 $begin[5]+=1900; 478 my $begin = sprintf($time_format, @begin[5,4,3,2,1,0]); 479 480 $end[4]++; 481 $end[5]+=1900; 482 my $end = sprintf($time_format, @end[5,4,3,2,1,0]); 483 484 my $text = "BBBike datebook entry"; 485 $text = $args{-text} if $args{-text} ne ""; 486 open(F, ">$leave_file") or my_die "Can't write to $leave_file: $!"; 487 print F "$begin\t$end\t" . $alarm_min . "m\t$text"; 488 if ($install_datebook_additions && defined &main::get_act_search_route) { 489 print F "\t"; 490 print F join(" - ", map { 491 $_->[0] . {"l" => " - links", 492 "r" => " - rechts" , 493 "" => ""}->{$_->[3]} 494 } @{ main::get_act_search_route() }); 495 } 496 print F "\n"; 497 close F 498 or my_die "While closing $leave_file: $!"; 499 500 # pilot-xfer 0.9.3's install-datebook is buggy!!!! 501 # use fixed executable XXX 502 503 require BBBikePalm; 504 if (-x "/usr/local/src/pilot-link.0.9.3/install-datebook") { 505 # XXX kill old processes... 506 system("killall", "install-datebook"); 507 system("/usr/local/src/pilot-link.0.9.3/install-datebook $ENV{PILOTPORT} $leave_file &"); 508 # system("install-datebook", $ENV{PILOTPORT}, $leave_file);#& 509 BBBikePalm::hot_sync_message($main::top); 510 } else { 511 warn "Sorry, no patched install-datebook on your system..."; 512 } 513 unlink $leave_file; 514} 515 516sub bluetooth_leave { 517 return unless $main::devel_host; # XXX vorerst, geht nur unter FreeBSD 518 my($top, $abfahrt_epoch, $ankunft_epoch, $vorbereitung_s, %args) = @_; 519 select_baddr_and_send 520 ($top, 521 sub { 522 my($baddr) = @_; 523 524 my $vcal_entry = create_vcalendar_entry($abfahrt_epoch, $ankunft_epoch, $vorbereitung_s); 525 require File::Temp; 526 my($fh,$file) = File::Temp::tempfile(UNLINK => 1, SUFFIX => ".vcs"); 527 print $fh $vcal_entry; 528 close $fh; 529 530 my $status; 531 my @cmd; 532 if (is_in_path("obexapp")) { 533 # 9 should not be hardcoded 534 @cmd = ("obexapp", "-C", 9, "-c", "-a", $baddr, "-n", "put", $file); 535 system @cmd; 536 $status = $?; 537 } elsif (is_in_path("ussp-push")) { 538 # 9 should not be hardcoded 539 @cmd = ("ussp-push", $baddr . '@' . 9, $file, basename($file)); 540 system @cmd; 541 $status = $?; 542 } else { 543 my_die "Neither obexapp nor ussp-push are available"; 544 } 545 546 unlink $file; 547 if ($status != 0) { 548 my_die "Obex command <@cmd> failed with $status"; 549 } 550 }, 551 ); 552} 553 554sub select_baddr_and_send { 555 my($top, $ok_cb) = @_; 556 my $t = $top->Toplevel(-title => "Bluetooth devices"); 557 my $lb = $t->Scrolled("Listbox", -selectmode => "single")->pack(-fill => "both"); 558 load_baddr_cache(); 559 fill_baddr_lb($lb); 560 { 561 my $f = $t->Frame->pack(-fill => "x"); 562 $f->Button(-text => "Inquiry", 563 -command => sub { 564 $t->Busy(-recurse => 1, 565 sub { 566 bluetooth_inquiry(); 567 }); 568 fill_baddr_lb($lb); 569 })->pack(-side => "left"); 570 $f->Button(-text => "Send VCAL", 571 -command => sub { 572 my(@inx) = $lb->curselection; 573 $t->destroy; 574 if (@inx) { 575 my $baddr_entry = $baddr[$inx[0]]; 576 my $baddr = $baddr_entry->{baddr}; 577 for my $i (0 .. $#baddr) { 578 if ($i == $inx[0]) { 579 $baddr[$i]->{sel} = '+'; 580 } else { 581 $baddr[$i]->{sel} = '-'; 582 } 583 } 584 $top->Busy(-recurse => 1, 585 sub { 586 $ok_cb->($baddr); 587 }); 588 } else { 589 $t->messageBox(-message => "Please select a device"); 590 } 591 })->pack(-side => "left"); 592 $f->Button(-text => "Cancel", 593 -command => sub { 594 $t->destroy; 595 })->pack(-side => "left"); 596 } 597} 598 599sub bluetooth_inquiry { 600 if (is_in_path("hccontrol")) { 601 @baddr = bluetooth_inquiry_hccontrol(); 602 } elsif (is_in_path("hcitool")) { 603 @baddr = bluetooth_inquiry_hcitool(); 604 } else { 605 my_die "Either hccontrol (BSD) or hcitool (Linux) is necessary for bluetooth inquiry"; 606 } 607 save_baddr_cache(); 608} 609 610sub bluetooth_inquiry_hccontrol { 611 my $cmd = "hccontrol inquiry"; 612 my(@result) = `$cmd`; 613 my_die "$cmd failed with $?" if $? != 0; 614 my @_baddr; 615 for (@result) { 616 if (/^\s+BD_ADDR:\s+([0-9a-f:]+)/i) { 617 push @_baddr, $1; 618 } 619 } 620 621 my @__baddr; 622 for my $baddr (@_baddr) { 623 my $cmd = "hccontrol Remote_Name_Request $baddr"; 624 my(@result) = `$cmd`; 625 my_die "$cmd failed with $?" if $? != 0; 626 for (@result) { 627 if (/^Name:\s+(.*)/) { 628 my $name = $1; 629 push @__baddr, {name => $name, 630 sel => '-', 631 baddr => $baddr, 632 }; 633 } 634 } 635 } 636 637 @__baddr; 638} 639 640sub bluetooth_inquiry_hcitool { 641 my $cmd = "hcitool scan 2>&1"; 642 my(@result) = `$cmd`; 643 my_die "$cmd failed with $?" if $? != 0; 644 my @_baddr; 645 for (@result) { 646 if (/^\s+([0-9a-f:]+)\s+(.*)/i) { 647 my $name = $2; 648 my $baddr = $1; 649 push @_baddr, { name => $name, 650 sel => '-', 651 baddr => $baddr, 652 }; 653 } 654 } 655 656 @_baddr; 657} 658 659sub fill_baddr_lb { 660 my($lb) = @_; 661 my $sel_done = 0; 662 $lb->delete(0,"end"); 663 for my $baddr (@baddr) { 664 my($sel, $baddr, $name) = @{$baddr}{qw(sel baddr name)}; 665 $lb->insert("end", sprintf "%-20s (%s)", $name, $baddr); 666 if (!$sel_done && $sel eq '+') { 667 $lb->selectionClear; 668 $lb->selectionSet("end"); 669 $sel_done = 1; 670 } 671 } 672} 673 674sub get_baddr_cache_file { 675 $main::bbbike_configdir = $main::bbbike_configdir if 0; 676 my $dir = $main::bbbike_configdir; 677 if (!$dir || !-d $dir || !-w $dir) { 678 $dir = "/tmp"; 679 } 680 $dir . "/baddr_cache"; 681} 682 683sub load_baddr_cache { 684 my $f = get_baddr_cache_file(); 685 @baddr = (); 686 if (open BADDR, $f) { 687 while(<BADDR>) { 688 chomp; 689 my($sel) = $_ =~ m{^(.)}; 690 s{^.}{}; 691 my($baddr, $name) = split /\s+/, $_, 2; 692 push @baddr, {sel => $sel, 693 baddr => $baddr, 694 name => $name, 695 }; 696 } 697 close BADDR; 698 } 699 @baddr; 700} 701 702sub save_baddr_cache { 703 my $f = get_baddr_cache_file(); 704 open BADDR, "> $f" 705 or my_die "Can't write to $f: $!"; 706 for my $baddr (@baddr) { 707 my($sel, $baddr, $name) = @{$baddr}{qw(sel baddr name)}; 708 $sel = '-' if !$sel; 709 print BADDR "$sel$baddr $name\n" 710 } 711 close BADDR 712 or my_die "While closing $f: $!"; 713} 714 715sub create_vcalendar_entry { 716 my($begintime, $endtime, $vorbereitung_s, $subject, $descr, $cat) = @_; 717 718 require POSIX; 719 my $dtstart = POSIX::strftime("%Y%m%dT%H%M%S", localtime $begintime); 720 my $dtend = POSIX::strftime("%Y%m%dT%H%M%S", localtime $endtime); 721 my $alarm = POSIX::strftime("%Y%m%dT%H%M%S", localtime ($begintime-$vorbereitung_s)); 722 723 my @search_route; 724 725 if (!defined $subject) { 726 $subject = "Fahrradfahrt (BBBike)"; 727 if (defined &main::get_act_search_route) { 728 @search_route = @{ main::get_act_search_route() }; 729 if (@search_route) { 730 $subject = $search_route[-1][StrassenNetz::ROUTE_NAME()] . " (Fahrradfahrt)"; 731 } 732 } 733 } 734 735 if (!defined $descr && @search_route) { 736 require BBBikeUtil; 737 require Strassen::Strasse; 738 $descr = join("\n", map { 739 my $hop = Strasse::strip_bezirk($_->[StrassenNetz::ROUTE_NAME()]); 740 $hop .= " [" . BBBikeUtil::m2km($_->[StrassenNetz::ROUTE_DIST()]); 741 if (defined $_->[StrassenNetz::ROUTE_ANGLE()] && $_->[StrassenNetz::ROUTE_ANGLE()] >= 30) { 742 $hop .= ", " . uc($_->[StrassenNetz::ROUTE_DIR()]); 743 } 744 $hop .= "]"; 745 } @search_route); 746 } 747 748 #my $cat = "MISCELLANEOUS"; 749 $cat = "MEETING" if !defined $cat; 750 751 my $this_host = _get_host(); 752 my $uid = POSIX::strftime("%Y%m%d%H%M%S-$this_host", localtime); 753 754 #(my $descr_escaped = $descr) =~ s{\n}{\\N}g; # XXX Does not work with my N95, neither with \n nor with \N 755 (my $descr_escaped = $descr) =~ s{\n}{ - }g; 756 <<EOF; 757BEGIN:VCALENDAR 758VERSION:1.0 759BEGIN:VEVENT 760UID:$uid 761CATEGORIES:$cat 762DALARM:$alarm 763DTSTART:$dtstart 764DTEND:$dtend 765SUMMARY:$subject 766DESCRIPTION:$descr_escaped 767END:VEVENT 768END:VCALENDAR 769EOF 770} 771 772#XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX not yet ready 773sub add_palm_datebook_entry { 774 require BBBikePalm; 775 #use Palm::PDB; 776 #use Palm::Datebook; 777 #require Palm::StdAppInfo; 778 my $pdb = new Palm::PDB; 779 $pdb->Load("/home/e/eserte/private/palm/bak/DatebookDB.pdb"); 780 use Data::Dumper; print STDERR "Line " . __LINE__ . ", File: " . __FILE__ . "\n" . Data::Dumper->Dumpxs([$pdb],[]); # XXX 781 782 $pdb->Write("/tmp/DB.pdb"); 783} 784 785sub add_ical_entry { 786 my($abfahrt_epoch, $text, %args) = @_; 787 my $file = $args{-file}; 788 if (!defined $file) { 789 $file = "$ENV{HOME}/.calendar.ical.bbbikealarm"; # XXX dos file name? 790 } 791 my @pre_alarm_minutes = (0); 792 if (exists $args{-prealarm}) { 793 push @pre_alarm_minutes, int($args{-prealarm}/60); 794 } else { 795 push @pre_alarm_minutes, 10; 796 } 797 my $pre_alarm = join(" ", @pre_alarm_minutes); 798 799 my @l = localtime($abfahrt_epoch); 800 my $start = $l[1]+$l[2]*60; 801 my $length = 30; # XXX make changeable 802 my($day,$month,$year) = ($l[3], $l[4]+1, $l[5]+1900); 803 my $owner = eval { ((getpwuid($<))[0]) } || "unknown"; 804 # XXX escape text 805 # XXX rewrite to use locking etc. 806 my $ical_data = ""; 807 my $uid = 0; 808 if (open(F, $file)) { 809 if ($] >= 5.008) { 810 eval q{binmode F, ':utf8';}; 811 my_die $@ if $@; 812 } 813 while(<F>) { 814 $ical_data .= $_; 815 if (/Uid\s+\[bbbikealarm_(\d+)\]/i) { 816 my $new_uid = $1; 817 if ($new_uid > $uid) { 818 $uid = $new_uid; 819 } 820 } 821 } 822 close F; 823 } else { 824 $ical_data = "Calendar [v2.0]\n"; 825 } 826 $uid++; 827 $ical_data .= <<EOF; 828Appt [ 829Start [$start] 830Length [$length] 831Alarms [$pre_alarm] 832Uid [bbbikealarm_$uid] 833Owner [$owner] 834Contents [$text] 835Remind [1] 836Hilite [always] 837Dates [Single $day/$month/$year End 838] 839] 840EOF 841 open(F, ">$file") or my_die "Can't write to $file: $!"; 842 if ($] >= 5.008) { 843 eval q{binmode F, ':utf8';}; 844 my_die $@ if $@; 845 } 846 print F $ical_data 847 or my_die "Can't print to $file: $!"; 848 close F 849 or my_die "While closing $file: $!"; 850} 851 852sub emacs_org_mode_date { 853 my(%args) = @_; 854 my $toplevel = delete $args{-toplevel}; 855 my $text = delete $args{-text}; 856 my $dtstart_epoch = delete $args{-dtstart}; 857 my $alarm_delta = delete $args{-alarmdelta}; 858 die "Unhandled arguments: " . join(" ", %args) if %args; 859 my $t = $toplevel->Toplevel(-title => "Emacs org-mode date"); 860 $t->transient($toplevel) if $main::transient; 861 my $txt = $t->Scrolled("ROText", 862 -scrollbars => 'osoe', 863 -height => 2, 864 -width => 60, 865 )->pack(qw(-fill both -expand 1)); 866 # XXX Taken from ical2org 867 my $alarm_delta_spec; 868 if ($alarm_delta % 3600 == 0) { 869 $alarm_delta_spec = ($alarm_delta/3600).'h'; 870 } elsif ($alarm_delta % 60 == 0) { 871 $alarm_delta_spec .= ($alarm_delta/60).'min'; 872 } else { 873 $alarm_delta_spec .= $alarm_delta.'s'; 874 } 875 876 require POSIX; 877 my $org_date = POSIX::strftime("%Y-%m-%d %a %H:%M", localtime $dtstart_epoch) . " -" . $alarm_delta_spec; 878 $txt->insert("end", "** $text <$org_date>"); 879 $txt->selectAll; 880 $t->Button(Name => "close", 881 -text => M"Schlie�en", 882 -command => sub { 883 $t->destroy; 884 })->pack(-side => "right", -fill => "x"); 885} 886 887# called from outer world 888sub tk_interface { 889 my($end_time, $text, %args) = @_; 890 $text = "Leave" if $text eq ""; 891 require Tk; 892##XXX balloon geht nicht... 893# require Tk::Balloon; 894 my $top = MainWindow->new; 895# my $balloon = $top->Balloon; 896 $top->title($text); 897 898 $Tk::platform = $Tk::platform; # peacify -w 899 if ($Tk::platform eq 'unix') { 900 my($wrapper) = $top->wrapper; 901 # set sticky flag for gnome and fvwm2 902 eval q{ 903 $top->property('set','_WIN_STATE','CARDINAL',32,[1],$wrapper); # sticky 904 $top->property('set','_WIN_LAYER','CARDINAL',32,[6],$wrapper); # ontop 905 }; 906 warn $@ if $@; 907 } 908 909 $top->withdraw; 910 911 $top->optionAdd("*font", "Helvetica 24 bold"); 912 $top->optionAdd("*padX", 20); 913 $top->optionAdd("*padY", 20); 914 $top->optionAdd("*background", "#ff0000"); 915 $top->optionAdd("*foreground", "white"); 916 $top->optionAdd("*activeBackground", "#ff8080"); 917 $top->optionAdd("*activeForeground", "white"); 918 919 if ($args{-ask}) { 920 if ($top->messageBox 921 (-title => M"Alarm setzen?", 922 -icon => "question", 923 -message => Mfmt("Alarm auf %s setzen?", scalar localtime $end_time), 924 -type => "YesNo") =~ /no/i) { 925 return; 926 } 927 } 928 929 my $cb = 930 $top->Button(-text => M("Verlassen"), 931 -command => sub { $top->destroy }, 932 )->pack; 933# $balloon->attach($cb, -msg => $text); 934 my $red = 0xff; 935 my $dir = -1; 936 CenterWindow($top); 937 my $wait = $end_time - time; 938 if ($wait < 0) { 939 warn "Wait time is smaller than 0\n"; 940 $wait = 0; 941 } 942 943 { 944 my $ack_t = $top->Toplevel(-title => M"Alarm gesetzt"); 945 my $wait = int($wait/60); 946 $ack_t->Button(-text => Mfmt("Alarm in %s %s gesetzt", $wait, $wait==1 ? M"Minute" : M"Minuten"), 947 -command => sub { $ack_t->destroy }, 948 )->pack; 949 $ack_t->after(10*1000, sub { $ack_t->destroy }); 950 $ack_t->Popup; 951 } 952 953 { 954 (my $esc_text = $text) =~ s/\t/ /g; 955 add_tk_alarm($$, $end_time, $esc_text); 956 } 957 958 $top->after 959 ($wait*1000, sub { 960 $top->deiconify; 961 $top->raise; 962 if ($Tk::platform eq 'unix') { 963 system(qw(xset s reset)); 964 } 965 966 del_tk_alarm($$); 967 968 my $raise_after; 969 $top->bind("<Visibility>" => sub { 970 return if $raise_after; 971 $raise_after = $top->after 972 (500, sub { $top->raise; undef $raise_after }); 973 }); 974 $top->repeat 975 (50, sub { 976 my @l = localtime; 977 $cb->configure 978 (-bg => sprintf("#%02x%02x%02x", $red,0,0), 979 -activebackground => sprintf("#%02x%02x%02x", $red,0,0), 980 -text => "$text\n" . 981 sprintf("%02d:%02d", $l[2], $l[1]), 982 ); 983 $red+=(8*$dir); 984 if ($red < 0x80) { 985 $dir = 1; 986 } elsif ($red > 0xff) { 987 $red = 0xff; 988 $dir = -1; 989 } 990 }); 991 992 }); 993 Tk::MainLoop(); 994} 995 996sub get_alarms_file { 997 if (!defined $alarms_file) { 998 $alarms_file = "$ENV{HOME}/.bbbikealarm.pids"; 999 } 1000 $alarms_file; 1001} 1002 1003use constant LIST_HOST => 0; 1004use constant LIST_PID => 1; 1005use constant LIST_TIME => 2; 1006use constant LIST_RELTIME => 3; 1007use constant LIST_DESC => 4; 1008use constant LIST_STATE => 5; 1009 1010use constant COL_HOST => 0; 1011use constant COL_PID => 1; 1012use constant COL_TIME => 2; 1013use constant COL_RELTIME => 3; 1014use constant COL_DESC => 4; 1015use constant COL_STATE => 5; 1016 1017sub _get_host { 1018 eval 'require Sys::Hostname; Sys::Hostname::hostname();'; 1019} 1020 1021{ 1022 my($w, $this_host, $top, $show_all_timer); 1023 1024 sub tk_show_all_init { 1025 $w = shift; 1026 require Tk; 1027 require Tk::HList; 1028 $this_host = _get_host(); 1029 if ($w) { 1030 $top = $w->Toplevel; 1031 } else { 1032 $top = MainWindow->new; 1033 } 1034 $top->title(M("Alarmprozesse")); 1035 } 1036 1037 sub tk_show_all_do { 1038 my $hl; 1039 $this_host = $this_host; # hmmm ... needed so the hlist command closure may see this lexical... 1040 $hl = $top->Scrolled("HList", -header => 1, 1041 -columns => 6, -scrollbars => "osoe", 1042 -width => 65, 1043 -command => sub { 1044 my $entry = shift; 1045 my $data = $hl->entrycget($entry, -data); 1046 if ($data->[LIST_HOST] eq $this_host && 1047 $hl->messageBox(-message => Mfmt("Prozess %s abbrechen?", $data->[LIST_PID]), 1048 -type => "YesNo", 1049 ) =~ /yes/i) { 1050 kill 9 => $data->[LIST_PID]; 1051 del_tk_alarm($data->[LIST_PID]); 1052 $hl->destroy; 1053 tk_show_all_do(); 1054 } 1055 }, 1056 )->pack(-fill => "both", -expand => 1); 1057 $hl->headerCreate(COL_HOST, -text => M"Rechner"); 1058 $hl->headerCreate(COL_PID, -text => M"Pid"); 1059 $hl->headerCreate(COL_TIME, -text => M"Zeit"); 1060 $hl->headerCreate(COL_RELTIME, -text => M"Verbl. Zeit"); 1061 $hl->headerCreate(COL_DESC, -text => M"Beschr."); 1062 $hl->headerCreate(COL_STATE, -text => M"Status"); 1063 1064 if ($show_all_timer) { 1065 $show_all_timer->cancel; 1066 } 1067 $show_all_timer = $hl->repeat(60*1000, sub { tk_show_all_update($hl) }); 1068 tk_show_all_update($hl); 1069 } 1070 1071 sub tk_show_all_update { 1072 my($hl) = @_; 1073 if (!Tk::Exists($hl)) { 1074 if ($show_all_timer) { 1075 $show_all_timer->cancel; 1076 undef $show_all_timer; 1077 } 1078 return; 1079 } 1080 1081 my @result = show_all(); 1082 my $i = 0; 1083 $hl->delete("all"); 1084 foreach my $result (@result) { 1085 $hl->add($i, -text => $result->[LIST_HOST], -data => $result); 1086 $hl->itemCreate($i, COL_PID, -text => $result->[LIST_PID]); 1087 $hl->itemCreate($i, COL_TIME, -text => scalar localtime $result->[LIST_TIME]); 1088 $hl->itemCreate($i, COL_RELTIME, -text => $result->[LIST_RELTIME]); 1089 $hl->itemCreate($i, COL_DESC, -text => $result->[LIST_DESC]); 1090 $hl->itemCreate($i, COL_STATE, -text => $result->[LIST_STATE]); 1091 $i++; 1092 } 1093 1094 } 1095 1096 sub tk_show_all { 1097 my $w = shift; 1098 tk_show_all_init($w); 1099 tk_show_all_do(); 1100 Tk::MainLoop(); 1101 } 1102 1103} 1104 1105sub open_dbm { 1106 my(%args) = @_; 1107 my $readonly = delete $args{-readonly} || 0; 1108 if (keys %args) { 1109 my_die "Unhandled arguments " . join " ", %args; 1110 } 1111 my $pids; 1112 if (!eval { 1113 require DB_File; 1114 require Fcntl; 1115 my $flags = $readonly ? &Fcntl::O_RDONLY : &Fcntl::O_RDWR|&Fcntl::O_CREAT; 1116 tie %$pids, 'DB_File', get_alarms_file(), $flags, 0600 1117 or my_die "Can't tie DB_File " . get_alarms_file() . ": $!"; 1118 }) { 1119 require SDBM_File; 1120 require Fcntl; 1121 my $flags = $readonly ? &Fcntl::O_RDONLY : &Fcntl::O_RDWR|&Fcntl::O_CREAT; 1122 tie %$pids, 'SDBM_File', get_alarms_file(), $flags, 0600 1123 or my_die "Can't tie SDBM_File " . get_alarms_file() . ": $!"; 1124 } 1125 $pids; 1126} 1127 1128sub restart_alarms { 1129 eval { 1130 my $pids = open_dbm(-readonly => 1); 1131 my $this_host = _get_host(); 1132 while(my($k,$v) = each %$pids) { 1133 my(@l) = split /\t/, $v; 1134 my($host, $pid, $time, $desc) = @l; 1135 $desc = _decode_desc($desc); 1136 my $state = "unknown"; 1137 if ($host eq $this_host) { 1138 if (!kill(0 => $pid)) { 1139 warn "Restart process $pid at " . scalar(localtime $time) . " ...\n"; 1140 tk_leave(undef, -epoch => $time, -text => $desc); # XXX use_tk? 1141 delete $pids->{$k}; 1142 } 1143 } 1144 } 1145 untie %$pids; 1146 }; 1147 warn $@ if $@; 1148} 1149 1150sub show_all { 1151 my @result; 1152 my $this_host = _get_host(); 1153 1154 eval { 1155 my $pids = open_dbm(-readonly => 1); 1156 while(my($k,$v) = each %$pids) { 1157 my(@l) = split /\t/, $v; 1158 my($host, $pid, $time, $desc) = @l; 1159 $l[3] = _decode_desc($desc); 1160 my $state = "unknown"; 1161 if ($host eq $this_host) { 1162 $state = (kill(0 => $pid) ? M("l�uft") : M("l�uft nicht")); 1163 } 1164 push @l, $state; 1165 1166 my $reltime; 1167 my $min = ($time-time)/60; 1168 if ($min < 0) { 1169 $reltime = M"�berf�llig"; 1170 } else { 1171 $reltime = sprintf "%d:%02d h", $min/60, abs($min)%60; 1172 } 1173 1174 splice @l, LIST_RELTIME, 0, $reltime; 1175 1176 push @result, [@l]; 1177 } 1178 untie %$pids; 1179 }; 1180 warn $@ if $@; 1181 1182 @result; 1183} 1184 1185sub add_tk_alarm { 1186 my($pid, $time, $desc) = @_; 1187 if (!defined $pid) { $pid = $$ } 1188 my $this_host = _get_host(); 1189 1190 eval { 1191 my $pids = open_dbm(-readonly => 0); 1192 my $desc_octets = _encode_desc($desc); 1193 $pids->{$this_host.":".$pid} = join("\t", $this_host, $pid, $time, $desc_octets); 1194 untie %$pids; 1195 }; 1196 warn $@ if $@; 1197} 1198 1199sub del_tk_alarm { 1200 my($this_pid) = @_; 1201 if (!defined $this_pid) { $this_pid = $$ } 1202 my $this_host = _get_host(); 1203 1204 eval { 1205 my $pids = open_dbm(-readonly => 0); 1206 delete $pids->{$this_host.":".$this_pid}; 1207 my @to_del; 1208 while(my($k, $string) = each %$pids) { 1209 if ($this_host eq (split /\t/, $string)[LIST_HOST]) { 1210 my $time = (split /\t/, $string)[LIST_TIME]; 1211 my $pid = (split /\t/, $string)[LIST_PID]; 1212 if (!kill 0 => $pid || $time < time) { 1213 push @to_del, $k; 1214 } 1215 } 1216 } 1217 delete $pids->{$_} foreach @to_del; 1218 untie %$pids; 1219 }; 1220 warn $@ if $@; 1221} 1222 1223 1224# return number of seconds to wait 1225sub end_time { 1226 my($time) = @_; 1227 my $now = time; 1228 if ($time =~ /^\+(..)(..)$/) { # relative time 1229 $now += $1*60*60 + $2*60; 1230 return $now; 1231 } 1232 1233 # absolute time 1234 my @l = localtime $now; 1235 my @l2 = @l; 1236 ($l2[2], $l2[1]) = $time =~ /^(..)(..)$/; 1237 my $time_epoch = timelocal(@l2); 1238 if ($time_epoch < $now) { 1239 $time_epoch+=86400; 1240 if ($time_epoch < $now) { 1241 my_die "Strange: time is wrong"; 1242 } 1243 } 1244 $time_epoch; 1245} 1246 1247sub capabilities { 1248 if (is_in_path("leave") && is_in_path("who") && is_in_path("tee")) { 1249 $can_leave = 1; 1250 } 1251 if (is_in_path("at") && is_in_path("who") && is_in_path("tee")) { 1252 my $out = `at -V 2>&1`; 1253 $can_at = ($out !~ /\bno.*\bpermission\b/i); 1254 } 1255 eval { 1256 require Tk; 1257 $can_tk = 1; 1258 }; 1259 if (is_in_path("install-datebook") && 1260 defined $ENV{PILOTPORT}) { 1261 $can_palm = 1; 1262 } 1263 if (is_in_path("ical") && -r "$ENV{HOME}/.calendar" && 0 == system("grep", "-q", 'IncludeCalendar \[.*\.calendar\.ical\.bbbikealarm\]', "$ENV{HOME}/.calendar")) { 1264 $can_ical = 1; 1265 } 1266 if ($main::devel_host) { 1267 if (is_in_path("obexapp")) { 1268 $can_bluetooth = 1; # FreeBSD 1269 } elsif (is_in_path("ussp-push")) { 1270 $can_bluetooth = 1; # Linux 1271 } 1272 } 1273} 1274 1275sub time2epoch { 1276 my($time) = @_; 1277 if ($time =~ /^\+(\d{2}):?(\d{2})$/) { 1278 my($H,$M) = ($1, $2); 1279 time + $H*3600 + $M*60; 1280 } elsif ($time =~ /^(\d{2}):?(\d{2})$/) { 1281 require Time::Local; 1282 my($H,$M) = ($1, $2); 1283 my @l = localtime; 1284 my $HM = sprintf "%02d%02d", $H, $M; 1285 my $HM_now = sprintf "%02d%02d", $l[2], $l[1]; 1286 $l[1] = $M; 1287 $l[2] = $H; 1288 my $new_time = Time::Local::timelocal(@l); 1289 if ($HM < $HM_now) { 1290 $new_time += 86400; 1291 } 1292 $new_time; 1293 } else { 1294 $time; 1295 } 1296} 1297 1298sub _decode_desc { 1299 my $v = shift; 1300 if (eval { require Encode; 1 }) { 1301 $v = Encode::decode('utf-8', $v); 1302 } 1303 $v; 1304} 1305 1306sub _encode_desc { 1307 my $v = shift; 1308 if (eval { require Encode; 1 }) { 1309 $v = Encode::encode('utf-8', $v); 1310 } 1311 $v; 1312} 1313 1314# REPO BEGIN 1315# REPO NAME is_in_path /home/e/eserte/src/repository 1316# REPO MD5 1aa226739da7a8178372aa9520d85589 1317sub is_in_path { 1318 my($prog) = @_; 1319 return $prog if (file_name_is_absolute($prog) and -x $prog); 1320 require Config; 1321 my $sep = $Config::Config{'path_sep'} || ':'; 1322 foreach (split(/$sep/o, $ENV{PATH})) { 1323 return "$_/$prog" if -x "$_/$prog"; 1324 } 1325 undef; 1326} 1327# REPO END 1328 1329# REPO BEGIN 1330# REPO NAME file_name_is_absolute /home/e/eserte/src/repository 1331# REPO MD5 a77759517bc00f13c52bb91d861d07d0 1332sub file_name_is_absolute { 1333 my $file = shift; 1334 my $r; 1335 eval { 1336 require File::Spec; 1337 $r = File::Spec->file_name_is_absolute($file); 1338 }; 1339 if ($@) { 1340 if ($^O eq 'MSWin32') { 1341 $r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i); 1342 } else { 1343 $r = ($file =~ m|^/|); 1344 } 1345 } 1346 $r; 1347} 1348# REPO END 1349 1350# REPO BEGIN 1351# REPO NAME center_window /home/e/eserte/src/repository 1352# REPO MD5 3d08d84d7a8e609eedbd70f901f5b5ef 1353 1354sub CenterWindow { 1355#################################################### 1356# Args: (0) window to center 1357# (1) [optional] desired width 1358# (2) [optional] desired height 1359# 1360# Returns: *nothing* 1361#################################################### 1362 my($window, $width, $height) = @_; 1363 1364 $window->idletasks; 1365 $width = $window->reqwidth unless $width; 1366 $height = $window->reqheight unless $height; 1367 my $x = int(($window->screenwidth / 2) - ($width / 2)); 1368 my $y = int(($window->screenheight / 2) - ($height / 2)); 1369 $window->geometry($width . "x" . $height . "+" . $x . "+" . $y); 1370} 1371# REPO END 1372 1373# REPO BEGIN 1374# REPO NAME bg_system /home/e/eserte/src/repository 1375# REPO MD5 aa3191a2004671b54fd024be12389d0d 1376sub bg_system { 1377 my(@args) = @_; 1378 if ($^O eq 'MSWin32') { 1379 for (@args) { 1380 s/[\"\\]//g; # XXX quote properly 1381 } 1382 system 1, "@args"; 1383 } else { 1384 my $pid1 = fork; 1385 die "Cannot fork: $!" if !defined $pid1; 1386 if (!$pid1) { 1387 my $pid2 = fork; 1388 if (!defined $pid2) { 1389 warn "Cannot fork: $!"; 1390 CORE::exit(1); 1391 } 1392 if (!$pid2) { 1393 exec @args; 1394 warn "Cannot exec @args: $!"; 1395 CORE::exit(2); 1396 } 1397 CORE::exit(0); 1398 } 1399 } 1400} 1401# REPO END 1402 1403return 1 if caller; 1404 1405###################################################################### 1406 1407package main; 1408 1409my $use_tk; 1410my $time; 1411my $text; 1412my $interactive; 1413my $interactive_small; 1414my $ask; 1415my $show_all; 1416my $restart; 1417my $encoding; 1418require Getopt::Long; 1419if (!Getopt::Long::GetOptions("-tk!" => \$use_tk, 1420 "-time=s" => \$time, 1421 "-text=s" => \$text, 1422 "-interactive!" => \$interactive, 1423 "-interactive-small!" => \$interactive_small, 1424 "-ask!" => \$ask, 1425 "-encoding=s" => \$encoding, 1426 "showall|list" => \$show_all, 1427 "restart" => \$restart, 1428 )) { 1429 die "Usage $0 [-tk [-ask]] [-time hh:mm] [-text message] 1430 [-interactive | -interactive-small] 1431 [-showall|-list] [-restart] [-encoding ...] 1432"; 1433} 1434 1435$time = BBBikeAlarm::time2epoch($time) if defined $time; 1436if (defined $text && defined $encoding) { 1437 require Encode; 1438 $text = Encode::decode($encoding, $text); 1439} 1440 1441if ($interactive || $interactive_small) { 1442 require Tk; 1443 my $mw = MainWindow->new; 1444 $mw->withdraw; 1445 if ($interactive_small) { 1446 BBBikeAlarm::enter_alarm_small_dialog($mw, -withtext => 1); 1447 } else { 1448 $time = do { @_ = localtime; sprintf "%02d:%02d", $_[3], $_[2] }; 1449 BBBikeAlarm::enter_alarm($mw, \$time, -dialog => 1); 1450 } 1451} elsif ($use_tk) { 1452 if ($show_all) { 1453 BBBikeAlarm::tk_show_all(); 1454 } else { 1455 BBBikeAlarm::tk_interface($time, $text, -ask => $ask); 1456 } 1457} elsif ($show_all) { 1458 print join("\n", map { join "\t", @$_ } BBBikeAlarm::show_all()), "\n"; 1459} elsif ($restart) { 1460 BBBikeAlarm::restart_alarms(); 1461} else { 1462 die "Can't set alarm: type e.g. -tk missing"; 1463} 1464 1465# peacify -w 1466$main::tmpdir = $main::tmpdir if 0; 1467$main::top = $main::top if 0; 1468 1469__END__ 1470 1471=head1 NAME 1472 1473BBBikeAlarm - setting alarms 1474 1475=head1 SYNOPSIS 1476 1477From cmdline: 1478 1479 perl BBBikeAlarm.pm [-tk [-ask]] [-time hh:mm] [-text message] 1480 [-interactive | -interactive-small] 1481 [-showall|-list] [-restart] [-encoding ...] 1482 1483From script: 1484 1485 use BBBikeAlarm; 1486 use Tk; 1487 BBBikeAlarm::enter_alarm_small_dialog(MainWindow->new) 1488 1489=head1 BUGS 1490 1491The pid list of running alarm processes is maintained in a Berkeley DB 1492file F<~/.bbbikealarm.pids>, if L<DB_File> is available. Berkeley DB 1493is a highly instable format. It is possible that updates to the 1494underlying library makes the old db file unreadable (often seen on 1495Debian systems). In this case, just remove the mentioned file. 1496 1497=head1 TODO 1498 1499 sollte ich evtl. verwenden f�r die Liste der Alarme: 1500 http://reefknot.sourceforge.net/ 1501 Date::ICal, Net::ICal 1502 1503=head1 AUTHOR 1504 1505Slaven Rezic 1506 1507=head1 SEE ALSO 1508 1509L<DB_File>, L<Astro::Sunrise>, L<BBBikePalm>. 1510 1511=cut 1512