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 4     4   21 use strict;
  4         6  
  4         99  
3 4     4   25 use warnings;
  4         8  
  4         113  
4 4     4   41 use base qw/Exporter/;
  4         9  
  4         381  
5 4     4   2398 use File::ShareDir qw/dist_dir/;
  4         19024  
  4         273  
6 4     4   1074 use Path::Tiny qw/path/;
  4         15361  
  4         241  
7 4     4   3649 use Getopt::Long qw//;
  4         45420  
  4         105  
8 4     4   2984 use MIME::Types qw//;
  4         21596  
  4         93  
9 4     4   3978 use Term::ANSIColor;
  4         26708  
  4         303  
10 4     4   35 use Carp qw/croak/;
  4         7  
  4         1720  
11              
12             our @EXPORT = qw/path_to_res share_path parse_options error warn info/;
13              
14             sub parse_options {
15 3     3 0 9 my ($args, @options) = @_;
16 3         13 Getopt::Long::Configure("no_ignore_case", "no_auto_abbrev");
17 3         158 my $result = Getopt::Long::GetOptionsFromArray($args, @options);
18 3         1078 return $result;
19             }
20              
21             sub path_to_res {
22 1     1 0 527 my $path = shift;
23 1 50 33     11 if( $path && $path->exists ) {
24 1         30 my $c = $path->slurp_raw();
25 1         165 my $meta = ['Content-Length' => length $c ];
26 1 50       12 if( my $mime = MIME::Types->new->mimeTypeOf($path->basename) ){
27 1         52992 push @$meta, ('Content-Type' => $mime->type );
28             }
29 1         26 return [200, $meta , [$c]];
30             }
31 0         0 return [404, [], ['not found.']];
32             }
33              
34             sub share_path {
35 6     6 0 14 my $p = shift;
36 6 50       23 die "Parameter must be ARRAY ref" unless ref $p eq 'ARRAY';
37 6         19 my $path = path(@$p);
38 6 50       179 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 116 my $message = shift;
65 5         115 print "[";
66 5         17 print color 'green';
67 5         111 print "Info";
68 5         13 print color 'reset';
69 5         113 print "] $message\n";
70             }
71              
72             1;