1# -*- perl -*-
2
3#
4# $Id: BBBikePalm.pm,v 1.11 2008/01/19 23:02:40 eserte Exp $
5# Author: Slaven Rezic
6#
7# Copyright (C) 2000,2008 Slaven Rezic. All rights reserved.
8# This package is free software; you can redistribute it and/or
9# modify it under the same terms as Perl itself.
10#
11# Mail: eserte@users.sourceforge.net
12# WWW:  http://bbbike.sourceforge.net
13#
14
15# Palm-Routinen f�r BBBike
16
17# in main muss definiert sein: is_in_path
18# wenn in main folgendes definiert ist, wird es verwendet: status_message
19
20use strict;
21# main bbbike variables
22use vars qw($os $tmpdir %tmpfiles $palm_doc_format $top);
23
24my @prog_order = qw(txt2pdbdoc /usr/local/txt2pdbdoc/bin/txt2pdbdoc
25		    pilot_makedoc
26		    iSiloBSD iSiloLinux iSiloDOS
27		    );
28
29# module-private variables
30use vars qw($win32_pdb_installer);
31
32sub can_create_and_transfer_palm_docs {
33    ((is_in_path("pilot_makedoc") ||
34      is_in_path("iSiloBSD")      ||
35      is_in_path("iSiloLinux")    ||
36      is_in_path("iSiloDOS")      ||
37      is_in_path("txt2pdbdoc")    ||
38      -x "/usr/local/txt2pdbdoc/bin/txt2pdbdoc")
39     &&
40     can_transfer_palm_docs());
41}
42
43sub can_transfer_palm_docs {
44    if ($os eq 'win') {
45	require Win32Util;
46	my $class = Win32Util::get_class_by_ext(".pdb") || "pdbfile";
47	$win32_pdb_installer = Win32Util::get_reg_cmd($class);
48	return (defined $win32_pdb_installer &&
49		$win32_pdb_installer ne "");
50    } else {
51	return 1 if (is_in_path("pilot-xfer"));
52    }
53}
54
55sub create_palm_button {
56    my $parent = shift;
57    my $get_endpoints_sub = shift;
58    $parent->Button
59	(-text => 'Palm',
60	 -command => \&create_palm_doc,
61	);
62}
63
64sub create_palm_doc {
65    my $f   = "$tmpdir/palmdoc-$$.";
66    my $doc = "$tmpdir/palmdoc-$$.pdb";
67    my $is_empty = sub {
68	if (!-r $f || -z $f) {
69	    die "Datei $f existiert nicht bzw. ist leer";
70	}
71    };
72    if ($palm_doc_format eq 'isilo') {
73	BBBikePalm::to_top(\@prog_order,
74			   qw(iSiloBSD iSiloLinux iSiloDOS));
75    }
76
77    foreach my $check_sys (@prog_order) {
78	my $full_path = is_in_path($check_sys);
79	if (defined $full_path) {
80	    if ($check_sys =~ /isilo/i) {
81		if ($os eq 'win') {
82		    # isilodos is a real DOS program ... only understanding 8.3
83		    $f = "$tmpdir\\palmtmp.htm";
84		    $doc = "$tmpdir\\palmtmp.pdb";
85		} else {
86		    $f .= "html";
87		}
88		open(PALM, ">$f") or
89		    die "$f kann nicht geschrieben werden: $!";
90		print PALM route_info_to_html();
91		close PALM;
92		$is_empty->();
93		my @cmd;
94		if ($os eq 'win') {
95		    @cmd = "$full_path -y $f $doc";
96		} else {
97		    @cmd = ($full_path, "-y", $f, $doc);
98		}
99		#warn "Executing @cmd\n";
100		system @cmd;
101	    } else {
102
103		# XXX better move to bbbike?
104		my $route_name = "BBBike-Route";
105		if (defined $main::show_route_start and
106		    defined $main::show_route_ziel) {
107		    my($start, $ziel);
108		    $start = Strasse::short(Strassen::strip_bezirk($main::show_route_start), 3); # Start besser abk�rzen --- ist meist immer der Gleiche
109		    $ziel  = Strasse::short(Strassen::strip_bezirk($main::show_route_ziel), 2);
110		    $route_name = "BBBike: $start-$ziel";
111		}
112
113		$f .= "txt";
114		open(PALM, ">$f") or
115		    die "$f kann nicht geschrieben werden: $!";
116		print PALM BBBikePalm::strip_html_tags(route_info_to_html()); # or route_info_to_text???
117		close PALM;
118		$is_empty->();
119		if ($check_sys =~ /pilot_makedoc/) {
120		    system($full_path, $f, $doc, $route_name);
121		} elsif ($check_sys =~ /txt2pdbdoc/) {
122		    system($full_path, $route_name, $f, $doc);
123		}
124	    }
125	    last;
126	}
127    }
128    if (!-r $doc) {
129	die "Doc-Datei $doc konnte nicht erzeugt werden";
130    }
131    if (defined $win32_pdb_installer) {
132	Win32Util::start_cmd($win32_pdb_installer, $doc);
133    } else {
134	system("pilot-xfer -i $doc &");
135	BBBikePalm::hot_sync_message($top);
136    }
137    $tmpfiles{$doc}++;
138}
139
140sub BBBikePalm::strip_html_tags {
141    my $text = shift;
142    $text =~ s/<[^>]+>//gs;
143    $text;
144}
145
146sub BBBikePalm::to_top {
147    my($listref, @to_top) = @_;
148    my(%to_top) = map { ($_ => 1) } @to_top;
149    my @new_list = @to_top;
150    foreach (@$listref) {
151	push @new_list, $_ if !exists $to_top{$_};
152    }
153    @$listref = ();
154    foreach (@new_list) {
155	push @$listref, $_;
156    }
157}
158
159sub BBBikePalm::hot_sync_message {
160    my $msg = "Hotsync-Button dr�cken!";
161    if (defined &main::status_message) {
162	main::status_message($msg, "infodlg");
163    } else {
164	my $top = shift;
165	$top->messageBox(-title => "Hotsync",
166			 -text => $msg);
167    }
168}
169
170######################################################################
171# Routines for bbbike.cgi using Palm::PalmDoc
172
173sub BBBikePalm::route2palm {
174    require Route::Descr;
175    require Palm::PalmDoc;
176    my(%args) = @_;
177    my $fh = delete $args{-fh};
178    my $file = delete $args{-file};
179    my $out = Route::Descr::convert(%args);
180    my $doc = Palm::PalmDoc->new;
181    if ($out->{Goal}) {
182	# Who is causing the bug behind this restriction?
183	my $title = substr("$out->{Start} - $out->{Goal}", 0, 31);
184	$doc->title($title);
185    } else {
186	$doc->title("BBBike-Route");
187    }
188    $doc->body(join("\n\n", map { join("\t", @$_) } @{$out->{Lines}}, $out->{Footer}));
189    #$doc->compression(1); # XXX no effect?
190    if ($fh) {
191	binmode $fh;
192	print $fh $doc->pdb_header,$doc->body;
193    } elsif ($file) {
194	open(F, ">$file") or die "Can't write to $file: $!";
195	binmode F;
196	print F $doc->pdb_header,$doc->body;
197	close F;
198    } else {
199	return $doc->pdb_header . $doc->body;
200    }
201}
202
2031;
204
205__END__
206