File Coverage

blib/lib/MDK/Common/Various.pm
Criterion Covered Total %
statement 3 26 11.5
branch 0 16 0.0
condition 0 3 0.0
subroutine 1 14 7.1
pod 13 13 100.0
total 17 72 23.6


line stmt bran cond sub pod time code
1             package MDK::Common::Various;
2              
3             =head1 NAME
4              
5             MDK::Common::Various - miscellaneous functions
6              
7             =head1 SYNOPSIS
8              
9             use MDK::Common::Various qw(:all);
10              
11             =head1 EXPORTS
12              
13             =over
14              
15             =item first(LIST)
16              
17             returns the first value. C is an alternative for C<((XXX)[0])>
18              
19             =item second(LIST)
20              
21             returns the second value. C is an alternative for C<((XXX)[1])>
22              
23             =item top(LIST)
24              
25             returns the last value. C is an alternative for C<$l[$#l]>
26              
27             =item to_bool(SCALAR)
28              
29             returns a value in { 0, 1 }
30              
31             =item to_int(STRING)
32              
33             extracts the number from the string. You could use directly C, but
34             you'll get I. It also handles returns
35             11 for C<"foo 11 bar">
36              
37             =item to_float(STRING)
38              
39             extract a decimal number from the string
40              
41             =item bool2text(SCALAR)
42              
43             returns a value in { "true", "false" }
44              
45             =item bool2yesno(SCALAR)
46              
47             returns a value in { "yes", "no" }
48              
49             =item text2bool(STRING)
50              
51             inverse of C and C
52              
53             =item chomp_(STRING)
54              
55             non-mutable version of chomp: do not modify the argument, returns the chomp'ed
56             value. Also works on lists: C is equivalent to
57             C
58              
59             =item backtrace()
60              
61             returns a string describing the backtrace. eg:
62              
63             sub g { print "oops\n", backtrace() }
64             sub f { &g }
65             f();
66              
67             gives
68              
69             oops
70             main::g() called from /tmp/t.pl:2
71             main::f() called from /tmp/t.pl:4
72              
73              
74             =item internal_error(STRING)
75              
76             another way to C with a nice error message and a backtrace
77              
78             =item noreturn()
79              
80             use this to ensure nobody uses the return value of the function. eg:
81              
82             sub g { print "g called\n"; noreturn }
83             sub f { print "g returns ", g() }
84             f();
85              
86             gives
87              
88             test.pl:3: main::f() expects a value from main::g(), but main::g() doesn't return any value
89              
90             =back
91              
92             =head1 SEE ALSO
93              
94             L
95              
96             =cut
97            
98              
99 1     1   6 use Exporter;
  1         1  
  1         412  
100             our @ISA = qw(Exporter);
101             our @EXPORT_OK = qw(first second top to_bool to_int to_float bool2text bool2yesno text2bool chomp_ backtrace internal_error noreturn);
102             our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
103              
104              
105 0     0 1   sub first { $_[0] }
106 0     0 1   sub second { $_[1] }
107 0     0 1   sub top { $_[-1] }
108              
109 0 0   0 1   sub to_bool { $_[0] ? 1 : 0 }
110 0 0   0 1   sub to_int { $_[0] =~ /\s*(\d*)/ && $1 }
111 0 0   0 1   sub to_float { $_[0] =~ /\s*(\d*(\.\d*)?)/ && $1 }
112 0 0   0 1   sub bool2text { $_[0] ? "true" : "false" }
113 0 0   0 1   sub bool2yesno { $_[0] ? "yes" : "no" }
114 0 0 0 0 1   sub text2bool { my $t = lc($_[0]); $t eq "true" || $t eq "yes" ? 1 : 0 }
  0            
115              
116 0 0   0 1   sub chomp_ { my @l = @_; chomp @l; wantarray() ? @l : $l[0] }
  0            
  0            
117              
118             sub backtrace() {
119 0     0 1   my $s;
120 0           for (my $i = 1; caller($i); $i++) {
121 0           my ($_package, $file, $line, $func) = caller($i);
122 0           $s .= "$func() called from $file:$line\n";
123             }
124 0           $s;
125             }
126              
127             sub internal_error {
128 0     0 1   die "INTERNAL ERROR: $_[0]\n" . backtrace();
129             }
130              
131             sub noreturn() {
132 0 0   0 1   if (defined wantarray()) {
133 0           my ($_package, $file, $line, $func) = caller(1);
134 0           my (undef, undef, undef, $func2) = caller(2);
135 0           die "$file:$line: $func2() expects a value from $func(), but $func() doesn't return any value\n";
136             }
137             }
138              
139             1;
140