line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::App::URLMux; |
2
|
|
|
|
|
|
|
|
3
|
9
|
|
|
9
|
|
517811
|
use strict; |
|
9
|
|
|
|
|
79
|
|
|
9
|
|
|
|
|
199
|
|
4
|
9
|
|
|
9
|
|
88
|
use v5.22; |
|
9
|
|
|
|
|
50
|
|
5
|
9
|
|
|
9
|
|
4175
|
use experimental qw(signatures postderef); |
|
9
|
|
|
|
|
24836
|
|
|
9
|
|
|
|
|
39
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.08'; |
7
|
|
|
|
|
|
|
|
8
|
9
|
|
|
9
|
|
4394
|
use parent qw(Plack::Component); |
|
9
|
|
|
|
|
1871
|
|
|
9
|
|
|
|
|
38
|
|
9
|
9
|
|
|
9
|
|
95496
|
use Carp qw(croak); |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
379
|
|
10
|
|
|
|
|
|
|
|
11
|
9
|
|
|
9
|
|
43
|
use constant MAX_FINE => 65535; # if URL will contains url-path segments more than this number - increment it :) |
|
9
|
|
|
|
|
18
|
|
|
9
|
|
|
|
|
402
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# map[] structure constants |
14
|
9
|
|
|
9
|
|
39
|
use constant _keys => 0; # hash of url-path segments => map[] |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
322
|
|
15
|
9
|
|
|
9
|
|
39
|
use constant _level => 1; # level of map tree |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
368
|
|
16
|
9
|
|
|
9
|
|
65
|
use constant _quant => 2; # rule for quantifier at branch, this value sensitive for _named array |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
364
|
|
17
|
9
|
|
|
9
|
|
51
|
use constant _app => 3; # reference to app on this leaf, undefined if does not mounted any |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
345
|
|
18
|
9
|
|
|
9
|
|
50
|
use constant _named => 4; # reference to map[], if url-path has named parameter then mapping searching in it |
|
9
|
|
|
|
|
13
|
|
|
9
|
|
|
|
|
375
|
|
19
|
9
|
|
|
9
|
|
40
|
use constant _names => 5; # array of [parameter, index], if app has parameters in the url format |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
326
|
|
20
|
9
|
|
|
9
|
|
37
|
use constant _params => 6; # array of pairs name=>value of input parameters specified at map |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
324
|
|
21
|
9
|
|
|
9
|
|
37
|
use constant _quants => 7; # array of quantifiers of each url-path segments for mounted app |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
338
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# _quant array constants |
24
|
9
|
|
|
9
|
|
43
|
use constant _quant_n => 0; # start range quanifier |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
460
|
|
25
|
9
|
|
|
9
|
|
45
|
use constant _quant_m => 1; # end range qunatifier, -1 unknown maximum as possible |
|
9
|
|
|
|
|
10
|
|
|
9
|
|
|
|
|
360
|
|
26
|
9
|
|
|
9
|
|
73
|
use constant _quant_r => 2; # rest of posible search path, -1 unknown, unusefull, FIXME delete this |
|
9
|
|
|
|
|
25
|
|
|
9
|
|
|
|
|
378
|
|
27
|
9
|
|
|
9
|
|
50
|
use constant _quant_h => 3; # greedy/lazy flag for search path and gather subpathes for parameter, 0 lazy, 1 greedy |
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
364
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# _params array constants |
30
|
9
|
|
|
9
|
|
41
|
use constant _param_name => 0; |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
343
|
|
31
|
9
|
|
|
9
|
|
43
|
use constant _param_index => 1; |
|
9
|
|
|
|
|
16
|
|
|
9
|
|
|
|
|
369
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# matched array constants |
34
|
9
|
|
|
9
|
|
40
|
use constant _match_map => 0; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
389
|
|
35
|
9
|
|
|
9
|
|
44
|
use constant _match_length => 1; |
|
9
|
|
|
|
|
14
|
|
|
9
|
|
|
|
|
514
|
|
36
|
9
|
|
|
9
|
|
53
|
use constant _match_fine => 2; |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
365
|
|
37
|
9
|
|
|
9
|
|
55
|
use constant _match_matching => 3; |
|
9
|
|
|
|
|
13
|
|
|
9
|
|
|
|
|
359
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# matching array constants |
40
|
9
|
|
|
9
|
|
62
|
use constant _matching_index => 0; |
|
9
|
|
|
|
|
34
|
|
|
9
|
|
|
|
|
439
|
|
41
|
9
|
|
|
9
|
|
50
|
use constant _matching_fine => 1; |
|
9
|
|
|
|
|
25
|
|
|
9
|
|
|
|
|
19591
|
|
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
0
|
1
|
0
|
sub mount { shift->map(@_) } |
44
|
|
|
|
|
|
|
|
45
|
29
|
|
|
29
|
1
|
1016
|
sub map($self, $location, $app, @input_params) { |
|
29
|
|
|
|
|
46
|
|
|
29
|
|
|
|
|
47
|
|
|
29
|
|
|
|
|
39
|
|
|
29
|
|
|
|
|
42
|
|
|
29
|
|
|
|
|
36
|
|
46
|
|
|
|
|
|
|
|
47
|
29
|
100
|
|
|
|
68
|
if ($location eq '') { |
48
|
|
|
|
|
|
|
croak "location 'not found' has already mount app" |
49
|
1
|
50
|
33
|
|
|
31
|
if exists $self->{_mapping_not_found} and defined $self->{_mapping_not_found}; |
50
|
1
|
|
|
|
|
3
|
$self->{_mapping_not_found} = $app; |
51
|
1
|
|
|
|
|
3
|
return; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
28
|
|
|
|
|
43
|
my $host = '*'; #any host |
55
|
28
|
100
|
|
|
|
79
|
if ($location =~ m/^https?:\/\/(.*?)(\/.*)/o) { |
56
|
5
|
|
|
|
|
23
|
$host = $1; |
57
|
5
|
|
|
|
|
14
|
$location = $2; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
28
|
50
|
|
|
|
90
|
croak "Path '$location' need to start with '/'" |
61
|
|
|
|
|
|
|
unless $location =~ m/^\//o; |
62
|
28
|
|
|
|
|
118
|
$location =~ s/^\/|\/$//go; |
63
|
|
|
|
|
|
|
|
64
|
28
|
|
|
|
|
71
|
my @paths = split('/', $location); |
65
|
|
|
|
|
|
|
|
66
|
28
|
|
|
|
|
67
|
my ($index, $params, $quants) = (0, [], []); |
67
|
28
|
|
100
|
|
|
358
|
my $map = $self->{_mapping}->{$host} ||= [{}, $index, [1, 0]]; # Zero mapping for URL '/' |
68
|
28
|
|
|
|
|
47
|
$index++; |
69
|
28
|
|
|
|
|
57
|
foreach my $path (@paths) { |
70
|
30
|
|
|
|
|
52
|
my $r = @paths - $index; |
71
|
|
|
|
|
|
|
|
72
|
30
|
100
|
|
|
|
130
|
if ($path =~ |
73
|
|
|
|
|
|
|
/^ |
74
|
|
|
|
|
|
|
\: |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
([^\:\+\*\?\{\}\,]+?) (?# 1: name of parameter ) |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
(?: |
79
|
|
|
|
|
|
|
(?: |
80
|
|
|
|
|
|
|
(\+|\*|\?) (?# 2: '+|*|?' quantifier ) |
81
|
|
|
|
|
|
|
(\??) (?# 3: '?' greedy|lazy flag ) |
82
|
|
|
|
|
|
|
) |
83
|
|
|
|
|
|
|
| (?: |
84
|
|
|
|
|
|
|
\{ |
85
|
|
|
|
|
|
|
(\d+) (?# 4: start range quantifier ) |
86
|
|
|
|
|
|
|
(?: |
87
|
|
|
|
|
|
|
(\,) (?# 5: range delimeter ) |
88
|
|
|
|
|
|
|
(\d+)* (?# 6: end range quantifier ) |
89
|
|
|
|
|
|
|
)* |
90
|
|
|
|
|
|
|
\} |
91
|
|
|
|
|
|
|
(\??) (?# 7: '?' greedy|lazy flag ) |
92
|
|
|
|
|
|
|
) |
93
|
|
|
|
|
|
|
)? |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$/xo |
96
|
|
|
|
|
|
|
){ |
97
|
15
|
50
|
100
|
|
|
127
|
my ($name, $quant, $n, $m, $h) = ($1, $2 || $5, $4, $6, (($3 || $7) ? 0 : 1)); |
|
|
|
33
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
15
|
100
|
|
|
|
36
|
($n, $m) = (0, -1 ) if $quant eq '*'; |
100
|
15
|
100
|
|
|
|
34
|
($n, $m) = (1, -1 ) if $quant eq '+'; |
101
|
15
|
50
|
|
|
|
29
|
($n, $m) = (0, 1 ) if $quant eq '?'; |
102
|
15
|
100
|
|
|
|
29
|
($n, $m) = ($n, ($m ? $m : -1) ) if $quant eq ','; |
|
|
100
|
|
|
|
|
|
103
|
15
|
50
|
|
|
|
36
|
($n, $m) = ($n = ($n ? $n : 1), $n ) if $quant eq ''; |
|
|
100
|
|
|
|
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
#check _named now named must be array but we must check |
106
|
15
|
|
|
|
|
44
|
push(@$params, [$name, $index]); |
107
|
15
|
|
|
|
|
68
|
push(@$quants, [$n, $m, $r, $h]); |
108
|
|
|
|
|
|
|
|
109
|
15
|
|
100
|
|
|
55
|
$map->[_named] ||= {}; |
110
|
15
|
|
100
|
|
|
100
|
$map = $map->[_named]->{"$n.$m"} ||= [{}, $index, [$n, $m]]; |
111
|
15
|
|
|
|
|
24
|
$index++; |
112
|
15
|
|
|
|
|
33
|
next; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
15
|
50
|
|
|
|
37
|
if ($path =~ /^\:/o) { |
116
|
0
|
|
|
|
|
0
|
croak "url '$location' is wrong, syntax sub path '$path' is incorrent, expect :[alphanum](*|+|?|{n,m})?\??"; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
#FIXME check than name contain only valid chars need check RFC for that |
120
|
|
|
|
|
|
|
|
121
|
15
|
|
100
|
|
|
95
|
$map = $map->[_keys]->{$path} ||= [{}, $index, [1, 1]]; |
122
|
15
|
|
|
|
|
54
|
push(@$quants, [1, 1, $r, 1]); |
123
|
15
|
|
|
|
|
30
|
$index++; |
124
|
15
|
|
|
|
|
26
|
next; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
28
|
50
|
|
|
|
63
|
croak "/$location has already mount app" |
129
|
|
|
|
|
|
|
if defined $map->[_app]; |
130
|
|
|
|
|
|
|
|
131
|
28
|
100
|
|
|
|
163
|
@$map[_app,_params,_names,_quants] = ($app, \@input_params, @$params ? $params : undef, $quants); |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
0
|
0
|
0
|
sub prepapre_app ($self) {} |
|
0
|
|
|
|
|
0
|
|
136
|
|
|
|
|
|
|
|
137
|
59
|
|
|
59
|
1
|
191063
|
sub call ($self, $env) { |
|
59
|
|
|
|
|
89
|
|
|
59
|
|
|
|
|
67
|
|
|
59
|
|
|
|
|
64
|
|
138
|
59
|
|
|
|
|
89
|
my ($matches, $params); |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
my ($http_host, $server_name, $script_name, $path_info) |
141
|
59
|
|
|
|
|
151
|
= $env->@{qw( HTTP_HOST SERVER_NAME SCRIPT_NAME PATH_INFO )}; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
#FIXME possible BUG |
144
|
|
|
|
|
|
|
# is there cases when port is not the same in HTTP_HOST and SERVER_PORT? |
145
|
59
|
50
|
33
|
|
|
259
|
if ($http_host and $env->{SERVER_PORT}) { |
146
|
59
|
|
|
|
|
112
|
$http_host =~ s/:\d+$//o; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
59
|
|
|
|
|
157
|
my @path = split('/', $path_info); |
150
|
59
|
|
|
|
|
83
|
shift @path; # remove zero |
151
|
|
|
|
|
|
|
|
152
|
59
|
|
|
|
|
110
|
my $mapping = $self->{_mapping}; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
my $matched = |
155
|
|
|
|
|
|
|
_matched( |
156
|
|
|
|
|
|
|
$self->search( |
157
|
59
|
|
66
|
|
|
379
|
$mapping->{$http_host} || $mapping->{$server_name} || $mapping->{'*'} |
158
|
|
|
|
|
|
|
, my $i = 0 |
159
|
|
|
|
|
|
|
, \@path |
160
|
|
|
|
|
|
|
, @path + 0 |
161
|
|
|
|
|
|
|
, [] |
162
|
|
|
|
|
|
|
) |
163
|
|
|
|
|
|
|
); |
164
|
|
|
|
|
|
|
|
165
|
59
|
100
|
|
|
|
144
|
unless ($matched) { |
166
|
|
|
|
|
|
|
return [404, [ 'Content-Type' => 'text/plain' ], [ "Not Found" ]] |
167
|
1
|
50
|
|
|
|
4
|
unless $self->{_mapping_not_found}; |
168
|
1
|
|
|
|
|
4
|
return $self->{_mapping_not_found}->($env); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
#now we have first matched rule and match path, we need fill params if they exists |
172
|
|
|
|
|
|
|
|
173
|
58
|
|
|
|
|
102
|
my ($match, $matching) = $matched->@[_match_map,_match_matching]; |
174
|
|
|
|
|
|
|
|
175
|
58
|
100
|
|
|
|
109
|
if (defined $match->[_names]) { |
176
|
29
|
|
|
|
|
32
|
my ($i, $j); |
177
|
|
|
|
|
|
|
$params = [ |
178
|
|
|
|
|
|
|
map { |
179
|
34
|
100
|
|
|
|
171
|
$_->[_param_name] => |
|
|
100
|
|
|
|
|
|
180
|
|
|
|
|
|
|
( |
181
|
|
|
|
|
|
|
( |
182
|
|
|
|
|
|
|
($j = $matching->[$_->[_param_index]-1]->[_matching_index] - 1) |
183
|
|
|
|
|
|
|
- |
184
|
|
|
|
|
|
|
($i = $_->[_param_index] - 1 > 0 ? $matching->[$_->[_param_index] - 2]->[_matching_index] : 0) |
185
|
|
|
|
|
|
|
) >= 0 |
186
|
|
|
|
|
|
|
? |
187
|
|
|
|
|
|
|
[(@path[$i..$j])] |
188
|
|
|
|
|
|
|
: |
189
|
|
|
|
|
|
|
[] |
190
|
|
|
|
|
|
|
) |
191
|
29
|
|
|
|
|
31
|
} @{$match->[_names]} |
|
29
|
|
|
|
|
40
|
|
192
|
|
|
|
|
|
|
]; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
58
|
|
|
|
|
95
|
my $index = $matching->[-1]->[_matching_index]; |
196
|
|
|
|
|
|
|
#clone input params, couse they may be mutated by middlewire |
197
|
|
|
|
|
|
|
@$env{qw( plack.urlmux.params.map plack.urlmux.params.url SCRIPT_NAME PATH_INFO )} |
198
|
|
|
|
|
|
|
= ( |
199
|
58
|
100
|
100
|
|
|
75
|
[@{$match->[_params]}] |
|
58
|
50
|
|
|
|
503
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
200
|
|
|
|
|
|
|
, $params || [] |
201
|
|
|
|
|
|
|
, ($script_name ? $script_name : $index ? '/' : '') . join('/', (@path[0..($index-1)])) |
202
|
|
|
|
|
|
|
, ($index == @path ? @path ? '' : '/' : '/') . join('/', (@path[$index..(@path-1)])) |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
return $self->response_cb($match->[_app]->($env), sub { |
206
|
58
|
|
|
58
|
|
3906
|
$env->@{qw( PATH_INFO SCRIPT_NAME )} = ($path_info, $script_name); |
207
|
58
|
|
|
|
|
178
|
}); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
202
|
|
|
202
|
0
|
212
|
sub search ($self, $map, $index, $parts, $l, $matching) { |
|
202
|
|
|
|
|
215
|
|
|
202
|
|
|
|
|
227
|
|
|
202
|
|
|
|
|
263
|
|
|
202
|
|
|
|
|
225
|
|
|
202
|
|
|
|
|
201
|
|
|
202
|
|
|
|
|
210
|
|
|
202
|
|
|
|
|
187
|
|
211
|
|
|
|
|
|
|
|
212
|
202
|
|
|
|
|
251
|
my $path = $parts->[$index]; |
213
|
202
|
|
|
|
|
353
|
my ($_app, $_keys, $_named) = $map->@[_app,_keys,_named]; |
214
|
|
|
|
|
|
|
|
215
|
202
|
|
|
|
|
231
|
my $matches = []; |
216
|
|
|
|
|
|
|
|
217
|
202
|
100
|
|
|
|
352
|
if (exists $_keys->{$path}) { |
218
|
30
|
50
|
|
|
|
63
|
if ($index < $l) { |
219
|
30
|
|
|
|
|
39
|
push(@$matches, (@{$self->search($_keys->{$path}, $index + 1, $parts, $l, [(@$matching), [$index+1, 0]])})); |
|
30
|
|
|
|
|
148
|
|
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else { |
222
|
0
|
0
|
|
|
|
0
|
if (defined $_keys->{$path}->[_app]) { |
223
|
0
|
|
|
|
|
0
|
my $match = [$_keys->{$path}, $index + 1, 0, [(@$matching), [$index+1, 0]]]; |
224
|
0
|
|
|
|
|
0
|
push (@$matches, $match); |
225
|
0
|
|
|
|
|
0
|
map {$match->[_match_fine] += $_->[_matching_fine]} @{$match->[_match_matching]}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
202
|
100
|
|
|
|
305
|
if (defined $_named) { |
231
|
47
|
|
|
|
|
52
|
foreach my $quant (values %{$_named}) { |
|
47
|
|
|
|
|
93
|
|
232
|
77
|
|
|
|
|
147
|
my ($n, $m) = $quant->[_quant]->@[_quant_n,_quant_m]; |
233
|
77
|
100
|
|
|
|
161
|
my ($ln, $lm) = ($index + $n, ($m==-1 ? MAX_FINE : $index + $m)); |
234
|
77
|
|
|
|
|
115
|
my $matches_ = []; |
235
|
77
|
100
|
|
|
|
165
|
for ($ln .. ($lm > $l ? $l : $lm)) { |
236
|
168
|
100
|
|
|
|
223
|
if ($_ < $l) { |
237
|
113
|
|
|
|
|
126
|
push(@$matches_ , (@{$self->search($quant, $_, $parts, $l, [(@$matching), [$_, $lm - $ln + 1]])})); |
|
113
|
|
|
|
|
274
|
|
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
else { |
240
|
55
|
100
|
|
|
|
90
|
if (defined $quant->[_app]) { |
241
|
39
|
|
|
|
|
79
|
my $match = [$quant, $_, 0, [(@$matching), [$_, $lm - $ln + 1]]]; |
242
|
39
|
|
|
|
|
64
|
push(@$matches_, $match); |
243
|
39
|
|
|
|
|
41
|
map {$match->[_match_fine] += $_->[_matching_fine]} @{$match->[_match_matching]}; |
|
60
|
|
|
|
|
92
|
|
|
39
|
|
|
|
|
63
|
|
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
77
|
100
|
|
|
|
133
|
next unless @$matches_; |
248
|
55
|
|
|
|
|
97
|
push(@$matches, _matched_greedy($matches_, $index)); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
202
|
100
|
|
|
|
306
|
if (defined $_app) { |
253
|
151
|
|
|
|
|
311
|
my $match = [$map, $index, 0, [(@$matching), [$index, 0]]]; |
254
|
151
|
|
|
|
|
197
|
push(@$matches, $match); |
255
|
151
|
|
|
|
|
155
|
map {$match->[_match_fine] += $_->[_matching_fine]} @{$match->[_match_matching]}; |
|
284
|
|
|
|
|
403
|
|
|
151
|
|
|
|
|
228
|
|
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
202
|
|
|
|
|
410
|
return $matches; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
59
|
|
|
59
|
|
68
|
sub _matched ($matches) { |
|
59
|
|
|
|
|
63
|
|
|
59
|
|
|
|
|
65
|
|
263
|
|
|
|
|
|
|
|
264
|
59
|
100
|
|
|
|
124
|
return unless @$matches; |
265
|
58
|
100
|
|
|
|
107
|
return $matches->[0] if @$matches == 1; |
266
|
|
|
|
|
|
|
|
267
|
37
|
|
|
|
|
43
|
my $match; |
268
|
|
|
|
|
|
|
|
269
|
37
|
|
|
|
|
56
|
foreach (@$matches) { |
270
|
93
|
100
|
|
|
|
135
|
unless (defined $match) { |
271
|
37
|
|
|
|
|
42
|
$match = $_; |
272
|
37
|
|
|
|
|
55
|
next; |
273
|
|
|
|
|
|
|
} |
274
|
56
|
100
|
|
|
|
102
|
if ($_->[_match_length] < $match->[_match_length]) { |
275
|
37
|
|
|
|
|
50
|
next; |
276
|
|
|
|
|
|
|
} |
277
|
19
|
100
|
|
|
|
28
|
if ($_->[_match_length] > $match->[_match_length]) { |
278
|
3
|
|
|
|
|
4
|
$match = $_; |
279
|
3
|
|
|
|
|
3
|
next; |
280
|
|
|
|
|
|
|
} |
281
|
16
|
100
|
|
|
|
36
|
if ($_->[_match_fine] < $match->[_match_fine]) { |
282
|
2
|
|
|
|
|
3
|
$match = $_; |
283
|
2
|
|
|
|
|
3
|
next; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
} |
286
|
37
|
|
|
|
|
58
|
return $match; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
55
|
|
|
55
|
|
56
|
sub _matched_greedy ($matches, $index) { |
|
55
|
|
|
|
|
60
|
|
|
55
|
|
|
|
|
55
|
|
|
55
|
|
|
|
|
53
|
|
290
|
|
|
|
|
|
|
|
291
|
55
|
50
|
|
|
|
79
|
return unless @$matches; |
292
|
55
|
100
|
|
|
|
147
|
return $matches->[0] if @$matches == 1; |
293
|
|
|
|
|
|
|
|
294
|
35
|
|
|
|
|
58
|
my $greedy = $matches->[0]->[_match_map]->[_quants]->[$index-1]->[_quant_h]; |
295
|
|
|
|
|
|
|
|
296
|
35
|
|
|
|
|
38
|
my $match; |
297
|
35
|
|
|
|
|
48
|
foreach (@$matches) { |
298
|
111
|
100
|
|
|
|
144
|
unless (defined $match) { |
299
|
35
|
|
|
|
|
50
|
$match = $_; |
300
|
35
|
|
|
|
|
44
|
next; |
301
|
|
|
|
|
|
|
} |
302
|
76
|
100
|
|
|
|
117
|
if ($_->[_match_length] < $match->[_match_length]) { |
303
|
10
|
|
|
|
|
12
|
next; |
304
|
|
|
|
|
|
|
} |
305
|
66
|
100
|
|
|
|
94
|
if ($_->[_match_length] > $match->[_match_length] ) { |
306
|
63
|
|
|
|
|
57
|
$match = $_; |
307
|
63
|
|
|
|
|
74
|
next; |
308
|
|
|
|
|
|
|
} |
309
|
3
|
50
|
|
|
|
5
|
if ($greedy) { |
310
|
3
|
50
|
|
|
|
8
|
if ($_->[_match_matching]->[$index-1]->[_matching_index] > $match->[_match_matching]->[$index-1]->[_matching_index]) { |
311
|
0
|
|
|
|
|
0
|
$match = $_; |
312
|
0
|
|
|
|
|
0
|
next; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else { |
316
|
0
|
0
|
|
|
|
0
|
if ($_->[_match_matching]->[$index-1]->[_matching_index] < $match->[_match_matching]->[$index-1]->[_matching_index]) { |
317
|
0
|
|
|
|
|
0
|
$match = $_; |
318
|
0
|
|
|
|
|
0
|
next; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
35
|
|
|
|
|
101
|
return $match; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
1; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
__END__ |