source: repository/lib/Metabrik/String/Parse.pm

METABRIK_REPOSITORY_1_30_0
Last change on this file was 954:6fa51436f298, checked in by GomoR <gomor@…>, 9 months ago
  • update: copyright notice to 2018
File size: 2.8 KB
Line 
1#
2# $Id$
3#
4# string::parse Brik
5#
6package Metabrik::String::Parse;
7use strict;
8use warnings;
9
10use base qw(Metabrik);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
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
27sub to_array {
28   my $self = shift;
29   my ($data) = @_;
30
31   $self->brik_help_run_undef_arg('to_array', $data) or return;
32   $self->brik_help_run_invalid_arg('to_array', $data, 'SCALAR') or return;
33
34   my @array = split(/\n/, $data);
35
36   return \@array;
37}
38
39sub to_matrix {
40   my $self = shift;
41   my ($data) = @_;
42
43   $self->brik_help_run_undef_arg('to_matrix', $data) or return;
44
45   my $array = $self->to_array($data) or return;
46
47   my @matrix = ();
48   for my $this (@$array) {
49      push @matrix, [ split(/\s+/, $this) ];
50   }
51
52   return \@matrix;
53}
54
55sub identify {
56   my $self = shift;
57   my ($string) = @_;
58
59   $self->brik_help_run_undef_arg('identify', $string) or return;
60
61   my $length = length($string);
62   # Truncate to 128 Bytes
63   my $subset = substr($string, 0, $length > 128 ? 128 : $length);
64
65   my $identify = [ 'text' ]; # Default dump text string
66
67   if ($subset =~ /^<html>/i) {
68      push @$identify, 'html';
69   }
70   elsif ($subset =~ /^<xml /i) {
71      push @$identify, 'xml';
72   }
73   elsif ($subset =~ /^\s*{\s+["a-zA-Z0-9:]+\s+/) {
74      push @$identify, 'json';
75   }
76   elsif ($string =~ /^[a-zA-Z0-9+]+={1,2}$/) {
77      push @$identify, 'base64';
78   }
79   elsif ($length == 32 && $string =~ /^[a-f0-9]+$/) {
80      push @$identify, 'md5';
81   }
82   elsif ($length == 40 && $string =~ /^[a-f0-9]+$/) {
83      push @$identify, 'sha1';
84   }
85   elsif ($length == 64 && $string =~ /^[a-f0-9]+$/) {
86      push @$identify, 'sha256';
87   }
88
89   return $identify;
90}
91
92sub split_by_blank_line {
93   my $self = shift;
94   my ($data) = @_;
95
96   $self->brik_help_run_undef_arg('split_by_blank_line', $data) or return;
97   $self->brik_help_run_invalid_arg('split_by_blank_line', $data, 'ARRAY') or return;
98
99   my $new = [];
100   my @chunks = ();
101   for (@$data) {
102      if (/^\s*$/ && @$new > 0) {
103         push @chunks, $new;
104         $new = [];
105         next;
106      }
107      push @$new, $_;
108   }
109
110   # Read last lines before eof (no more blank lines can be found)
111   if (@$new > 0) {
112      push @chunks, $new;
113   }
114
115   return \@chunks;
116}
117
1181;
119
120__END__
121
122=head1 NAME
123
124Metabrik::String::Parse - string::parse Brik
125
126=head1 COPYRIGHT AND LICENSE
127
128Copyright (c) 2014-2018, Patrice E<lt>GomoRE<gt> Auffret
129
130You may distribute this module under the terms of The BSD 3-Clause License.
131See LICENSE file in the source distribution archive.
132
133=head1 AUTHOR
134
135Patrice E<lt>GomoRE<gt> Auffret
136
137=cut
Note: See TracBrowser for help on using the repository browser.