File Coverage

blib/lib/File/Fingerprint.pm
Criterion Covered Total %
statement 58 59 98.3
branch 5 6 83.3
condition 3 3 100.0
subroutine 10 10 100.0
pod 3 3 100.0
total 79 81 97.5


line stmt bran cond sub pod time code
1             package File::Fingerprint;
2 2     2   1494 use strict;
  2         5  
  2         64  
3              
4 2     2   12 use warnings;
  2         4  
  2         61  
5 2     2   11 no warnings;
  2         5  
  2         75  
6              
7 2     2   12 use Carp;
  2         4  
  2         1742  
8              
9             our $VERSION = '0.102';
10              
11             =encoding utf8
12              
13             =head1 NAME
14              
15             File::Fingerprint - Identify a file by its checksums and other attributes
16              
17             =head1 SYNOPSIS
18              
19             use File::Fingerprint;
20              
21             my $fingerprint = File::Fingerprint->roll( $file );
22              
23             =head1 DESCRIPTION
24              
25             =over 4
26              
27             =cut
28              
29             =item roll
30              
31             =cut
32              
33             sub roll {
34 3     3 1 5094 my( $class, $file ) = @_;
35              
36 3 100       50 unless( -e $file ) {
37 2         353 carp "File [$file] does not exist! Can't fingerprint it";
38 2         19 return;
39             }
40              
41 1         6 my $self = bless { file => $file }, $class;
42              
43 1         5 $self->init;
44             }
45              
46             =item init
47              
48             =cut
49              
50 0         0 BEGIN {
51              
52             my %Prints = (
53 1         549 md5 => sub { require MD5; my $ctx = MD5->new; $ctx->add( $_[0]->file ); $ctx->hexdigest },
  1         261  
  1         6  
  1         15  
54              
55 1         828 mmagic => sub { require File::MMagic; File::MMagic->new->checktype_filename( $_[0]->file ) },
  1         11638  
56             # mime_info => sub { require File::MimeInfo; File::MimeInfo::mimetype( $_[0]->file ) },
57              
58 1         4 extension => sub { my @b = split /\./, $_[0]->file; shift @b; [ @b ] },
  1         4  
  1         7  
59 1         5 size => sub { -s $_[0]->file },
60 1         5 stat => sub { [ stat $_[0]->file ] },
61 1         7 lines => sub { open my($fh), "<", $_[0]->file; 1 while( <$fh> ); $. },
  1         32  
  1         20  
62 1         9 crc16 => sub { require Digest::CRC; my $ctx = Digest::CRC->new( type => 'crc16' ); open my($fh), "<", $_[0]->file; $ctx->addfile( $fh ); $ctx->hexdigest; },
  1         8  
  1         106  
  1         9  
  1         77  
63 1         664 crc32 => sub { require Digest::CRC; my $ctx = Digest::CRC->new( type => 'crc32' ); open my($fh), "<", $_[0]->file; $ctx->addfile( $fh ); $ctx->hexdigest; },
  1         3205  
  1         159  
  1         11  
  1         96  
64 1         8 basename => sub { require File::Basename; File::Basename::basename( $_[0]->file ) },
  1         5  
65 2     2   230 );
66              
67             sub init {
68 1     1 1 4 my( $self ) = shift;
69              
70 1         4 print "File is ", $self->file, "\n";
71              
72 1         9 foreach my $print ( keys %Prints ) {
73 9         21 $self->{$print} = eval { $self->$print() };
  9         90  
74 9 50       41054 carp "Error is $@\n" if $@;
75             }
76              
77 1         8 return $self;
78             }
79              
80             sub AUTOLOAD {
81 12     12   2085 our $AUTOLOAD;
82              
83 12         88 ( my $method = $AUTOLOAD ) =~ s/.*:://;
84              
85 12 100       239 carp "No such method as $AUTOLOAD" unless exists $Prints{$method};
86              
87 12   100     176 return $_[0]->{$method} || $Prints{$method}->( $_[0] );
88             }
89              
90             }
91              
92 1     1   1136 sub DESTROY { 1 }
93              
94             =item file
95              
96             Returns the filename of the fingerprinted file. This is the same path
97             passed to C.
98              
99             =cut
100              
101 10     10 1 1092 sub file { $_[0]->{file} }
102              
103             =item md5
104              
105             =item mmagic
106              
107             Return the MIME type of the file, as determined by File::MMagic. For
108             instance, C.
109              
110             =item basename
111              
112             Returns the basename of the file.
113              
114             =item extension
115              
116             Returns the file extensions as an array reference.
117              
118             For instance, F returns C<[ qw(tar gz) ]>.
119              
120             =item size
121              
122             Returns the file size, in bytes.
123              
124             =item stat
125              
126             Returns that stat buffer. This is the array reference of all of the values
127             returned by C.
128              
129             =item lines
130              
131             Returns the line count of the file.
132              
133             =item crc16
134              
135             Returns the CRC-16 checksum of the file.
136              
137             =item crc32
138              
139             Returns the CRC-32 checksum of the file.
140              
141             =back
142              
143             =head1 TO DO
144              
145              
146             =head1 SEE ALSO
147              
148              
149             =head1 SOURCE AVAILABILITY
150              
151             This source is in Github
152              
153             git://github.com/briandfoy/file-fingerprint.git
154              
155             =head1 AUTHOR
156              
157             brian d foy, C<< >>
158              
159             =head1 COPYRIGHT AND LICENSE
160              
161             Copyright © 2008-2018, brian d foy . All rights reserved.
162              
163             You may redistribute this under the terms of the Artistic License 2.0.
164              
165             =cut
166              
167             1;