line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id$ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# string::parse Brik |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
package Metabrik::String::Parse; |
7
|
1
|
|
|
1
|
|
781
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
8
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use base qw(Metabrik); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
819
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub brik_properties { |
13
|
|
|
|
|
|
|
return { |
14
|
0
|
|
|
0
|
1
|
|
revision => '$Revision$', |
15
|
|
|
|
|
|
|
tags => [ qw(unstable) ], |
16
|
|
|
|
|
|
|
author => 'GomoR ', |
17
|
|
|
|
|
|
|
license => 'http://opensource.org/licenses/BSD-3-Clause', |
18
|
|
|
|
|
|
|
commands => { |
19
|
|
|
|
|
|
|
identify => [ qw(string) ], |
20
|
|
|
|
|
|
|
to_array => [ qw($data) ], |
21
|
|
|
|
|
|
|
to_matrix => [ qw($data) ], |
22
|
|
|
|
|
|
|
split_by_blank_line => [ qw($data) ], |
23
|
|
|
|
|
|
|
}, |
24
|
|
|
|
|
|
|
}; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub to_array { |
28
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
29
|
0
|
|
|
|
|
|
my ($data) = @_; |
30
|
|
|
|
|
|
|
|
31
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('to_array', $data) or return; |
32
|
0
|
0
|
|
|
|
|
$self->brik_help_run_invalid_arg('to_array', $data, 'SCALAR') or return; |
33
|
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
|
my @array = split(/\n/, $data); |
35
|
|
|
|
|
|
|
|
36
|
0
|
|
|
|
|
|
return \@array; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub to_matrix { |
40
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
41
|
0
|
|
|
|
|
|
my ($data) = @_; |
42
|
|
|
|
|
|
|
|
43
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('to_matrix', $data) or return; |
44
|
|
|
|
|
|
|
|
45
|
0
|
0
|
|
|
|
|
my $array = $self->to_array($data) or return; |
46
|
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
my @matrix = (); |
48
|
0
|
|
|
|
|
|
for my $this (@$array) { |
49
|
0
|
|
|
|
|
|
push @matrix, [ split(/\s+/, $this) ]; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
return \@matrix; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub identify { |
56
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
57
|
0
|
|
|
|
|
|
my ($string) = @_; |
58
|
|
|
|
|
|
|
|
59
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('identify', $string) or return; |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
my $length = length($string); |
62
|
|
|
|
|
|
|
# Truncate to 128 Bytes |
63
|
0
|
0
|
|
|
|
|
my $subset = substr($string, 0, $length > 128 ? 128 : $length); |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
my $identify = [ 'text' ]; # Default dump text string |
66
|
|
|
|
|
|
|
|
67
|
0
|
0
|
0
|
|
|
|
if ($subset =~ /^/i) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
push @$identify, 'html'; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
elsif ($subset =~ /^
|
71
|
0
|
|
|
|
|
|
push @$identify, 'xml'; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
elsif ($subset =~ /^\s*{\s+["a-zA-Z0-9:]+\s+/) { |
74
|
0
|
|
|
|
|
|
push @$identify, 'json'; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
elsif ($string =~ /^[a-zA-Z0-9+]+={1,2}$/) { |
77
|
0
|
|
|
|
|
|
push @$identify, 'base64'; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
elsif ($length == 32 && $string =~ /^[a-f0-9]+$/) { |
80
|
0
|
|
|
|
|
|
push @$identify, 'md5'; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
elsif ($length == 40 && $string =~ /^[a-f0-9]+$/) { |
83
|
0
|
|
|
|
|
|
push @$identify, 'sha1'; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
elsif ($length == 64 && $string =~ /^[a-f0-9]+$/) { |
86
|
0
|
|
|
|
|
|
push @$identify, 'sha256'; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
return $identify; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub split_by_blank_line { |
93
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
94
|
0
|
|
|
|
|
|
my ($data) = @_; |
95
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('split_by_blank_line', $data) or return; |
97
|
0
|
0
|
|
|
|
|
$self->brik_help_run_invalid_arg('split_by_blank_line', $data, 'ARRAY') or return; |
98
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
my $new = []; |
100
|
0
|
|
|
|
|
|
my @chunks = (); |
101
|
0
|
|
|
|
|
|
for (@$data) { |
102
|
0
|
0
|
0
|
|
|
|
if (/^\s*$/ && @$new > 0) { |
103
|
0
|
|
|
|
|
|
push @chunks, $new; |
104
|
0
|
|
|
|
|
|
$new = []; |
105
|
0
|
|
|
|
|
|
next; |
106
|
|
|
|
|
|
|
} |
107
|
0
|
|
|
|
|
|
push @$new, $_; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Read last lines before eof (no more blank lines can be found) |
111
|
0
|
0
|
|
|
|
|
if (@$new > 0) { |
112
|
0
|
|
|
|
|
|
push @chunks, $new; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
return \@chunks; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
1; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
__END__ |