File Coverage

blib/lib/App/revealup/util.pm
Criterion Covered Total %
statement 48 65 73.8
branch 4 8 50.0
condition 1 3 33.3
subroutine 13 15 86.6
pod 0 6 0.0
total 66 97 68.0


line stmt bran cond sub pod time code
1             package App::revealup::util;
2 5     5   33 use strict;
  5         9  
  5         142  
3 5     5   26 use warnings;
  5         9  
  5         136  
4 5     5   25 use base qw/Exporter/;
  5         18  
  5         481  
5 5     5   1991 use File::ShareDir qw/dist_dir/;
  5         99140  
  5         283  
6 5     5   1528 use Path::Tiny qw/path/;
  5         22231  
  5         265  
7 5     5   2993 use Getopt::Long qw//;
  5         41542  
  5         142  
8 5     5   2243 use MIME::Types qw//;
  5         20298  
  5         131  
9 5     5   3206 use Term::ANSIColor;
  5         43927  
  5         340  
10 5     5   38 use Carp qw/croak/;
  5         9  
  5         2075  
11              
12             our @EXPORT = qw/path_to_res share_path parse_options error warn info/;
13              
14             sub parse_options {
15 3     3 0 8 my ($args, @options) = @_;
16 3         10 Getopt::Long::Configure("no_ignore_case", "no_auto_abbrev");
17 3         135 my $result = Getopt::Long::GetOptionsFromArray($args, @options);
18 3         1212 return $result;
19             }
20              
21             sub path_to_res {
22 1     1 0 361 my $path = shift;
23 1 50 33     8 if( $path && $path->exists ) {
24 1         28 my $c = $path->slurp_raw();
25 1         213 my $meta = ['Content-Length' => length $c ];
26 1 50       9 if( my $mime = MIME::Types->new->mimeTypeOf($path->basename) ){
27 1         59708 push @$meta, ('Content-Type' => $mime->type );
28             }
29 1         20 return [200, $meta , [$c]];
30             }
31 0         0 return [404, [], ['not found.']];
32             }
33              
34             sub share_path {
35 7     7 0 189 my $p = shift;
36 7 50       29 die "Parameter must be ARRAY ref" unless ref $p eq 'ARRAY';
37 7         34 my $path = path(@$p);
38 7 50       278 return $path if $path->exists();
39 0         0 shift @$p;
40 0         0 my $dist_dir = dist_dir('App-revealup');
41 0         0 return path($dist_dir, @$p);
42             }
43              
44             sub error {
45 0     0 0 0 my $message = shift;
46 0         0 print "[";
47 0         0 print color 'red';
48 0         0 print "Error";
49 0         0 print color 'reset';
50 0         0 print "] $message\n";
51 0         0 croak $message;
52             }
53              
54             sub warn {
55 0     0 0 0 my $message = shift;
56 0         0 print "[";
57 0         0 print color 'yellow';
58 0         0 print "Warn";
59 0         0 print color 'reset';
60 0         0 print "] $message\n";
61             }
62              
63             sub info {
64 5     5 0 125 my $message = shift;
65 5         132 print "[";
66 5         25 print color 'green';
67 5         168 print "Info";
68 5         18 print color 'reset';
69 5         168 print "] $message\n";
70             }
71              
72             1;