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 |