decode_file

#!/usr/bin/env perl
use strict;
use warnings;

use Readonly;

Readonly::Scalar my $BS => 16;

use Getopt::Long qw(:config no_ignore_case bundling);
use Algorithm::FEC;
use IPC::Run qw(run);
use MIME::Base64;
use Number::Range;
use IO::File;
use List::MoreUtils qw(uniq);
use Image::Size;
use File::Temp;

sub read_image {
	my %args = @_;
	my %data;

	my $codes;
	my (undef, $img_height) = imgsize($args{filename});
	my $crop_h = int($img_height / 3.5);
	foreach my $off_y (map { int($_ * $img_height / 4) } 0..3) {
		my $codes_new;
		run
			["convert", @{$args{convert_options}}, "-crop", "100%x$crop_h+0+$off_y", "+repage", $args{filename}, "pnm:-"],
			"|", ["zbarimg", "--quiet", "--raw", "--", "-"], ">", \$codes_new;
		$codes .= $codes_new;
	}
	my @codes = uniq sort split(/\n/, $codes);

	foreach my $code (@codes) {
		if ($code =~ /^FI(.+)$/) {
			# fileid
			$data{fileid} = $1;
		} elsif ($code =~ /^(OS|LE)([0-9a-f]+)$/) {
			# offset/length
			my $f = {OS => "offset", LE => "length"}->{$1};
			if (defined($data{$f})) {
				die("Tried to set \"$f\" field twice");
			}
			$data{$f} = oct("0x$2");
		} elsif ($code =~ /^DBNONE\s*$/) {
			# no deleted blocks
			$data{deleted_blocks} = 1;
		} elsif ($code =~ /^DB(.*)$/) {
			# deleted blocks, fill them with null bytes.
			foreach my $bid (Number::Range->new($1)->range()) {
				push(@{$data{data_indices}}, $bid);
				push(@{$data{data}}        , "\0" x $BS);
			}
			$data{deleted_blocks} = 1;
		} elsif ($code =~ /^([0-9a-f]+):([A-Za-z0-9+\/=]{1,40})$/) {
			# data
			my ($off, $b64) = ($1, $2);
			$b64 .= "=" until (length($b64) % 4 == 0);
			push(@{$data{data_indices}}, oct("0x$off"));
			push(@{$data{data}}        , decode_base64($b64));
		} else {
			# warn("Ignoring unknown barcode input \"$code\"");
		}
	}

	foreach (qw(fileid offset length deleted_blocks)) {
		die("Required header field \"$_\" not found in image") if (!exists($data{$_}));
	}
	delete($data{deleted_blocks});

	if (@{$data{data} || []} < 256) {
		die("Could only retrieve " . scalar(@{$data{data} || []}) . " data lines from image \"$args{filename}\" - need at least 256");
	}

	my $fec = Algorithm::FEC->new(256, 320, $BS);
	my @f_d = @{$data{data}}[0..255];
	my @f_i = @{$data{data_indices}}[0..255];
	$fec->set_decode_blocks(\@f_d, \@f_i);
	$fec->decode();

	$data{data} = join("", @f_d);
	delete($data{data_indices});

	$data{data} = substr($data{data}, 0, $data{length});

	return %data;
}

sub try_read_image {
	my ($filename) = @_;
	my %data;

	foreach my $co (
		["-contrast-stretch", "35%x30%"],
		["-contrast-stretch", "30%x40%"],
		["-contrast-stretch", "25%x50%"],
		["-contrast-stretch", "20%x60%"],
		["-contrast-stretch", "20%x70%"],
		["-threshold", "75%"],
		[],
	) {
		eval {
			%data = read_image(filename => $filename, convert_options => $co);
		};
		if ($@) {
			if ($@ =~ /^(?:Required header field|Could only retrieve)/) {
				warn("[@{$co}] $@");
			} else {
				die($@);
			}
		} else {
			return %data;
		}
	}

	return ();
}

my %options = (
	filename_prefix => "dp_",
);

GetOptions(\%options,
	"filename_prefix|filename-prefix=s",
);

my $in_name;
my $tempfile;
if (!@ARGV) {
	if (-t STDIN) {
		die("No filename provided and STDIN is opened to a terminal.\nPlease provide a filename or image data");
	} else {
		$tempfile = File::Temp->new();
		print $tempfile do { local $/; <STDIN>; };
		close($tempfile);
		$in_name = $tempfile->filename;
	}
} else {
	$in_name = $ARGV[0];
}

my %image_data = try_read_image($in_name) or die("unable to get any usable data from $in_name");
print STDERR "retrieved data from image!\n";

if ($image_data{fileid} =~ /([^A-Za-z0-9\-_.])/) {
	die("file identifier \"$image_data{fileid}\" contains unsafe character $1");
}

my $filename = $options{filename_prefix} . $image_data{fileid};
my $outfile = IO::File->new($filename, O_WRONLY | O_CREAT)
	or die("unable to open output $filename: $!");
seek($outfile, $image_data{offset}, 0);
print $outfile $image_data{data};