File Coverage

blib/lib/NanoB2B/UniversalRoutines.pm
Criterion Covered Total %
statement 18 136 13.2
branch 0 20 0.0
condition n/a
subroutine 6 24 25.0
pod 0 16 0.0
total 24 196 12.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             # NanoB2B::UniversalRoutines
3             #
4             # Just universally used subroutines (i.e. printColor, inArray, wordIndex)
5             # Version 1.0
6             #
7             # Program by Milk
8              
9              
10             package NanoB2B::UniversalRoutines;
11              
12             ####################### IMPORTS ####################
13              
14 1     1   587 use Term::ANSIColor; #color coding the output
  1         6378  
  1         60  
15 1     1   513 use List::MoreUtils qw(first_index); #check for first occurrence of a word
  1         6679  
  1         9  
16 1     1   681 use List::MoreUtils qw(indexes); #get all of the indexes of a word
  1         2  
  1         4  
17 1     1   436 use File::Path qw(make_path); #makes sub directories
  1         2  
  1         45  
18              
19 1     1   5 use strict;
  1         2  
  1         14  
20 1     1   4 use warnings;
  1         2  
  1         954  
21              
22             ##### GLOBAL VARIABLES #####
23              
24             my $debug = 0;
25              
26             #----------------------------------------
27             # constructor
28             #----------------------------------------
29             # constructor method to create a new UR object
30             # input : $params <- reference to hash containing the parameters
31             # output: $self <- a UR object
32              
33             sub new {
34             #grab class and parameters
35 0     0 0   my $self = {};
36 0           my $class = shift;
37 0 0         return undef if(ref $class);
38 0           my $params = shift;
39              
40             #bless this object
41 0           bless $self, $class;
42              
43             # get some of the parameters
44 0           my $debugoption = $params->{'debug'};
45 0 0         if(defined $debugoption){$debug = $debugoption;}
  0            
46              
47 0           return $self;
48             }
49              
50             ################# HERE BE SUB-ROUTINES ######################
51             ################# (alphabatized for your convenience :D) ######################
52              
53              
54             #excludes a value from a number array
55             # input : $e <-- the number of elements in the array (5 = 1,2,3,4,5)
56             # $bully <-- the number to exclude from the set (3 => 1,2,4,5)
57             # output : @kids <-- the number set
58             sub bully{
59 0     0 0   my $self = shift;
60 0           my $num = shift;
61 0           my $bully = shift;
62              
63 0           my @kids = (1..$num);
64 0           @kids = grep { $_ != $bully } @kids;
  0            
65 0           return @kids;
66             }
67              
68             # cleans the line without getting rid of tags
69             # input : $input <-- the line to clean up
70             # output : $input <-- cleaned up input line
71             sub cleanWords{
72 0     0 0   my $self = shift;
73 0           my $input = shift;
74              
75 0           $input = lc($input);
76 0           $input =~ s/[^a-zA-z0-9\:\.\s<>&#;\*\/]/ /og; #get rid of non-ascii
77             #$input =~ s/([0-9]+(\.[0-9]*)?)-[0-9]+(\.[0-9]*)?/RANGE/g; #get rid of range num (#-#)
78 0           $input =~ s/\b[0-9]+\.?[0-9]+\b/NUM/og; #get rid of normal num (#.#)
79 0           $input =~ s/\b[0-9]+\b/NUM/og; #get rid of normal num (#.#)
80 0           $input =~ s/\s?=\s?/eq/og; #get rid of =
81 0           $input =~ s///og; #get rid of
82 0           $input =~ s/[\*\/]//og; #get rid of * and /
83             #$input =~ s/[,\)\(\\\'\/\=\*\-]/ /g;
84 0           $input =~ s/\s\+/_/og; #get rid of _+ space
85 0           $input =~ s/\s+\.\s+/ /og; #get rid of _._ periods
86 0           $input =~ s/\.\s+/ /og; #get rid of ._ space
87 0           $input =~ s/\s+/ /og; #get rid of excessive blank space
88 0           return $input;
89             }
90              
91             #helper function that retrieves all of the indexes of a word in a given set
92             # input : $word <-- an element or object
93             # @set <-- the array to look through
94             # output : array <-- returns a set of all indexes of the word; returns {-1} if none found
95             sub getAllIdxs{
96 0     0 0   my $self = shift;
97 0           my $word = shift;
98 0           my $set_ref = shift;
99 0           my @set = @$set_ref;
100              
101 0     0     my @idxs = indexes{$_ eq $word} @set;
  0            
102 0           return @idxs;
103             }
104              
105             #gets the line's index
106             # input : $keyword <-- the regex to use to search for the specific line
107             # @lines <-- the set of lines to look through
108             # output : $a <-- return the index of the line based on the regex; returns -1 if not found
109             sub getIndexofLine{
110 0     0 0   my $self = shift;
111 0           my $keyword = shift;
112 0           my $lines_ref = shift;
113 0           my @lines = @$lines_ref;
114              
115 0           my $len = @lines;
116 0           for(my $a = 0; $a < $len; $a++){
117 0           my $line = $lines[$a];
118 0 0         if ($line =~ /($keyword)/){
119 0           return $a;
120             }
121             }
122 0           return -1;
123             }
124              
125             #helper function to check if an element is in an array
126             # input : $e <-- an element or object
127             # @array <-- the array to look through
128             # output : boolean <-- 1 if it is in the array, 0 if it isn't
129             sub inArr{
130 0     0 0   my $self = shift;
131 0           my $e = shift;
132 0           my $arr_ref = shift;
133 0           my @arr = @$arr_ref;
134              
135 0     0     my $ans = first_index {$_ eq $e} @arr;
  0            
136 0 0         if($ans > -1){
137 0           return 1;
138             }else{
139 0           return 0;
140             }
141             }
142              
143             #prints to a file called debug
144             # input : $output <-- the text to output to the debug file
145             # output : --
146             sub print2DebugFile{
147 0     0 0   my $self = shift;
148 0           my $output = shift;
149              
150 0 0         open(DEBUG, ">>", "debug") || die "NOOOOOO DEBUG NOOOOOO!!! >w<";
151 0           print2File(, $output);
152             }
153              
154             #prints to a file w/ line skip
155             # input : $file <-- the file to print to (must already be opened!)
156             # @array <-- the text to print to the file (includes next line)
157             # output : --
158             sub print2File{
159 0     0 0   my $self = shift;
160 0           my $file = shift;
161 0           my $txt = shift;
162              
163 0           print $file "$txt\n";
164             }
165              
166             #prints to a file as is
167             # input : $file <-- the file to print to (must already be opened!)
168             # @array <-- the text to print to the file
169             # output : --
170             sub print2FileNoLine{
171 0     0 0   my $self = shift;
172 0           my $file = shift;
173 0           my $txt = shift;
174              
175 0           print $file "$txt";
176             }
177              
178             #shows an array
179             # input : $delim <-- string to separate the elememts by
180             # @array <-- the array to print
181             # output : string <-- returns the array elements in a string format separated by the delimiter
182             sub printArr{
183 0     0 0   my $self = shift;
184 0           my $delim = shift;
185 0           my $parr_ref = shift;
186 0           my @parr = @$parr_ref;
187              
188 0           my $combo = join ($delim, @parr);
189 0           print "$combo\n";
190             }
191              
192              
193             #prints input with color
194             # input : $color <-- color to print the text in
195             # $text <-- the text to print
196             # output : --
197             sub printColor{
198 0     0 0   my $self = shift;
199 0           my $color = shift;
200 0           my $text = shift;
201              
202 0 0         if($color =~ /on_\w+/){print color($color), "$text", color("reset"), "\n";}
  0            
203 0           else{print color($color), "$text", color("reset");}
204             }
205              
206             #prints input with color for debug mode only
207             # input : $color <-- color to print the text in
208             # $text <-- the text to print
209             # output : --
210             sub printColorDebug{
211 0     0 0   my $self = shift;
212 0           my $color = shift;
213 0           my $text = shift;
214              
215 0 0         if($debug){
216 0 0         if($color =~ /on_\w+/){print color($color), "$text", color("reset"), "\n";}
  0            
217 0           else{print color($color), "$text", color("reset");}
218            
219             }
220             }
221              
222             #prints only if debug mode is on
223             # input : $text <-- the text to print
224             # output : --
225             sub printDebug{
226 0     0 0   my $self = shift;
227 0           my $text = shift;
228              
229 0 0         if($debug){
230 0           print ($text);
231             }
232             }
233              
234             #helper function that checks if an array set is in another array
235             # input : @arr1 <-- the subject array element
236             # @arr2 <-- the array to look through
237             # output : boolean <-- 1 if it is in the array, 0 if it isn't
238             sub setInArr{
239 0     0 0   my $self = shift;
240 0           my $arr1_ref = shift;
241 0           my $arr2_ref = shift;
242            
243 0           my @arr1 = @$arr1_ref;
244 0           my @arr2 = @$arr2_ref;
245              
246 0           my $str1 = join " ", @arr1;
247 0           my $str2 = join " ", @arr2;
248              
249 0 0         if(index($str2, $str1) != -1){
250 0           return 1;
251             }else{
252 0           return 0;
253             }
254             }
255              
256             #counts how many times a word appears in a set
257             # input : $word <-- the word to look for in the array
258             # @arr <-- the array to look through
259             # output : $num <-- the total number of times the element occurs in the array
260             sub wordCount{
261 0     0 0   my $self = shift;
262 0           my $word = shift;
263 0           my $arr_ref = shift;
264 0           my @arr = @$arr_ref;
265              
266 0           my @idx = getAllIdxs($word, @arr);
267 0           my $num = @idx;
268 0           return $num;
269             }
270              
271             #makes a counter for each word in a line
272             # input : @words <-- the set of words to count
273             # output : @index_set <-- the set of counter numbers correlating to each word
274             sub wordIndex{
275 0     0 0   my $self = shift;
276 0           my $words_ref = shift;
277 0           my @words = @$words_ref;
278              
279 0           my @curWords = ();
280 0           my @index_set = ();
281 0           foreach my $word (@words){
282 0           my $index = wordCount($word, @curWords) + 1;
283 0           push(@curWords, $word);
284 0           push (@index_set, $index);
285             }
286              
287 0           return @index_set;
288             }
289              
290             1;