File Coverage

blib/lib/Data/FreqConvert.pm
Criterion Covered Total %
statement 54 56 96.4
branch 5 8 62.5
condition 4 6 66.6
subroutine 9 9 100.0
pod 0 3 0.0
total 72 82 87.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Data::FreqConvert - converts variables to scalars holfding frequencys of keys in values
4              
5             =head1 VERSION
6              
7             Version 0.02
8              
9              
10             =head1 SYNOPSIS
11              
12             use Data::FreqConvert;
13             use Data::Printer;
14              
15             my $data = Data::FreqConvert->new();
16              
17             my %a = ("a"=>1,"b"=>1,"c"=>1);
18             my $a = {"a"=>1,"b"=>1,"c"=>1,"a"=>3};
19             my @a = ("a","b","c","a");
20             my $b = "a\nb\nc\nc";
21              
22             my $r = $data->freq($b);
23             p $r;
24              
25             $r = $data->freq(\@a);
26             p $r;
27              
28             $r = $data->freq($a);
29             p $r;
30              
31             =cut
32              
33             package Data::FreqConvert;
34              
35 2     2   41646 use strict;
  2         5  
  2         50  
36 2     2   10 use warnings;
  2         4  
  2         58  
37              
38 2     2   1631 use Data::Freq;
  2         52323  
  2         63  
39 2     2   2051 use Data::Dumper;
  2         20423  
  2         127  
40 2     2   2164 use Data::Printer;
  2         91844  
  2         15  
41 2     2   1842 use IO::Capture::Stdout;
  2         5756  
  2         933  
42             our $VERSION = "0.01";
43              
44             sub new {
45 1     1 0 1265 my $class = shift;
46 1         3 my (%params) = @_;
47              
48 1         3 my $self = {};
49 1         3 bless $self, $class;
50              
51 1         4 return $self;
52             }
53              
54              
55             sub prepArg {
56 2     2 0 3 my $self = shift;
57 2         5 my ($arg) = @_;
58 2         3 my $ref = ref $arg;
59 2         5 my @return = ();
60              
61 2 50       8 if($ref =~ /HASH/) {
62 0         0 @return = keys %$arg;
63             }
64 2 50       5 if($ref =~ /ARRAY/) {
65 0         0 @return = @$arg;
66             }
67              
68 2 50       9 if($ref eq "") {
69 2         7 @return = split("\n",$arg);
70             }
71              
72 2         8 return @return;
73              
74             }
75              
76              
77             sub freq {
78 2     2 0 14 my $self = shift;
79 2         4 my $arg = shift;
80 2         7 my @set = $self->prepArg($arg);
81 2         13 my $data = Data::Freq->new();
82 2         220 foreach my $n( @set){
83 5         264 $data->add($n);
84             }
85              
86 2         219 my $capture = IO::Capture::Stdout->new;
87 2         46 $capture->start;
88 2         142 $data->output();
89 2         661 $capture->stop();
90              
91 2         75 my $ret = {};
92 2         10 my @buffer = reverse grep{/\w|\d/}$capture->read;
  24         90  
93              
94 2         4 my $last = "";
95 2         5 my $i = 0;
96 2         5 foreach my $z(@buffer){
97 8 100 100     55 if($z=~/\w/ && ($i % 2 || $i == 0)) {
      33        
98 6         16 $ret->{$z}="";
99             }
100             else {
101 2         5 $ret->{$last}=$z;
102             }
103              
104 8         10 $last = $z;
105 8         15 $i++;
106             }
107              
108 2         24 return $ret;
109             }
110              
111             =head1 AUTHOR
112              
113             Mahiro Ando, C<< >>
114              
115             =head1 LICENSE AND COPYRIGHT
116              
117             Copyright 2015 Hagen Geissler
118              
119             This program is free software; you can redistribute it and/or modify it
120             under the terms of either: the GNU General Public License as published
121             by the Free Software Foundation; or the Artistic License.
122              
123             See http://dev.perl.org/licenses/ for more information.
124              
125             =cut
126              
127             1;