source: subversion/applications/editors/osmpedit/osm.pm @ 34468

Last change on this file since 34468 was 1137, checked in by tpersson, 13 years ago

More support for ways added

File size: 21.1 KB
Line 
1#    Copyright (C) 2005 Tommy Persson, tpe@ida.liu.se
2#
3#    This program is free software; you can redistribute it and/or modify
4#    it under the terms of the GNU General Public License as published by
5#    the Free Software Foundation; either version 2 of the License, or
6#    (at your option) any later version.
7#
8#    This program is distributed in the hope that it will be useful,
9#    but WITHOUT ANY WARRANTY; without even the implied warranty of
10#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11#    GNU General Public License for more details.
12#
13#    You should have received a copy of the GNU General Public License
14#    along with this program; if not, write to the Free Software
15#    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111 USA
16
17package osm;
18
19use FindBin qw($RealBin);
20use lib "$RealBin/../perl";
21
22
23use strict;
24
25use osmnode;
26use osmsegment;
27use osmway;
28use osmutil;
29
30use XML::TokeParser;
31
32sub new {
33    my $this = shift;
34    my $class = ref($this) || $this;
35    my $obj = bless {
36        USERNAME => "unspecified",
37        PASSWORD => "unspecified",
38        UIDTOSEGMENTMAP => {},
39        UIDTONODEMAP => {},
40        UIDTOWAYMAP => {},
41        ITEMTOUID => {},
42        UIDTOITEM => {},
43        SEGCOLOUR => {},
44        @_
45        }, $class;
46    $obj->{SEGCOLOUR}->{"none"} = "white";
47    $obj->{SEGCOLOUR}->{"street"} = "lightsteelblue3";
48    $obj->{SEGCOLOUR}->{"primary"} = "orangered";
49    $obj->{SEGCOLOUR}->{"secondary"} = "orangered4";
50    $obj->{SEGCOLOUR}->{"motorway"} = "navy";
51#    $obj->{SEGCOLOUR}->{"unsurfaced"} = "green";
52    $obj->{SEGCOLOUR}->{"minor"} = "wheat3";
53    $obj->{SEGCOLOUR}->{"path"} = "brown";
54    $obj->{SEGCOLOUR}->{"footpath"} = "brown";
55    $obj->{SEGCOLOUR}->{"bikepath"} = "brown";
56    $obj->{SEGCOLOUR}->{"train"} = "sienna3";
57    $obj->{SEGCOLOUR}->{"railroad"} = "sienna3";
58    $obj->{SEGCOLOUR}->{"tunnel"} = "black";
59    return $obj;
60}
61
62sub clean {
63    my $self = shift;
64    $self->{UIDTOSEGMENTMAP} = {};
65    $self->{UIDTONODEMAP} = {};
66    $self->{UIDTOWAYMAP} = {};
67    $self->{ITEMTOUID} = {};
68    $self->{UIDTOITEM} = {};
69}
70
71sub connect_uid_item {
72    my $self = shift;
73    my $uid = shift;
74    my $item = shift;
75    $self->{ITEMTOUID}->{$item} = $uid;
76    $self->{UIDTOITEM}->{$uid} = $item;
77##    print STDERR "$item --- $uid\n";
78}
79
80sub add_node {
81    my $self = shift;
82    my $n = shift;
83##    push @{$self->{NODES}}, $n;
84    my $uid = $n->get_uid ();
85    $self->{UIDTONODEMAP}->{$uid} = $n;
86}
87
88sub add_way {
89    my $self = shift;
90    my $w = shift;
91##    push @{$self->{NODES}}, $n;
92    my $uid = $w->get_uid ();
93    $self->{UIDTOWAYMAP}->{$uid} = $w;
94}
95
96sub get_nodes {
97    my $self = shift;
98    my  @res = ();
99    foreach my $k (keys %{$self->{UIDTONODEMAP}}) {
100        my $node = $self->{UIDTONODEMAP}->{$k};
101        if ($node) {
102            push @res, $node;
103        }
104    }
105    return @res;
106#    return @{$self->{NODES}};
107}
108
109sub get_ways {
110    my $self = shift;
111    my  @res = ();
112    foreach my $k (keys %{$self->{UIDTOWAYMAP}}) {
113        my $way = $self->{UIDTOWAYMAP}->{$k};
114        if ($way) {
115            push @res, $way;
116        }
117    }
118    return @res;
119}
120
121sub get_segment_colour {
122    my $self = shift;
123    my $class = shift;
124    my $res = "white";
125    if ($self->{SEGCOLOUR}->{$class}) {
126        $res =  $self->{SEGCOLOUR}->{$class};
127    } else {
128        print STDERR "WARNING: No colour specified for class - $class\n";
129    }
130    return $res;
131}
132
133sub get_segment_classes {
134    my $self = shift;
135    return keys %{$self->{SEGCOLOUR}};
136}
137
138sub get_segment_keys {
139    my $self = shift;
140    my %keys;
141    foreach my $s ($self->get_segments ()) {
142        foreach my $k ($s->get_keys ()) {
143            $keys{$k} = 1;
144        }
145    }
146    return keys %keys;
147}
148
149sub get_way_keys {
150    my $self = shift;
151    my %keys;
152    foreach my $s ($self->get_ways ()) {
153        foreach my $k ($s->get_keys ()) {
154            $keys{$k} = 1;
155        }
156    }
157    return keys %keys;
158}
159
160
161sub get_segment_values {
162    my $self = shift;
163    my $key = $self->{SEGMENTKEY};
164    my %values;
165    foreach my $s ($self->get_segments ()) {
166        my $v = $s->get_key_value ($key);
167        if ($v) {
168            $values{$v} = 1;
169        }
170    }
171    return keys %values;
172}
173
174sub get_way_values {
175    my $self = shift;
176    my $key = $self->{WAYKEY};
177    my %values;
178    foreach my $s ($self->get_ways ()) {
179        my $v = $s->get_key_value ($key);
180        if ($v) {
181            $values{$v} = 1;
182        }
183    }
184    return keys %values;
185}
186
187
188
189sub get_node {
190    my $self = shift;
191    my $uid = shift;
192    my $node = $self->{UIDTONODEMAP}->{$uid};
193    return $node;
194}
195
196sub get_segment {
197    my $self = shift;
198    my $uid = shift;
199    my $segment = $self->{UIDTOSEGMENTMAP}->{$uid};
200    return $segment;
201}
202
203sub get_way {
204    my $self = shift;
205    my $uid = shift;
206    my $way = $self->{UIDTOWAYMAP}->{$uid};
207    return $way;
208}
209
210sub get_node_from_item {
211    my $self = shift;
212    my $item = shift;
213    my $uid = $self->{ITEMTOUID}->{$item};
214##    print STDERR "UID: $uid\n";
215    return $self->get_node ($uid);
216}
217
218sub get_segment_from_item {
219    my $self = shift;
220    my $item = shift;
221    my $uid = $self->{ITEMTOUID}->{$item};
222    return $self->get_segment ($uid);
223}
224
225sub get_way_from_item {
226    my $self = shift;
227    my $item = shift;
228    my $uid = $self->{ITEMTOUID}->{$item};
229    print STDERR "UID: $uid\n";
230    return $self->get_way ($uid);
231}
232
233sub add_segment {
234    my $self = shift;
235    my $s = shift;
236    my $uid = $s->get_uid ();
237    $self->{UIDTOSEGMENTMAP}->{$uid} = $s;
238
239    my $from = $s->get_from ();
240    my $fromnode = $self->get_node ($from);
241    if ($fromnode) {
242        $fromnode->add_from ($uid);
243    }
244
245    my $to = $s->get_to ();
246    my $tonode = $self->get_node ($to);
247    if ($tonode) {
248        $tonode->add_to ($uid);
249    }
250}
251
252sub get_segments {
253    my $self = shift;
254    my  @res = ();
255    foreach my $k (keys %{$self->{UIDTOSEGMENTMAP}}) {
256        my $seg = $self->{UIDTOSEGMENTMAP}->{$k};
257        if ($seg) {
258            push @res, $seg;
259        }
260    }
261    return @res;
262}
263
264sub get_segments_connected_to_node {
265    my $self = shift;
266    my $node_uid = shift;
267    my @res = ();
268    my $node = $self->get_node ($node_uid);
269    if ($node) {
270        my @froms = $node->get_froms ();
271        foreach my $suid (@froms) {
272            print STDERR "MOVE FROM: $suid\n";
273            my $s = $self->get_segment ($suid);
274            push @res, $s;
275        }
276    }
277    return @res;
278}
279
280
281sub get_position {
282    my $self = shift;
283    my $uid = shift;
284    my @res = ();
285    my $n = $self->{UIDTONODEMAP}->{$uid};
286    if ($n) {
287        my $lat = $n->get_lat ();
288        my $lon = $n->get_lon ();
289        @res = ($lat, $lon);
290    }
291    return @res;
292}
293
294sub set_username {
295    my $self = shift;
296    my $val = shift;
297    $self->{USERNAME} = $val;
298}
299
300sub get_username {
301    my $self = shift;
302    return $self->{USERNAME};
303}
304
305sub set_password {
306    my $self = shift;
307    my $val = shift;
308    $self->{PASSWORD} = $val;
309}
310
311sub get_password {
312    my $self = shift;
313    return $self->{PASSWORD};;
314}
315
316
317
318
319sub fetch {
320    my $self = shift;
321    my $landsat = shift;
322
323    if (not -d "$ENV{HOME}/.osmpedit") {
324        mkdir "$ENV{HOME}/.osmpedit";
325    }
326
327    if (not -d "$ENV{HOME}/.osmpedit/cache") {
328        mkdir "$ENV{HOME}/.osmpedit/cache";
329    }
330
331    my $username  = $self->get_username ();
332    my $password  = $self->get_password ();
333
334    my ($west, $south, $east, $north) = $landsat->get_area ();
335
336    my $data = curl::grab_osm ($west, $south, $east, $north, 
337                               $username, $password);
338##    print STDERR "$data\n";
339
340    if ($data) {
341        my $filename = "$ENV{HOME}/.osmpedit/cache/lastosm.xml";
342        open XML, ">$filename" or die "Could not open $filename: $!";
343        print XML "$data";
344        close XML;
345    } else {
346        print STDERR "WARNING: Failed to read OSM data from server\n";
347    }
348}
349
350sub parse {
351    my $self = shift;
352    my $landsat = shift;
353
354    $landsat->get_canvas ()->delete ("osmwp");
355    $landsat->get_canvas ()->delete ("osmnode");
356    $landsat->get_canvas ()->delete ("osmsegment");
357    $self->clean ();
358
359    my $filename = "$ENV{HOME}/.osmpedit/cache/lastosm.xml";
360    if (-e "$filename" and -s "$filename") {
361        print STDERR "Parsing file: $filename\n";
362        my $p = XML::TokeParser->new("$filename");
363        if (not $p) {
364            print STDERR "WARNING: Could not parse osm data\n";
365            return;
366        }
367        my $t;
368        my $current_node_segment_way = 0;
369        while (1) {
370            eval {$t = $p->get_tag() };
371            if ($@) {
372                print STDERR "Could not parse file: $@\n";
373            }
374            last unless $t;
375            if ($t->is_start_tag) {
376                my $name = "$t->[0]";
377##              print STDERR "$name\n";
378                if ($name eq "node") {
379                    my $attr = $t->attr;
380                    my $lat = $attr->{lat};
381                    my $lon = $attr->{lon};
382                    my $uid = $attr->{id};
383                    my $timestamp = $attr->{timestamp};
384##                  print STDERR "NODE $lat $lon $uid\n";
385                    my $node = new osmnode;
386                    $node->set_lat ($lat);
387                    $node->set_lon ($lon);
388                    $node->set_uid ("n$uid");
389                    $self->add_node ($node);
390                    $current_node_segment_way = $node;
391                }
392                if ($name eq "tag") {
393                    my $attr = $t->attr;
394                    my $k = $attr->{k};
395                    my $v = $attr->{v};
396##                  print STDERR "TAG $k: $v\n";
397                    $current_node_segment_way->add_key_value ($k, $v);
398                }
399                if ($name eq "seg") {
400                    my $attr = $t->attr;
401                    my $s = $attr->{id};
402                    print STDERR "  WAYSEG $s\n";
403                    $current_node_segment_way->add_segment ("s$s");
404                }
405                if ($name eq "segment") {
406                    my $attr = $t->attr;
407                    my $from = $attr->{from};
408                    my $to = $attr->{to};
409                    my $id = $attr->{id};
410                    my $timestamp = $attr->{timestamp};
411##                  print STDERR "SEGMENT $from $to $id\n";
412                    my $s = new osmsegment;
413                    $s->set_from ("n$from");
414                    $s->set_to ("n$to");
415                    $s->set_uid ("s$id");
416                    $self->add_segment ($s);
417                    $current_node_segment_way = $s;
418                }
419                if ($name eq "way") {
420                    my $attr = $t->attr;
421                    my $id = $attr->{id};
422                    my $timestamp = $attr->{timestamp};
423                    print STDERR "WAY $id --- $timestamp\n";
424                    my $s = new osmway;
425                    $s->set_uid ("w$id");
426                    $self->add_way ($s);
427                    $current_node_segment_way = $s;
428                }
429            }
430        }
431    }
432}
433
434
435sub get_segment_canvas_coords {
436    my $self = shift;
437    my $landsat = shift;
438    my $segment = shift;
439
440    my $w = $landsat->get_pixel_width ();
441    my $h = $landsat->get_pixel_height ();
442    my ($west, $south, $east, $north) = $landsat->get_area ();
443    my $dx = $east-$west;
444    my $dy = $north-$south;
445
446    my $from = $segment->get_from ();
447    my $to = $segment->get_to ();
448    my $uid = $segment->get_uid ();
449
450    my ($flat, $flon) = $self->get_position ($from);
451    my ($tlat, $tlon) = $self->get_position ($to);
452
453    my $fromoutside = 0;
454    my $tooutside = 0;
455    if ($flat > $north or $flat < $south or $flon > $east or $flon<$west) {
456        $fromoutside = 1;
457    }
458
459    if ($tlat > $north or $tlat < $south or $tlon > $east or $tlon<$west) {
460        $tooutside = 1;
461    }
462
463    if ($fromoutside or $tooutside) { # change when clamping works...
464        return ();
465    }
466
467
468##      print STDERR "DRAW SEGMENT: $flat $flon $tlat $tlon\n";
469
470    my $x0 = ($flon-$west)/$dx*$w;
471    my $y0 = $h-($flat-$south)/$dy*$h;
472    my $x1 = ($tlon-$west)/$dx*$w;
473    my $y1 = $h-($tlat-$south)/$dy*$h;
474    return ($x0, $y0, $x1, $y1);
475}
476
477
478sub draw {
479    my $self = shift;
480    my $landsat = shift;
481
482    my $can = $landsat->get_canvas ();
483    my $w = $landsat->get_pixel_width ();
484    my $h = $landsat->get_pixel_height ();
485    my ($west, $south, $east, $north) = $landsat->get_area ();
486    my $dx = $east-$west;
487    my $dy = $north-$south;
488
489##    $self->fetch_and_parse ($west, $south, $east, $north);
490   
491    print STDERR "DRAW OSM FOR $north $south $east $west\n";
492
493    $can->delete ("osmsegment");
494    $can->delete ("osmnode");
495    $can->delete ("osmway");
496
497    foreach my $way ($self->get_ways ()) {
498        my @segids = $way->get_segments ();
499
500        my $colour = "white";
501        my $class = $way->get_class ();
502        if ($class) {
503            $colour = $self->get_segment_colour ($class);
504        }
505           
506
507        foreach my $uid (@segids) {
508            my $segment = $self->get_segment ($uid);
509            if (not $segment) {
510##              print STDERR "WARNING: WAY SEGMENT DOES NOT EXIST --- $uid\n";
511                next;
512            }
513
514            my ($x0, $y0, $x1, $y1) = 
515                $self->get_segment_canvas_coords ($landsat, $segment);
516            next unless ($x0);
517
518            my $wayuid = $way->get_uid ();
519            my $item = $can->create ('line', $x0, $y0, $x1, $y1,
520#                      -arrow => "last",
521                                     -fill => $colour,
522                                     -width => 4,
523                                     -tag => ["osmway", $wayuid]);
524        }
525    }
526
527    foreach my $segment ($self->get_segments ()) {
528        my $uid = $segment->get_uid ();
529
530       
531        my ($x0, $y0, $x1, $y1) = $self->get_segment_canvas_coords ($landsat,
532                                                                    $segment);
533        next unless ($x0);
534
535        my $colour = "white";
536        my $class = $segment->get_class ();
537        if ($class) {
538            $colour = $self->get_segment_colour ($class);
539        }
540
541        my $item = $can->create ('line', $x0, $y0, $x1, $y1,
542#                      -arrow => "last",
543                                -fill => $colour,
544                                 -width => 2,
545                                -tag => "osmsegment");
546        $self->connect_uid_item ($uid, $item);
547
548    }
549
550
551    foreach my $node ($self->get_nodes ()) {
552        my $lat = $node->get_lat ();
553        my $lon = $node->get_lon ();
554        my $uid = $node->get_uid ();
555        if ($lat > $north or $lat < $south or $lon > $east or $lon < $west) {
556            next;
557        }
558##      print STDERR "DRAW NODE $uid: $lat $lon\n";
559        my $x = ($lon-$west)/$dx*$w;
560        my $y = $h-($lat-$south)/$dy*$h;
561        my $item = $self->draw_node ($can, $x, $y, $node);
562        $self->connect_uid_item ($uid, $item);
563    }
564}
565
566sub update_segment_key_value {
567    my $self = shift;
568    my $item = shift;
569    my $key = shift;
570    my $value = shift;
571    my $s = $self->get_segment_from_item ($item);
572    my $oldvalue = $s->get_key_value ($key);
573    if ($value eq $oldvalue) {
574        $value = "";
575    }
576    if ($s) {
577        $s->add_key_value ($key, $value);
578        $s->print ();
579        my $username  = $self->get_username ();
580        my $password  = $self->get_password ();
581        $s->update_osm_segment ($username, $password);
582    }
583}
584
585##sub update_segment_class {
586##    my $self = shift;
587##    my $item = shift;
588##    my $s = $self->get_segment_from_item ($item);
589##    if ($s) {
590##      $s->print ();
591##      my $username  = $self->get_username ();
592##      my $password  = $self->get_password ();
593##      $s->update_osm_segment ($username, $password);
594##    }
595##}
596
597sub update_segment_colour {
598    my $self = shift;
599    my $item = shift;
600    my $can = shift;
601
602    my $s = $self->get_segment_from_item ($item);
603    if ($s) {
604        my $c = "white";
605        my $class = $s->get_class ();
606        if ($class) {
607            $c = $self->get_segment_colour ($class);
608        }
609        $can->itemconfigure ($item, "-fill", $c);
610    }
611}
612
613sub update_way_colour {
614    my $self = shift;
615    my $item = shift;
616    my $class = shift;
617    my $can = shift;
618
619    my $c = "white";
620    if ($class) {
621        $c = $self->get_segment_colour ($class);
622    }
623    $can->itemconfigure ($item, "-fill", $c);
624}
625
626sub update_segments_key_colour {
627    my $self = shift;
628    my $key = shift;
629    my $can = shift;
630    $self->{SEGMENTKEY} = $key;
631    foreach my $s ($self->get_segments ()) {
632        my $uid = $s->get_uid ();
633        my $item = $self->{UIDTOITEM}->{$uid};
634        if ($s->is_key ($key)) {
635            $can->itemconfigure ($item, "-fill", "yellow");
636        } else {
637            $self->update_segment_colour ($item, $can);
638        }
639    }
640
641}
642
643sub update_ways_key_colour {
644    my $self = shift;
645    my $key = shift;
646    my $can = shift;
647    $self->{WAYKEY} = $key;
648    print STDERR "UPDATE_WAYS_KEY_COLOUR: $key\n";
649    foreach my $s ($self->get_ways ()) {
650        my $uid = $s->get_uid ();
651##      print STDERR "$uid\n";
652        if ($s->is_key ($key)) {
653            $can->itemconfigure ("$uid", "-fill", "yellow");
654        } else {
655            my $value = "";
656            if ($key eq "none") {
657                $value = $s->get_key_value ("class");
658            }
659            $self->update_way_colour ("$uid", $value, $can);
660        }
661    }
662
663}
664
665sub update_ways_value_colour {
666    my $self = shift;
667    my $value = shift;
668    my $can = shift;
669    my $key = $self->{WAYKEY};
670    $self->update_ways_key_colour ($key, $can);
671    foreach my $s ($self->get_ways ()) {
672        my $uid = $s->get_uid ();
673##      my $item = $self->{UIDTOITEM}->{$uid};
674        if ($s->get_key_value ($key) eq $value) {
675            $can->itemconfigure ("$uid", "-fill", "green");
676        }
677    }
678}
679
680sub draw_node {
681    my $self = shift;
682    my $can = shift;
683    my $x = shift;
684    my $y = shift;
685    my $node = shift;
686    my $r = 2;
687    my $colour = "black";
688    my $tag = "osmnode";
689#    if ($node and $node->have_key_values ()) {
690#       $colour = "yellow";
691#       $r = 4;
692#       $tag = "osmwp";
693#    }
694    my $obj = $can->create ('oval', $x-$r, $y-$r, $x+$r, $y+$r,
695                            -fill => $colour,
696                            -outline => $colour,
697                            -tag => $tag);
698    return $obj;
699}
700
701
702sub move_node {
703    my $self = shift;
704    my $item = shift;
705    my $x = shift;
706    my $y = shift;
707    my $can = shift;
708
709    my $node = $self->get_node_from_item ($item);
710##    print STDERR "Move node: " . $node->get_uid() . "\n";
711    if ($node) {
712        my @froms = $node->get_froms ();
713        my @tos = $node->get_tos ();
714
715        foreach my $suid (@froms) {
716            print STDERR "Check FROMS: $suid\n";
717            my $sitem = $self->{UIDTOITEM}->{$suid};
718            if ($item) {
719                my ($x0, $y0, $x1, $y1) = $can->coords ($sitem);
720                $can->coords ($sitem, $x, $y, $x1, $y1);
721            }
722        }
723
724        foreach my $suid (@tos) {
725            print STDERR "Check TOS: $suid\n";
726            my $sitem = $self->{UIDTOITEM}->{$suid};
727            if ($item) {
728                my ($x0, $y0, $x1, $y1) = $can->coords ($sitem);
729                $can->coords ($sitem, $x0, $y0, $x, $y);
730            }
731        }
732
733       
734        my $r = 2;
735        if ($node->have_key_values ()) {
736            $r = 4;
737        }
738        $can->coords ($item, $x-$r, $y-$r, $x+$r, $y+$r);
739    }
740}
741
742
743sub create_node {
744    my $self = shift;
745    my $lat = shift;
746    my $lon = shift;
747    my $username  = $self->get_username ();
748    my $password  = $self->get_password ();
749    my $node = new osmnode;
750    $node->set_lat ($lat);
751    $node->set_lon ($lon);
752    my $tags = $node->get_tags ();
753
754    my $uid = osmutil::create_node ($lat, $lon, $tags, $username, $password);
755    if ($uid) {
756        $node->set_uid ("n$uid");
757        $self->add_node ($node);
758        print STDERR "Created node with osmuid: $uid\n";
759        return "n$uid";
760    } else {
761        return "$uid";
762    }
763}
764
765sub create_segment {
766    my $self = shift;
767    my $from = shift;
768    my $to = shift;
769    my $class = shift;
770    my $username  = $self->get_username ();
771    my $password  = $self->get_password ();
772    my $s = new osmsegment;
773    $s->set_from ($from);
774    $s->set_to ($to);
775
776    print STDERR "Create segment with class: $class\n";
777
778    if ($class) {
779        $s->add_key_value ("class", $class);
780    }
781
782    my $tags = $s->get_tags ();
783   
784    print STDERR "TAGS: $tags\n";
785
786    my $uid = osmutil::create_segment ($from, $to, $tags, $username, $password);
787
788    if ($uid) {
789        $s->set_uid ("s$uid");
790        $self->add_segment ($s);
791        print STDERR "Created segment with osmuid: $uid\n";
792        return "s$uid";
793    } else {
794        return "$uid";
795    }
796}
797
798sub update_node {
799    my $self = shift;
800    my $uid = shift;
801    my $lat = shift;
802    my $lon = shift;
803
804    my $node = $self->get_node_from_item ($uid);
805    my $username  = $self->get_username ();
806    my $password  = $self->get_password ();
807
808    $node->set_lat ($lat);
809    $node->set_lon ($lon);
810
811    return $node->upload_osm_node ($username, $password);
812}
813
814sub delete {
815    my $self = shift;
816    my $obj = shift;
817    my $can = shift;
818
819    my $uid = $self->{ITEMTOUID}->{$obj};
820    my $username  = $self->get_username ();
821    my $password  = $self->get_password ();
822
823    if ($uid) {
824        print STDERR "DELETE IN SERVER: $uid\n";
825        my $node = $self->get_node ($uid);
826
827        my $username  = $self->get_username ();
828        my $password  = $self->get_password ();
829        my $resp = "";
830       
831        if ($node) {
832            my @froms = $node->get_froms ();
833            my @tos = $node->get_tos ();
834            if ($self->one_segment_exists (@froms) or 
835                $self->one_segment_exists (@tos)) {
836                print STDERR "Cannot delete node that is connected to a segment\n";
837                return 0;
838            } else {
839                print STDERR "Trying to delete node\n";
840                $resp = osmutil::delete_node ($node->get_osmuid(), 
841                                              $username, $password);
842                $self->{UIDTONODEMAP}->{$uid} = 0;
843            }
844        } else {
845            my $seg = $self->get_segment ($uid);
846            if ($seg) {
847                print STDERR "Trying to delete segment\n";
848                $resp = osmutil::delete_segment ($seg->get_osmuid(), 
849                                                 $username, $password);
850                $self->{UIDTOSEGMENTMAP}->{$uid} = 0;
851            }
852        }
853        print STDERR "RESP: $resp\n";
854        if (not $resp) {
855            print STDERR "WARNING: Could not delete $obj\n";
856            return 0;
857        }
858        return 1;
859    } else {
860        print STDERR "WARNING: Could not delete $obj\n";
861        return 0;
862    }
863}
864
865sub key_value_hash {
866    my $self = shift;
867    my $item = shift;
868    my $node = $self->get_node_from_item ($item);
869#    print "NODE: ", $node->get_uid (), "\n";
870    if ($node) {
871#       print STDERR "Return key value hash ", $node->get_tags (), "\n";
872        return $node->key_value_hash ();
873    }
874    my $seg = $self->get_segment_from_item ($item);
875    if ($seg) {
876        return $node->key_value_hash ();
877    }
878    return 0;
879}
880
881sub toggle_colour {
882    my $self = shift;
883    my $can = shift;
884    my $class = shift;
885    my @items = $can->find ("withtag", "osmwp");
886    print STDERR "toggle_colour: $class\n";
887    foreach my $item (@items) {
888        my $keyvalues = $self->key_value_hash ($item);
889        next unless ($keyvalues);
890        if ($keyvalues->{"class"} eq $class) {
891            my $c = $can->itemcget ($item, -fill);
892            print STDERR "CURRENT COLOUR: $c\n";
893            my $col = "red";
894            if ($c eq "red") {
895                $col = "yellow";
896            }
897            $can->itemconfigure ($item, -fill => $col);
898        }
899    }
900}
901
902sub one_segment_exists {
903    my $self = shift;
904    my @sids = @_;
905    foreach my $uid (@sids) {
906        print STDERR "CHECKID: $uid\n";
907        if ($self->{UIDTOSEGMENTMAP}->{"$uid"}) {
908            return 1;
909        }
910    }
911    return 0;
912}
913
914sub create_way {
915    my $self = shift;
916    my @sids = @_;
917    my $username  = $self->get_username ();
918    my $password  = $self->get_password ();
919    my $way = new osmway;
920    $way->set_segments (@sids);
921    my $uid = $way->create_osm_way ($username, $password);
922    if ($uid) {
923        print STDERR "Created way: $uid\n";
924        $self->add_way ($way);
925    }
926}
927
928return 1;
Note: See TracBrowser for help on using the repository browser.