File Coverage

blib/lib/Metabrik/String/Parse.pm

Criterion	Covered	Total	%
statement	9	54	16.6
branch	0	34	0.0
condition	0	12	0.0
subroutine	3	8	37.5
pod	1	5	20.0
total	13	113	11.5

#
# $Id$
#
# string::parse Brik
#
package Metabrik::String::Parse;
use strict;
use warnings;

use base qw(Metabrik);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      commands => {
         identify => [ qw(string) ],
         to_array => [ qw($data) ],
         to_matrix => [ qw($data) ],
         split_by_blank_line => [ qw($data) ],
      },
   };
}

sub to_array {
   my $self = shift;
   my ($data) = @_;

   $self->brik_help_run_undef_arg('to_array', $data) or return;
   $self->brik_help_run_invalid_arg('to_array', $data, 'SCALAR') or return;

   my @array = split(/\n/, $data);

   return \@array;
}

sub to_matrix {
   my $self = shift;
   my ($data) = @_;

   $self->brik_help_run_undef_arg('to_matrix', $data) or return;

   my $array = $self->to_array($data) or return;

   my @matrix = ();
   for my $this (@$array) {
      push @matrix, [ split(/\s+/, $this) ];
   }

   return \@matrix;
}

sub identify {
   my $self = shift;
   my ($string) = @_;

   $self->brik_help_run_undef_arg('identify', $string) or return;

   my $length = length($string);
   # Truncate to 128 Bytes
   my $subset = substr($string, 0, $length > 128 ? 128 : $length);

   my $identify = [ 'text' ]; # Default dump text string

   if ($subset =~ /^/i) {
      push @$identify, 'html';
   }
   elsif ($subset =~ /^
      push @$identify, 'xml';
   }
   elsif ($subset =~ /^\s*{\s+["a-zA-Z0-9:]+\s+/) {
      push @$identify, 'json';
   }
   elsif ($string =~ /^[a-zA-Z0-9+]+={1,2}$/) {
      push @$identify, 'base64';
   }
   elsif ($length == 32 && $string =~ /^[a-f0-9]+$/) {
      push @$identify, 'md5';
   }
   elsif ($length == 40 && $string =~ /^[a-f0-9]+$/) {
      push @$identify, 'sha1';
   }
   elsif ($length == 64 && $string =~ /^[a-f0-9]+$/) {
      push @$identify, 'sha256';
   }

   return $identify;
}

sub split_by_blank_line {
   my $self = shift;
   my ($data) = @_;

   $self->brik_help_run_undef_arg('split_by_blank_line', $data) or return;
   $self->brik_help_run_invalid_arg('split_by_blank_line', $data, 'ARRAY') or return;

   my $new = [];
   my @chunks = ();
   for (@$data) {
      if (/^\s*$/ && @$new > 0) {
         push @chunks, $new;
         $new = [];
         next;
      }
      push @$new, $_;
   }

   # Read last lines before eof (no more blank lines can be found)
   if (@$new > 0) {
      push @chunks, $new;
   }

   return \@chunks;
}

1;

__END__