findhex

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # findhex
   5 # File ID: 04048b4a-284a-11e5-8465-000df06acc56
   6 #
   7 # Search for hexadecimal or decimal numbers in files or streams.
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2015– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18 use Text::Wrap;
  19
  20 local $| = 1;
  21
  22 our %Opt = (
  23
  24     'decimal' => 0,
  25     'help' => 0,
  26     'ignore-case' => 0,
  27     'length' => '1-',
  28     'quiet' => 0,
  29     'unique' => 0,
  30     'verbose' => 0,
  31     'version' => 0,
  32
  33 );
  34
  35 our $progname = $0;
  36 $progname =~ s/^.*\/(.*?)$/$1/;
  37 our $VERSION = '0.1.0';
  38
  39 Getopt::Long::Configure('bundling');
  40 GetOptions(
  41
  42     'decimal|d' => \$Opt{'decimal'},
  43     'help|h' => \$Opt{'help'},
  44     'ignore-case|i' => \$Opt{'ignore-case'},
  45     'length|l=s' => \$Opt{'length'},
  46     'quiet|q+' => \$Opt{'quiet'},
  47     'unique|u' => \$Opt{'unique'},
  48     'verbose|v+' => \$Opt{'verbose'},
  49     'version' => \$Opt{'version'},
  50
  51 ) || die("$progname: Option error. Use -h for help.\n");
  52
  53 my %size = (
  54
  55     'arj' => 8,
  56     'byte' => 2,
  57     'crc16' => 4,
  58     'crc32' => 8,
  59     'git' => 40,
  60     'gzip' => 8,
  61     'hg' => 40,
  62     'md2' => 32,
  63     'md4' => 32,
  64     'md5' => 32,
  65     'sha0' => 40,
  66     'sha1' => 40,
  67     'sha224' => 56,
  68     'sha256' => 64,
  69     'sha384' => 96,
  70     'sha512' => 128,
  71     'skein256' => 64,
  72     'skein384' => 96,
  73     'skein512' => 128,
  74     'zip' => 8,
  75
  76 );
  77
  78 $Opt{'verbose'} -= $Opt{'quiet'};
  79 $Opt{'help'} && usage(0);
  80 if ($Opt{'version'}) {
  81     print_version();
  82     exit(0);
  83 }
  84
  85 exit(main());
  86
  87 sub main {
  88     # {{{
  89     my $Retval = 0;
  90
  91     my $minlen = 1;
  92     my $maxlen = '0';
  93
  94     my $l = $Opt{'length'};
  95     if ($l =~ /^(\d+)$/) {
  96         $minlen = $1;
  97         $maxlen = $minlen;
  98     } elsif ($l =~ /^(\d+)-$/) {
  99         $minlen = $1;
 100     } elsif ($l =~ /^-(\d+)$/) {
 101         $maxlen = $1;
 102     } elsif ($l =~ /^(\d+)-(\d+)$/) {
 103         $minlen = $1;
 104         $maxlen = $2;
 105     } elsif ($l =~ /^([0-9a-z])+$/) {
 106         my $val = $size{"$Opt{'length'}"};
 107         if (defined($val)) {
 108             $minlen = $val;
 109             $maxlen = $val;
 110         } else {
 111             warn("$progname: $l: Unknown length unit\n");
 112             return(1);
 113         }
 114     }
 115     msg(3, "minlen = '$minlen', maxlen = '$maxlen'");
 116
 117     my %uniq = ();
 118
 119     my $exp = '0-9';
 120     $Opt{'ignore-case'} && ($exp .= 'A-F');
 121     $Opt{'decimal'} || ($exp .= 'a-f');
 122     while (my $line = <>) {
 123         $line =~ s{
 124             ([$exp]+)
 125         }{
 126             my $str = $1;
 127             my $do_print = 1;
 128             length($str) < $minlen && ($do_print = 0);
 129             $maxlen && length($str) > $maxlen && ($do_print = 0);
 130             $str = lc($str);
 131             $Opt{'unique'} && $uniq{"$str"} && ($do_print = 0);
 132             $do_print && print("$str\n");
 133             $uniq{"$str"} = 1;
 134             '';
 135         }egx;
 136     }
 137     return $Retval;
 138     # }}}
 139 } # main()
 140
 141 sub unit_list {
 142     # {{{
 143     my @arr = ();
 144     for my $f (keys %size) {
 145         push(@arr, "$f ($size{$f})");
 146     }
 147     return(join(', ', sort(@arr)));
 148     # }}}
 149 } # unit_list()
 150
 151 sub print_version {
 152     # Print program version {{{
 153     print("$progname $VERSION\n");
 154     return;
 155     # }}}
 156 } # print_version()
 157
 158 sub usage {
 159     # Send the help message to stdout {{{
 160     my $Retval = shift;
 161
 162     if ($Opt{'verbose'}) {
 163         print("\n");
 164         print_version();
 165     }
 166     $Text::Wrap::columns = 72;
 167     my $unit_str = wrap(' ' x 6, ' ' x 6, unit_list());
 168     print(<<"END");
 169
 170 Usage: $progname [options] [file [files [...]]]
 171
 172 Options:
 173
 174   -h, --help
 175     Show this help.
 176   -d, --decimal
 177     Limit search to decimal (0-9) digits.
 178   -i, --ignore-case
 179     Also include hexadecimal digits with upper case (A-F).
 180   -l X, --length X
 181     List only values of length X where X can be:
 182       X
 183         Each printed value must be exactly X characters wide
 184       X-
 185         X or longer
 186       -X
 187         No longer than X characters
 188       X-Y
 189         Minimal and maximum length
 190     Default value: '1-'
 191     A list of predefined sizes can also be specified. Current list:
 192 $unit_str
 193   -q, --quiet
 194     Be more quiet. Can be repeated to increase silence.
 195   -u, --unique
 196     Don't print any value more than once.
 197   -v, --verbose
 198     Increase level of verbosity. Can be repeated.
 199   --version
 200     Print version information.
 201
 202 END
 203     exit($Retval);
 204     # }}}
 205 } # usage()
 206
 207 sub msg {
 208     # Print a status message to stderr based on verbosity level {{{
 209     my ($verbose_level, $Txt) = @_;
 210
 211     if ($Opt{'verbose'} >= $verbose_level) {
 212         print(STDERR "$progname: $Txt\n");
 213     }
 214     return;
 215     # }}}
 216 } # msg()
 217
 218 __END__
 219
 220 # This program is free software; you can redistribute it and/or modify
 221 # it under the terms of the GNU General Public License as published by
 222 # the Free Software Foundation; either version 2 of the License, or (at
 223 # your option) any later version.
 224 #
 225 # This program is distributed in the hope that it will be useful, but
 226 # WITHOUT ANY WARRANTY; without even the implied warranty of
 227 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 228 # See the GNU General Public License for more details.
 229 #
 230 # You should have received a copy of the GNU General Public License
 231 # along with this program.
 232 # If not, see L<http://www.gnu.org/licenses/>.
 233
 234 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :