source: subversion/applications/utils/amf/amf_finddeleted.pl @ 25070

Last change on this file since 25070 was 24246, checked in by pa94, 10 years ago

perl version of "amf_finddeleted.rb"

File size: 3.8 KB
Line 
1#!/usr/bin/perl -w
2
3use LWP::UserAgent;
4
5
6############################################################################
7
8package MiniStringIO;
9
10sub new
11{
12        my $class= shift;
13        my $self= bless { string => shift, pointer => 0 }, $class;
14
15        return $self;   
16}
17
18sub read
19{
20        my $self= shift;
21        my $len= shift;
22       
23        my $r= substr($self->{string}, $self->{pointer}, $len);
24        $self->{pointer}+= $len;
25       
26        return $r;
27}
28
29############################################################################
30
31
32package main;
33
34
35
36sub encodevalue
37{
38        my ($n, $type)= @_;
39        my $a;
40       
41        if (ref($n) eq "HASH")
42        {
43                # fixme: missing
44        }
45        elsif (ref($n) eq "ARRAY")
46        {
47                $a= chr(10) . encodelong(scalar(@$n));
48                $a.= encodevalue($_, $type) foreach(@$n);
49                return $a;
50        }
51        if (!defined($type)) # not defined, so we have to find out
52        {
53                $type= "String";
54                $type= "Float" if ($n=~/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # taken from http://perldoc.perl.org/perlfaq4.html
55        }
56        if ($type eq "String")
57        {
58                return chr(2) . encodestring($n);
59        }
60        elsif ($type eq "Float")
61        {
62                return chr(0) . encodedouble($n);
63        }
64        elsif ($type eq "NilClass")
65        {
66                return chr(5);
67        }
68}
69
70
71sub encodestring
72{
73        my $n= shift;
74       
75        return chr(int(length($n)/256)) . chr(length($n)%256) . $n;
76}
77
78sub encodedouble
79{
80        return reverse(pack("d", shift));
81}
82
83
84sub encodelong
85{
86        return pack("N", shift);
87}
88
89####################################
90
91sub getbyte
92{
93        my $st= shift;
94        my $c= unpack("C", $st->read(1) );
95        return $c;
96}
97
98sub getint
99{
100        my $st= shift;
101        my $i= unpack("n", $st->read(2) );
102        return $i;
103}
104
105sub getlong
106{
107        my $st= shift;
108        my $l= unpack("N", $st->read(4) );
109        return $l;
110}
111
112sub getstring
113{
114        my $st= shift;
115       
116        my $len= unpack("n", $st->read(2) );
117        my $str= $st->read($len);
118        return $str;
119}
120
121sub getdouble
122{
123        my $st= shift;
124        my $s= $st->read(8);
125        my $d= unpack("d", reverse($s));
126        return $d;
127}
128
129sub getarray
130{
131        my $st= shift;
132        my $len= unpack("N", $st->read(4) );
133        my @a;
134        for(my $i=0; $i<$len; $i++)
135        {
136                push(@a, getvalue($st));
137        }
138        return @a; # v1
139#       return \@a; # v2
140}
141
142sub getvalue
143{
144        my $st= shift;
145        my $type= unpack("C", $st->read(1) );
146        if    ($type== 0) { return getdouble($st); }
147        elsif ($type== 1) { return getbyte($st); }
148        elsif ($type== 2) { return getstring($st); }
149        elsif ($type== 3) { die "not yet implemented"; return 1; } # fixme: not yet implemented
150        elsif ($type== 5) { return 0; }
151        elsif ($type== 6) { return 0; }
152        elsif ($type== 8) { die "not yet implemented"; return 1; } # fixme: not yet implemented
153        elsif ($type==10) { return getarray($st); }
154}
155
156
157
158
159############################################################################
160
161my $amf;
162
163my $url= "http://www.openstreetmap.org/api/0.6/amf/read";
164
165my @bbox= (-1.4916, 51.86895, -1.47949, 51.88447); # west, south, eeast, north
166
167
168$amf = chr(0) . chr(0);                                         # FP8
169$amf.= chr(0) . chr(0);                                         # no headers
170$amf.= chr(0) . chr(1);                                         # one body
171
172$amf.= encodestring("whichways_deleted");       # message
173$amf.= encodestring("1", "String");                     # unique ID for this message
174$amf.= encodelong(0);                                           # size of body in bytes, Potlatch ignores this
175$amf.= encodevalue(\@bbox);                                     # argument
176
177
178
179my $ua = LWP::UserAgent->new;
180$ua->agent("amf_finddeleted.pl");
181
182my $req = HTTP::Request->new(POST => $url);
183$req->content_type("application/x-www-form-urlencoded");
184$req->content($amf);
185
186
187# Pass request to the user agent and get a response back
188my $res = $ua->post($url, "Content-Type" => "application/x-www-form-urlencoded", Content => $amf);
189
190# Check the outcome of the response
191if ($res->is_success) 
192{
193        my $r= $res->content;
194
195        my ($junk)= ($r=~ /^(.{6})/gsc);
196       
197        my $sio= MiniStringIO->new($r);
198        $sio->read(6);
199
200        my $s1= getstring($sio);
201        my $s2= getstring($sio);
202        my $lo= getlong($sio);
203        #printf("%s %s %ld\n", $s1, $s2, $lo); # dbg
204
205        my @ways= getvalue($sio);
206        printf("%s\n", join(",", @ways) );
207}
208else 
209{
210        print $res->status_line, "\n";
211}
212
Note: See TracBrowser for help on using the repository browser.