|
|
@ -24,6 +24,8 @@ use Digest::CRC qw( crc8 ); |
|
|
|
use Scalar::Util; |
|
|
|
use File::Map qw(:map :extra); |
|
|
|
use File::FormatIdentification::Pronom; |
|
|
|
use Getopt::Long; |
|
|
|
use Carp; |
|
|
|
|
|
|
|
# calc a random color |
|
|
|
sub rndcolor { |
|
|
@ -194,26 +196,41 @@ sub get_partial_regex($$) { |
|
|
|
################################################################################ |
|
|
|
# main |
|
|
|
################################################################################ |
|
|
|
|
|
|
|
my $pronomfile = shift @ARGV; |
|
|
|
my $binaryfile = shift @ARGV; |
|
|
|
my $pronomfile; |
|
|
|
my $binaryfile; |
|
|
|
|
|
|
|
GetOptions ( |
|
|
|
"signature=s" => \$pronomfile, |
|
|
|
"binary=s" => \$binaryfile, |
|
|
|
"help" => sub { |
|
|
|
say "$0 --signature=droid_signature_filename --binary=binary_filename"; |
|
|
|
say "$0 --help "; |
|
|
|
say ""; |
|
|
|
exit 1; |
|
|
|
} |
|
|
|
) or croak "wrong option, try '$0 --help'"; |
|
|
|
|
|
|
|
if ( !defined $pronomfile ) { |
|
|
|
say "you need at least a pronom signature file"; |
|
|
|
exit; |
|
|
|
} |
|
|
|
if ( !defined $binaryfile ) { |
|
|
|
say "you need an binaryfile"; |
|
|
|
exit; |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
# write basic main.osd |
|
|
|
|
|
|
|
open( my $filehandle, "<", "$binaryfile" ); |
|
|
|
binmode($filehandle); |
|
|
|
seek( $filehandle, 0, SEEK_END ); |
|
|
|
my $eof = tell($filehandle); |
|
|
|
close $filehandle; |
|
|
|
|
|
|
|
my $pronom = File::FormatIdentification::Pronom->new( |
|
|
|
"droid_signature_filename" => $pronomfile ); |
|
|
|
"droid_signature_filename" => $pronomfile |
|
|
|
); |
|
|
|
|
|
|
|
my @output_buffer; |
|
|
|
|
|
|
@ -230,8 +247,6 @@ foreach my $internalid ( $pronom->get_all_internal_ids() ) { |
|
|
|
my @regexes = $pronom->get_regular_expressions_by_internal_id($internalid); |
|
|
|
my @res; |
|
|
|
my $timer = time; |
|
|
|
|
|
|
|
#print "internalid=$internalid"; |
|
|
|
foreach my $regex (@regexes) { |
|
|
|
|
|
|
|
# MATCHed? |
|
|
@ -241,7 +256,7 @@ foreach my $internalid ( $pronom->get_all_internal_ids() ) { |
|
|
|
} |
|
|
|
|
|
|
|
#say "REGEX='$regex'"; |
|
|
|
if ( $filestream =~ /$regex/saa ) { |
|
|
|
if ( $filestream =~ m/$regex/saa ) { |
|
|
|
my $tmp; |
|
|
|
$tmp->{matched} = 1; |
|
|
|
$tmp->{regex} = $regex; |
|
|
|