| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Mojolicious::Plugin::Vparam::Address; |
|
2
|
72
|
|
|
72
|
|
3757365
|
use Mojo::Base -strict; |
|
|
72
|
|
|
|
|
8088
|
|
|
|
72
|
|
|
|
|
524
|
|
|
3
|
72
|
|
|
72
|
|
8235
|
use Mojolicious::Plugin::Vparam::Common qw(load_class decode_json); |
|
|
72
|
|
|
|
|
147
|
|
|
|
72
|
|
|
|
|
4227
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
72
|
|
|
72
|
|
890
|
use Mojo::JSON; |
|
|
72
|
|
|
|
|
12684
|
|
|
|
72
|
|
|
|
|
2413
|
|
|
6
|
72
|
|
|
72
|
|
360
|
use Digest::MD5 qw(md5_hex); |
|
|
72
|
|
|
|
|
149
|
|
|
|
72
|
|
|
|
|
2713
|
|
|
7
|
72
|
|
|
72
|
|
373
|
use Encode qw(encode is_utf8); |
|
|
72
|
|
|
|
|
139
|
|
|
|
72
|
|
|
|
|
72656
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
|
11
|
33
|
|
|
33
|
0
|
63
|
my ($class, $opts) = @_; |
|
12
|
33
|
|
|
|
|
109
|
return bless $opts => $class; |
|
13
|
|
|
|
|
|
|
} |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head2 parse $str |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
Parse address from string |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=cut |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub parse { |
|
22
|
34
|
|
|
34
|
1
|
63
|
my ($class, $str) = @_; |
|
23
|
|
|
|
|
|
|
|
|
24
|
34
|
100
|
|
|
|
86
|
return undef unless defined $str; |
|
25
|
32
|
|
|
|
|
59
|
my ($full, $address, $lon, $lat, $md5, $id, $type, $lang, $opt); |
|
26
|
|
|
|
|
|
|
|
|
27
|
32
|
100
|
66
|
|
|
242
|
if( $str =~ m{^\s*\[} and $str =~ m{\]\s*$} ) { |
|
28
|
|
|
|
|
|
|
# JSON format |
|
29
|
12
|
|
|
|
|
39
|
my $json = decode_json $str; |
|
30
|
12
|
50
|
33
|
|
|
1903
|
if( $json and 'ARRAY' eq ref($json)) { |
|
31
|
12
|
|
100
|
|
|
143
|
$full = sprintf '%s : %s , %s', |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$json->[2]//'', $json->[3]//'', $json->[4]//''; |
|
33
|
12
|
|
|
|
|
23
|
$address = $json->[2]; |
|
34
|
12
|
|
|
|
|
17
|
$lon = $json->[3]; |
|
35
|
12
|
|
|
|
|
16
|
$lat = $json->[4]; |
|
36
|
12
|
|
|
|
|
18
|
$id = $json->[0]; |
|
37
|
12
|
|
|
|
|
18
|
$type = $json->[1]; |
|
38
|
12
|
|
|
|
|
16
|
$lang = $json->[5]; |
|
39
|
12
|
100
|
|
|
|
36
|
$opt = 'ARRAY' eq ref($json->[6]) |
|
40
|
|
|
|
|
|
|
? $class->new($json->[6]) |
|
41
|
|
|
|
|
|
|
: $json->[6]; |
|
42
|
|
|
|
|
|
|
} |
|
43
|
|
|
|
|
|
|
} else { |
|
44
|
|
|
|
|
|
|
# Text format |
|
45
|
20
|
|
|
|
|
180
|
($full, $address, $lon, $lat, $md5) = $str =~ m{^ |
|
46
|
|
|
|
|
|
|
( |
|
47
|
|
|
|
|
|
|
\s* |
|
48
|
|
|
|
|
|
|
# address |
|
49
|
|
|
|
|
|
|
(\S.*?) |
|
50
|
|
|
|
|
|
|
\s*:\s* |
|
51
|
|
|
|
|
|
|
# longitude |
|
52
|
|
|
|
|
|
|
(-?\d{1,3}(?:\.\d+)?) |
|
53
|
|
|
|
|
|
|
\s*,\s* |
|
54
|
|
|
|
|
|
|
# latitude |
|
55
|
|
|
|
|
|
|
(-?\d{1,3}(?:\.\d+)?) |
|
56
|
|
|
|
|
|
|
\s* |
|
57
|
|
|
|
|
|
|
) |
|
58
|
|
|
|
|
|
|
# md5 |
|
59
|
|
|
|
|
|
|
(?:\[\s*(\w*)\s*\])? |
|
60
|
|
|
|
|
|
|
\s* |
|
61
|
|
|
|
|
|
|
$}x; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
|
|
64
|
32
|
|
|
|
|
129
|
return $class->new([ |
|
65
|
|
|
|
|
|
|
$address, $lon, $lat, $md5, $full, $id, $type, $lang, $opt |
|
66
|
|
|
|
|
|
|
]); |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 check_secret $secret |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Check address sign for $secret |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=cut |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub check_secret { |
|
76
|
23
|
|
|
23
|
1
|
44
|
my ($self, $secret) = @_; |
|
77
|
23
|
50
|
|
|
|
56
|
return 1 unless defined $secret; |
|
78
|
23
|
100
|
|
|
|
66
|
return 1 unless length $secret; |
|
79
|
8
|
100
|
|
|
|
19
|
return 0 unless defined $self->md5; |
|
80
|
|
|
|
|
|
|
|
|
81
|
7
|
|
|
|
|
18
|
my $check = $secret . $self->fullname; |
|
82
|
7
|
50
|
|
|
|
46
|
$check = encode utf8 => $check if is_utf8 $check; |
|
83
|
7
|
|
|
|
|
275
|
return $self->md5 eq md5_hex( $check ); |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
|
|
86
|
73
|
|
|
73
|
0
|
1454
|
sub address { return $_[0]->[0]; } |
|
87
|
23
|
|
|
23
|
0
|
96
|
sub lon { return $_[0]->[1]; } |
|
88
|
23
|
|
|
23
|
0
|
87
|
sub lat { return $_[0]->[2]; } |
|
89
|
27
|
|
|
27
|
0
|
120
|
sub md5 { return $_[0]->[3]; } |
|
90
|
9
|
|
|
9
|
0
|
32
|
sub fullname { return $_[0]->[4]; } |
|
91
|
|
|
|
|
|
|
|
|
92
|
2
|
|
|
2
|
0
|
41
|
sub id { return $_[0]->[5]; } |
|
93
|
39
|
|
|
39
|
0
|
134
|
sub type { return $_[0]->[6]; } |
|
94
|
2
|
|
|
2
|
0
|
11
|
sub lang { return $_[0]->[7]; } |
|
95
|
|
|
|
|
|
|
|
|
96
|
23
|
|
|
23
|
0
|
104
|
sub opt { return $_[0]->[8]; } |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub is_extra { |
|
99
|
3
|
|
|
3
|
0
|
13
|
my ($self) = @_; |
|
100
|
3
|
100
|
|
|
|
8
|
return 0 unless defined $self->opt; |
|
101
|
2
|
100
|
66
|
|
|
6
|
return 1 if not ref( $self->opt ) and $self->opt eq 'extra'; |
|
102
|
1
|
|
|
|
|
7
|
return 0; |
|
103
|
|
|
|
|
|
|
} |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub is_near { |
|
106
|
5
|
|
|
5
|
0
|
12
|
my ($self) = @_; |
|
107
|
5
|
50
|
|
|
|
10
|
return 0 unless defined $self->opt; |
|
108
|
5
|
50
|
|
|
|
9
|
return 1 if ref( $self->opt ); |
|
109
|
0
|
|
|
|
|
0
|
return 0; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub near { |
|
113
|
4
|
|
|
4
|
0
|
9
|
my ($self) = @_; |
|
114
|
4
|
50
|
|
|
|
8
|
return unless $self->is_near; |
|
115
|
4
|
|
|
|
|
9
|
return $self->opt; |
|
116
|
|
|
|
|
|
|
} |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub check_address($;$) { |
|
119
|
34
|
|
|
34
|
0
|
69
|
my ($self, $secret) = (@_); |
|
120
|
34
|
100
|
|
|
|
83
|
return 'Value not defined' unless defined $self; |
|
121
|
32
|
50
|
|
|
|
82
|
return 'Wrong format' unless ref $self; |
|
122
|
32
|
100
|
|
|
|
74
|
return 'Wrong format' unless defined $self->address; |
|
123
|
24
|
50
|
|
|
|
44
|
return 'Wrong format' unless length $self->address; |
|
124
|
|
|
|
|
|
|
|
|
125
|
24
|
100
|
|
|
|
74
|
if( $self->type ) { |
|
126
|
10
|
100
|
|
|
|
19
|
if( $self->type eq 'p' ) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Standart point type |
|
128
|
|
|
|
|
|
|
|
|
129
|
8
|
|
|
|
|
20
|
my $e = load_class('Mojolicious::Plugin::Vparam::Numbers'); |
|
130
|
8
|
50
|
|
|
|
741
|
die $e if $e; |
|
131
|
|
|
|
|
|
|
|
|
132
|
8
|
|
|
|
|
20
|
my $lon = Mojolicious::Plugin::Vparam::Numbers::check_lon( |
|
133
|
|
|
|
|
|
|
$self->lon |
|
134
|
|
|
|
|
|
|
); |
|
135
|
8
|
50
|
|
|
|
22
|
return $lon if $lon; |
|
136
|
|
|
|
|
|
|
|
|
137
|
8
|
|
|
|
|
20
|
my $lat = Mojolicious::Plugin::Vparam::Numbers::check_lat( |
|
138
|
|
|
|
|
|
|
$self->lat |
|
139
|
|
|
|
|
|
|
); |
|
140
|
8
|
50
|
|
|
|
20
|
return $lat if $lat; |
|
141
|
|
|
|
|
|
|
} elsif( $self->type eq 't' ) { |
|
142
|
|
|
|
|
|
|
# Some text without point |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
} elsif( not defined $self->type ) { |
|
145
|
|
|
|
|
|
|
# Undefined type (legacy) |
|
146
|
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
0
|
my $e = load_class('Mojolicious::Plugin::Vparam::Numbers'); |
|
148
|
0
|
0
|
|
|
|
0
|
die $e if $e; |
|
149
|
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
0
|
my $lon = Mojolicious::Plugin::Vparam::Numbers::check_lon( |
|
151
|
|
|
|
|
|
|
$self->lon |
|
152
|
|
|
|
|
|
|
); |
|
153
|
0
|
0
|
|
|
|
0
|
return $lon if $lon; |
|
154
|
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
0
|
my $lat = Mojolicious::Plugin::Vparam::Numbers::check_lat( |
|
156
|
|
|
|
|
|
|
$self->lat |
|
157
|
|
|
|
|
|
|
); |
|
158
|
0
|
0
|
|
|
|
0
|
return $lat if $lat; |
|
159
|
|
|
|
|
|
|
} else { |
|
160
|
1
|
|
|
|
|
4
|
return 'Unknown type'; |
|
161
|
|
|
|
|
|
|
} |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
23
|
100
|
|
|
|
61
|
return 'Unknown source' unless $self->check_secret( $secret ); |
|
165
|
20
|
|
|
|
|
72
|
return 0; |
|
166
|
|
|
|
|
|
|
} |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub register { |
|
170
|
74
|
|
|
74
|
0
|
225
|
my ($class, $self, $app, $conf) = @_; |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
$app->vtype( |
|
173
|
|
|
|
|
|
|
address => |
|
174
|
|
|
|
|
|
|
load => 'Mojolicious::Plugin::Vparam::Address', |
|
175
|
|
|
|
|
|
|
pre => sub { |
|
176
|
34
|
|
|
34
|
|
116
|
return Mojolicious::Plugin::Vparam::Address->parse( $_[1] ); |
|
177
|
|
|
|
|
|
|
}, |
|
178
|
34
|
|
|
34
|
|
94
|
valid => sub { check_address($_[1], $conf->{address_secret}) }, |
|
179
|
74
|
|
|
|
|
1307
|
); |
|
180
|
|
|
|
|
|
|
|
|
181
|
74
|
|
|
|
|
465
|
return; |
|
182
|
|
|
|
|
|
|
} |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
1; |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head1 AUTHORS |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Dmitry E. Oboukhov <unera@debian.org> |
|
189
|
|
|
|
|
|
|
Roman V. Nikolaev <rshadow@rambler.ru> |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Copyright (C) 2011 Dmitry E. Oboukhov <unera@debian.org> |
|
194
|
|
|
|
|
|
|
Copyright (C) 2011 Roman V. Nikolaev <rshadow@rambler.ru> |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
This program is free software, you can redistribute it and/or |
|
197
|
|
|
|
|
|
|
modify it under the terms of the Artistic License. |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=cut |