File Coverage

blib/lib/File/Rename/Options.pm
Criterion Covered Total %
statement 33 37 89.1
branch 10 16 62.5
condition 3 6 50.0
subroutine 8 8 100.0
pod 2 2 100.0
total 56 69 81.1


line stmt bran cond sub pod time code
1             package File::Rename::Options;
2 21     21   69844 use strict;
  21         53  
  21         683  
3 21     21   103 use warnings;
  21         137  
  21         703  
4            
5 21     21   16258 use Getopt::Long 2.24 ();
  21         249448  
  21         10474  
6            
7             our $VERSION = 2.01;
8             our $IMPORTED;
9            
10             sub import {
11 21     21   63 my $pack = shift;
12 21 50       120 if( $IMPORTED++ ) {
13 0         0 require Carp;
14 0         0 Carp::cluck("$pack->import() called twice");
15             }
16 21         74 my @config = qw(
17             posix_default
18             no_ignore_case
19             );
20 21         48 push @config, @_;
21 21         77 Getopt::Long::Configure(@config);
22             }
23            
24             sub GetOptions {
25 29     29 1 29378 my ($no_code) = @_;
26 29         67 my @expression;
27 29         60 my $fullpath = 1;
28             Getopt::Long::GetOptions(
29             '-v|verbose' => \my $verbose,
30             '-0|null' => \my $null,
31             '-n|nono' => \my $nono,
32             '-f|force' => \my $force,
33             '-h|?|help' => \my $help,
34             '-m|man' => \my $man,
35             '-V|version' => \my $version,
36 4     4   3591 '-d|filename' => sub { undef $fullpath },
37             '-path|fullpath!' => \$fullpath,
38             '-e=s' => \@expression,
39             '-E=s' =>
40             sub {
41 8     8   4380 my(undef, $e) = @_;
42 8         20 $e .= ';';
43 8         24 push @expression, $e;
44             },
45 29 50       587 '-u|unicode:s' => \my $unicode,
46             ) or return;
47            
48 29         22740 my $options = {
49             verbose => $verbose,
50             input_null => $null,
51             no_action => $nono,
52             over_write => $force,
53             filename_only => !$fullpath,
54             show_help => $help,
55             show_manual => $man,
56             show_version => $version,
57             unicode_strings => defined $unicode,
58             encoding => $unicode,
59             };
60 29 100       121 return $options if $no_code;
61 23 100 33     286 return $options if $help or $man or $version;
      66        
62            
63 21 100       82 if( @expression ) {
64 7         31 $options->{_code} = join "\n", @expression;
65             }
66             else {
67 14 50       53 return unless @ARGV;
68 14         68 $options->{_code} = shift @ARGV;
69             }
70 21         137 return $options;
71             }
72            
73             sub bad_encoding {
74 21     21 1 47 my $options = shift;
75 21         43 my $encoding = $options->{encoding};
76 21 50       103 return unless $encoding;
77 0 0         return unless $encoding =~ /[^\s\w.-]/;
78 0           return 1
79             }
80            
81             1;
82             __END__