Browse Source

- init, added a perl script to identify files, similar to siegfried or droid

master
Andreas Romeyke 2 months ago
parent
commit
4f8b5d72e0
1 changed files with 89 additions and 0 deletions
  1. +89
    -0
      bin/pronomidentify.pl

+ 89
- 0
bin/pronomidentify.pl View File

@@ -0,0 +1,89 @@
#!/usr/bin/env perl
#===============================================================================
#
# FILE: pronom2wxhexeditor.pl
#
# USAGE: ./pronom2wxhexeditor.pl
#
# DESCRIPTION: perl ./pronom2wxhexeditor.pl <DROIDSIGNATURE-FILE> <BINARYFILE>
#
# OPTIONS: ---
# REQUIREMENTS: ---
# BUGS: ---
# NOTES: ---
# AUTHOR: Andreas Romeyke,
# CREATED: 28.08.2018 14:26:43
# REVISION: ---
#===============================================================================
use strict;
use warnings 'FATAL';
use utf8;
use v5.24;
use Fcntl qw(:seek);
use File::Map qw(:map :extra);
use File::FormatIdentification::Pronom;
use Getopt::Long;
use Carp;
use List::Util qw( all );

################################################################################
# main
################################################################################
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
);


#my $pathobj = path($binaryfile);
#my $filestream = $pathobj->slurp_raw;
map_file my $filestream, $binaryfile, "<";
advise( $filestream, 'random' );


foreach my $internalid ( $pronom->get_all_internal_ids() ) {
my $sig = $pronom->get_signature_id_by_internal_id($internalid);
if (!defined $sig) {next;}
my $puid = $pronom->get_puid_by_signature_id($sig);
my $name = $pronom->get_name_by_signature_id($sig);
my $quality = $pronom->get_qualities_by_internal_id($internalid);

my @regexes = $pronom->get_regular_expressions_by_internal_id($internalid);
my @res;
my $timer = time;
if ( all {$filestream =~ m/$_/saa} @regexes ) {
say "$binaryfile identified as $name with PUID $puid (regex quality $quality)";
}
}
;

Loading…
Cancel
Save