File Coverage

bin/hasher
Criterion Covered Total %
statement 35 59 59.3
branch 2 10 20.0
condition n/a
subroutine 10 12 83.3
pod n/a
total 47 81 58.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3 1     1   317 use strict;
  1         2  
  1         28  
4 1     1   3 use warnings FATAL => 'all';
  1         2  
  1         40  
5 1     1   11 use feature 'say';
  1         1  
  1         73  
6 1     1   3 use utf8;
  1         1  
  1         6  
7 1     1   20 use open qw(:std :utf8);
  1         1  
  1         8  
8              
9             # PODNAME: hasher
10              
11              
12 1     1   111 use Carp;
  1         1  
  1         63  
13 1     1   428 use Digest::SHA1;
  1         542  
  1         42  
14 1     1   10 use File::Basename qw(fileparse);
  1         1  
  1         54  
15 1     1   576 use Term::ANSIColor qw(colored);
  1         5058  
  1         727  
16              
17             sub _get_hash_from_file_name {
18 0     0   0 my ($file_name) = @_;
19              
20 0         0 my $result = open my $fh, '<', $file_name;
21              
22 0 0       0 if (not $result) {
23 0         0 say "Error. Can't open file '$file_name' - $!.";
24 0         0 exit 1;
25             }
26              
27             # $sha1->b64digest
28             #
29             # Same as $sha1->digest, but will return the digest as a base64 encoded
30             # string. The length of the returned string will be 27 and it will only
31             # contain characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+' and
32             # '/'.
33 0         0 my $digest = Digest::SHA1->new->addfile($fh)->b64digest;
34              
35             # I don't want to have '+' and '/' in the file name (I'm afraid of some
36             # problems, when such symbols are in the url).
37 0         0 $digest =~ s{\+}{-}g;
38 0         0 $digest =~ s{/}{_}g;
39              
40 0         0 close $fh;
41              
42 0         0 return $digest;
43             }
44              
45             sub _get_file_extension {
46 7     7   2010 my ($file_name) = @_;
47              
48 7         6 my $extension;
49              
50 7         23 $file_name =~ m{
51             (?:.*/)?
52             .*
53             (\.[^./]*)
54             \z
55             }x;
56              
57 7 100       16 if (defined $1) {
58 4         4 $extension = $1;
59 4         7 $extension = lc($extension);
60             } else {
61 3         3 $extension = "";
62             }
63              
64 7         40 return $extension;
65             }
66              
67             # main
68             sub main {
69              
70 0 0   0     if (not defined $ARGV[0]) {
71 0           say "Error. Expecting at least one filename as the parameters to the script.";
72 0           exit 1;
73             };
74              
75 0           foreach my $argument (@ARGV) {
76              
77 0 0         next if -d $argument;
78              
79 0           my $hash = _get_hash_from_file_name($argument);
80 0           my $extension = _get_file_extension($argument);
81              
82 0           my ($original_file_name, $dir) = fileparse $argument;
83 0           my $new_file_name = $hash . $extension;
84              
85 0           say sprintf
86             "%s{ %s -> %s }",
87             $dir,
88             colored($original_file_name, 'red'),
89             colored($new_file_name, 'green'),
90             ;
91              
92 0           my $result = rename(
93             $dir . $original_file_name,
94             $dir . $new_file_name
95             );
96              
97 0 0         if (not $result) {
98 0           say "Error. Can't rename file '$dir$original_file_name' to '$dir$new_file_name' - $!.";
99 0           exit 1;
100             }
101              
102             }
103              
104             }
105             main() if not caller;
106             1;
107              
108             __END__