#!/usr/bin/perl

use warnings;
use strict;
use Image::Sane ':all';
use Try::Tiny;
use Getopt::Long qw(:config no_ignore_case pass_through);
use File::Basename;
use IO::Handle;
use English qw( -no_match_vars );    # for $PROGRAM_NAME
use sigtrap qw/handler sighandler normal-signals/;
use Readonly;
Readonly my $BUFFER_SIZE   => ( 32 * 1024 );     # default size
Readonly my $START_COLUMN  => 8;
Readonly my $END_COLUMN    => 80;
Readonly my $INDENT        => 4;
Readonly my $BITS_PER_BYTE => 8;
Readonly my $MM_PER_CM     => 10;
Readonly my $MM_PER_INCH   => 25.4;
Readonly my $_8_BIT        => 8;
Readonly my $MAXVAL_8_BIT  => 2**$_8_BIT - 1;
Readonly my $_16_BIT       => 16;
Readonly my $MAXVAL_16_BIT => 2**$_16_BIT - 1;
Readonly my $HUNDRED       => 100.;
Readonly my $THOUSAND      => 1000.;
Readonly my $INFINITY      => -1;
Readonly my $I_TL_Y        => 3;
Readonly my $RGB_FRAMES    => 3;
Readonly my $_1_0_25       => 1.000025;

#$Image::Sane::DEBUG = 1;

my (
    %options, @window_val_user, @window_option, @window_val,
    @window,  $num_dev_options, $device,        $format,
    $devname, %option_number,   $batch_count,
);
my $verbose          = 0;
my $help             = 0;
my $all              = 0;
my $test             = 0;
my $batch            = 0;
my $batch_start_at   = 1;
my $batch_increment  = 1;
my $buffer_size      = $BUFFER_SIZE;
my $tl_x             = 0;
my $tl_y             = 0;
my $br_x             = 0;
my $br_y             = 0;
my $resolution_value = 0;
my $progress         = 0;
my $batch_double     = 0;
my $batch_prompt     = 0;
my $dont_scan        = 0;
my $prog_name        = basename($PROGRAM_NAME);
my $status           = SANE_STATUS_GOOD;
my $SPACE            = q{ };
my $EMPTY            = q{};
my $DASH             = q{-};
my @version          = Image::Sane->get_version;
my $version =
  $version[0] + $version[1] / $THOUSAND + $version[2] / $THOUSAND / $THOUSAND;
my @args = (
    \%options,
    'd|device-name=s' => \$devname,
    'L|list-devices',
    'f|formatted-device-list=s',
    'b|batch:s'         => \$format,
    'batch-start=i'     => \$batch_start_at,
    'batch-count=i'     => \$batch_count,
    'batch-increment=i' => \$batch_increment,
    'batch-double'      => \$batch_double,
    'batch-prompt'      => \$batch_prompt,
    'p|progress'        => \$progress,
    'n|dont-scan'       => \$dont_scan,
    'T|test'            => \$test,
    'A|all-options'     => \$all,
    'h|help'            => \$help,
    'v|verbose+'        => \$verbose,
    'B|buffer-size=i'   => \$buffer_size,
    'V|version',
);

sub printstdout {
    my ($msg) = @_;
    if ( defined $msg ) {
        if ( not print $msg) { die "Error writing to STDOUT\n" }
    }
    return;
}

sub printstderr {
    my ($msg) = @_;
    if ( defined $msg ) {
        print {*STDERR} $msg;    ## no critic (RequireCheckedSyscalls)
    }
    return;
}

sub sighandler {
    my $signum = shift;

    my $first_time = SANE_TRUE;

    if ($device) {
        printstderr("$prog_name: received signal $signum\n");
        if ($first_time) {
            $first_time = SANE_FALSE;
            printstderr("$prog_name: trying to stop scanner\n");
            $device->cancel;
        }
        else {
            printstderr("$prog_name: aborting\n");
            _exit(0);
        }
    }
    return;
}

sub print_unit {
    my ($unit) = @_;

    if ($unit == SANE_UNIT_PIXEL) {
        printstdout('pel');
    }
    elsif ($unit == SANE_UNIT_BIT) {
        printstdout('bit');
    }
    elsif ($unit == SANE_UNIT_MM) {
        printstdout('mm');
    }
    elsif ($unit == SANE_UNIT_DPI) {
        printstdout('dpi');
    }
    elsif ($unit == SANE_UNIT_PERCENT) {
        printstdout(q{%});
    }
    elsif ($unit == SANE_UNIT_MICROSECOND) {
        printstdout('us');
    }
    return;
}

sub print_option {
    ( $device, my $opt_num, my $opt, my $ro ) = @_;

    if ( $opt->{type} == SANE_TYPE_GROUP ) {
        printf "  %s:\n", $opt->{title};
        return;
    }

    # if both of these are set, option is invalid
    if (    $opt->{cap} & SANE_CAP_SOFT_SELECT
        and $opt->{cap} & SANE_CAP_HARD_SELECT )
    {
        printstderr("$prog_name: invalid option caps, SS+HS\n");
        return;
    }

    # invalid to select but not detect
    if ( $opt->{cap} & SANE_CAP_SOFT_SELECT
        and not( $opt->{cap} & SANE_CAP_SOFT_DETECT ) )
    {
        printstderr("$prog_name: invalid option caps, SS!SD\n");
        return;
    }

# standard allows this, though it makes little sense
# if($opt->{cap} & SANE_CAP_HARD_SELECT and !($opt->{cap} & SANE_CAP_SOFT_DETECT)){
#  printstderr("$prog_name: invalid option caps, HS!SD\n");
#  return;
# }

    # if one of these three is not set, option is useless, skip it
    if (
        not(
            $opt->{cap} & (
                SANE_CAP_SOFT_SELECT | SANE_CAP_HARD_SELECT |
                  SANE_CAP_SOFT_DETECT
            )
        )
      )
    {
        return;
    }

    # print the option
    if ( $opt->{name} =~ /^[xytl]$/xsm ) {
        printf '    -%s', $opt->{name};
    }
    else {
        printf '    --%s', $opt->{name};
    }

    print_option_choices($opt);
    print_current_option_value( $opt, $opt_num );

    if ( $opt->{cap} & SANE_CAP_INACTIVE ) {
        printstdout(' [inactive]');
    }
    elsif ( $opt->{cap} & SANE_CAP_HARD_SELECT ) {
        printstdout(' [hardware]');
    }
    elsif ( not( $opt->{cap} & SANE_CAP_SOFT_SELECT )
        and $opt->{cap} & SANE_CAP_SOFT_DETECT )
    {
        printstdout(' [read-only]');
    }

    printstdout("\n        ");

    my $column     = $START_COLUMN;
    my $last_break = 0;
    my $start      = 0;
    for my $pos ( 0 .. length( $opt->{desc} ) - 1 ) {
        ++$column;
        if ( substr( $opt->{desc}, $pos, 1 ) eq $SPACE ) {
            $last_break = $pos;
        }
        elsif ( substr( $opt->{desc}, $pos, 1 ) eq "\n" ) {
            $column     = $END_COLUMN;
            $last_break = $pos;
        }
        if ( $column >= $END_COLUMN - 1 and $last_break ) {
            while ( $start < $last_break ) {
                printstdout( substr $opt->{desc}, $start++, 1 );
            }
            $start = $last_break + 1;    # skip blank
            printstdout("\n        ");
            $column = $START_COLUMN + $pos - $start;
        }
    }
    while ( $start < length( $opt->{desc} ) ) {
        printstdout( substr $opt->{desc}, $start++, 1 );
    }
    printstdout("\n");
    return;
}

sub print_option_choices {
    my ($opt) = @_;
    if ( $opt->{type} == SANE_TYPE_BOOL ) {
        printstdout('[=(');
        if ( $opt->{cap} & SANE_CAP_AUTOMATIC ) { printstdout('auto|') }
        printstdout('yes|no)]');
    }
    elsif ( $opt->{type} == SANE_TYPE_BUTTON ) {
    }
    else {
        printstdout($SPACE);
        if ( $opt->{cap} & SANE_CAP_AUTOMATIC ) {
            printstdout('auto|');
        }
        if ( $opt->{constraint_type} == SANE_CONSTRAINT_NONE ) {
            if ( $opt->{type} == SANE_TYPE_INT ) {
                printstdout('<int>');
            }
            elsif ( $opt->{type} == SANE_TYPE_FIXED ) {
                printstdout('<float>');
            }
            elsif ( $opt->{type} == SANE_TYPE_STRING ) {
                printstdout('<string>');
            }
            if ( $opt->{max_values} > 1 ) { printstdout(',...') }
        }
        elsif ( $opt->{constraint_type} == SANE_CONSTRAINT_RANGE ) {
            my $string_format = '%g..%g';
            if ( $opt->{type} == SANE_TYPE_INT ) {
                $string_format = '%d..%d';
            }
            if ( $opt->{name} eq 'x' ) {
                printf $string_format, $opt->{constraint}{min},
                  $opt->{constraint}{max} - $tl_x;
            }
            elsif ( $opt->{name} eq 'y' ) {
                printf $string_format, $opt->{constraint}{min},
                  $opt->{constraint}{max} - $tl_y;
            }
            else {
                printf $string_format, $opt->{constraint}{min},
                  $opt->{constraint}{max};
            }
            print_unit( $opt->{unit} );
            if ( $opt->{max_values} > 1 ) { printstdout(',...') }
            if ( $opt->{constraint}{quant} ) {
                printstdout(" (in steps of $opt->{constraint}{quant})");
            }
        }
        elsif ( $opt->{constraint_type} == SANE_CONSTRAINT_STRING_LIST ||
                $opt->{constraint_type} == SANE_CONSTRAINT_WORD_LIST )
        {
            for my $i ( 0 .. $#{ $opt->{constraint} } ) {
                if ( $i > 0 ) { printstdout(q{|}) }
                my $string_format =
                  $opt->{type} == SANE_TYPE_FIXED ? '%g' : '%s';

                printf $string_format, $opt->{constraint}[$i];
            }
            if ( $opt->{constraint_type} == SANE_CONSTRAINT_WORD_LIST )
            {
                print_unit( $opt->{unit} );
                if ( $opt->{max_values} > 1 ) { printstdout(',...') }
            }
        }
    }
    return;
}

sub print_current_option_value {
    my ( $opt, $opt_num ) = @_;
    if ( $opt->{max_values} == 1 ) {
        if ( not( $opt->{cap} & SANE_CAP_INACTIVE ) ) {
            my $val = $device->get_option($opt_num);
            printstdout(' [');
            if ( $opt->{type} == SANE_TYPE_BOOL ) {
                printstdout( $val ? 'yes' : 'no' );
            }
            elsif ($opt->{type} == SANE_TYPE_INT
                or $opt->{type} == SANE_TYPE_FIXED )
            {
                my $string_format = '%g';
                if ( $opt->{type} == SANE_TYPE_INT ) { $string_format = '%d' }
                if ( $opt->{name} eq 'l' ) {
                    $tl_x = $val;
                    printf $string_format, $tl_x;
                }
                elsif ( $opt->{name} eq 't' ) {
                    $tl_y = $val;
                    printf $string_format, $tl_y;
                }
                elsif ( $opt->{name} eq 'x' ) {
                    $br_x = $val;
                    printf $string_format, $br_x - $tl_x;
                }
                elsif ( $opt->{name} eq 'y' ) {
                    $br_y = $val;
                    printf $string_format, $br_y - $tl_y;
                }
                else {
                    printf $string_format, $val;
                }
            }
            elsif ( $opt->{type} == SANE_TYPE_STRING ) {
                printstdout($val);
            }
            printstdout(']');
        }
    }
    return;
}

# A scalar has the following syntax:
#
#     V [ U ]
#
#   V is the value of the scalar.  It is either an integer or a
#   floating point number, depending on the option type.
#
#   U is an optional unit.  If not specified, the default unit is used.
#   The following table lists which units are supported depending on
#   what the option's default unit is:
#
#     Option's unit:	Allowed units:
#
#     SANE_UNIT_NONE:
#     SANE_UNIT_PIXEL:	pel
#     SANE_UNIT_BIT:	b (bit), B (byte)
#     SANE_UNIT_MM:	mm (millimeter), cm (centimeter), in or " (inches),
#     SANE_UNIT_DPI:	dpi
#     SANE_UNIT_PERCENT:	%
#     SANE_UNIT_MICROSECOND:	us

sub parse_scalar {
    my ( $opt, $str ) = @_;

    my ( $v, $unit, $rest );
    if (
        $str =~ qr{^
               (\d*[.]?\d*) # value
               (cm|mm|in|["bB%]|dpi|us)? # optional unit
               (.*) # rest of string
              }xsm
      )
    {
        $v    = $1;
        $unit = $2;
        $rest = $3;
        if ( not defined $unit ) { $unit = $EMPTY }
    }
    else {
        die
"$prog_name: option --$opt->{name}: bad option value (rest of option: $str)\n";
    }

    if ( $opt->{unit} == SANE_UNIT_BIT ) {
        if ( $unit eq 'B' ) { $v *= $BITS_PER_BYTE }
    }
    elsif ( $opt->{unit} == SANE_UNIT_MM ) {
        if ( $unit eq 'cm' ) {
            $v *= $MM_PER_CM;
        }
        elsif ( $unit eq 'in' ) {
            $v *= $MM_PER_INCH;
        }
    }
    return $v, $rest;
}

# A vector has the following syntax:
#
#     [ '[' I ']' ] S { [','|'-'] [ '[' I ']' S }
#
#   The number in brackets (I), if present, determines the index of the
#   vector element to be set next.  If I is not present, the value of
#   last index used plus 1 is used.  The first index value used is 0
#   unless I is present.
#
#   S is a scalar value as defined by parse_scalar().
#
#   If two consecutive value specs are separated by a comma (,) their
#   values are set independently.  If they are separated by a dash (-),
#   they define the endpoints of a line and all vector values between
#   the two endpoints are set according to the value of the
#   interpolated line.  For example, [0]15-[255]15 defines a vector of
#   256 elements whose value is 15.  Similarly, [0]0-[255]255 defines a
#   vector of 256 elements whose value starts at 0 and increases to
#   255.

sub parse_vector {
    my ( $opt, $str ) = @_;

    my $index      = $INFINITY;
    my $prev_value = 0;
    my $prev_index = 0;
    my $separator  = $EMPTY;
    my ( @vector, $value );
    while ( length $str ) {
        if ( $str =~ /^\[(\d+)(\])?/xsm ) {
            $index = $1;
            if ( $2 ne '\]' ) {
                die
                  "$prog_name: option --$opt->{name}: closing bracket missing "
                  . "(rest of option: $str)\n";
            }
        }
        else {
            ++$index;
        }

        if ( $index < 0 or $index >= length $str ) {
            my $msg = sprintf
"$prog_name: option --$opt->{name}: index $index out of range [0..%d]",
              length $str;
            die "$msg\n";
        }

        # read value
        ( $value, $str ) = parse_scalar( $opt, $str );

        if ( $str ne $EMPTY and $str !~ /^[-,]/xsm ) {
            die
"$prog_name: option --$opt->{name}: illegal separator (rest of option: $str)\n";
        }

        # store value:
        push @vector, $value;
        if ( $separator eq $DASH ) {

            # interpolate
            my $v = $prev_value;
            my $slope = ( $value - $v ) / ( $index - $prev_index );

            for my $i ( $prev_index + 1 .. $index - 1 ) {
                $v += $slope;
                push @vector, $v;
            }
        }

        $prev_index = $index;
        $prev_value = $value;
        $separator  = substr $str, 0, 1;
    }

    if ( $verbose > 2 ) {
        printstderr("$prog_name: value for --$opt->{name} is: ");
        for (@vector) {
            printstderr("$_ ");
        }
        printstderr("\n");
    }

    return @vector;
}

sub fetch_options {
    $device = shift;

    my $opt = $device->get_option_descriptor(0);
    if ( not defined $opt ) {
        die "Could not get option descriptor for option 0\n";
    }

    try {
        $num_dev_options = $device->get_option(0);
    }
    catch {
        die 'Could not get value for option 0:', $_->error, "\n";
    };

    # build the full table of long options
    for my $i ( 1 .. $num_dev_options - 1 ) {
        $opt = $device->get_option_descriptor($i);
        if ( not defined $opt ) {
            die "Could not get option descriptor for option $i\n";
        }

        next if ( not( $opt->{cap} & SANE_CAP_SOFT_SELECT ) );

        $option_number{ $opt->{name} } = $i;

        update_geometry( $opt, $i );

        if ( $opt->{type} == SANE_TYPE_BOOL ) {
            push @args, "$opt->{name}:s";
        }
        elsif ( $opt->{type} == SANE_TYPE_BUTTON ) {
            push @args, $opt->{name};
        }
        else {
            push @args, "$opt->{name}=s";
        }
    }

    # Initialize width & height options based on backend default
    # values for top-left x/y and bottom-right x/y:
    for my $i ( 0 .. 1 ) {
        if ( $window[$i] and not $window_val_user[$i] ) {
            $window_val[$i] = $device->get_option( $window[$i] );
            if ( $window[ $i + 2 ] ) {
                my $pos = $device->get_option( $window[ $i + 2 ] );
                $window_val[$i] -= $pos;
            }
        }
    }
    return;
}

# Keep track of top-left corner options (if they exist at
# all) and replace the bottom-right corner options by a
# width/height option (if they exist at all).
sub update_geometry {
    my ( $opt, $i ) = @_;
    if (    ( $opt->{type} == SANE_TYPE_FIXED or $opt->{type} == SANE_TYPE_INT )
        and ( $opt->{unit} == SANE_UNIT_MM or $opt->{unit} == SANE_UNIT_PIXEL )
      )
    {
        if ( $opt->{name} eq SANE_NAME_SCAN_BR_X ) {
            $window[0]                 = $i;
            $opt->{name}               = 'x';
            $window_option[0]          = $opt;
            $window_option[0]->{title} = 'Scan width';
            $window_option[0]->{desc}  = 'Width of scan-area.';
            $window_option[0]->{name}  = 'x';
        }
        elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_Y ) {
            $window[1]                 = $i;
            $opt->{name}               = 'y';
            $window_option[1]          = $opt;
            $window_option[1]->{title} = 'Scan height';
            $window_option[1]->{desc}  = 'Height of scan-area.';
            $window_option[1]->{name}  = 'y';
        }
        elsif ( $opt->{name} eq SANE_NAME_SCAN_TL_X ) {
            $window[2]                = $i;
            $window_option[2]         = $opt;
            $window_option[2]->{name} = 'l';
        }
        elsif ( $opt->{name} eq SANE_NAME_SCAN_TL_Y ) {
            $window[$I_TL_Y]                = $i;
            $window_option[$I_TL_Y]         = $opt;
            $window_option[$I_TL_Y]->{name} = 't';
        }
    }
    return;
}

sub set_option {
    ( $device, my $optnum, my $value ) = @_;

    my $opt = $device->get_option_descriptor($optnum);
    if ( $opt and ( $opt->{cap} & SANE_CAP_INACTIVE ) ) {
        if ( $verbose > 0 ) {
            printstderr(
"$prog_name: ignored request to set inactive option $opt->{name}\n"
            );
        }
        return;
    }

    my $info;
    try {
        $info = $device->set_option( $optnum, $value );
    }
    catch {
        die "$prog_name: setting of option --$opt->{name} failed ("
          . $_->error . "\n";
    };

    if ( ( $info & SANE_INFO_INEXACT ) and $opt->{max_values} == 1 ) {
        my $orig = $value;
        $value = $device->get_option($optnum);
        if ( $opt->{type} == SANE_TYPE_INT ) {
            printstderr(
                sprintf
                  "$prog_name: rounded value of $opt->{name} from %d to %d\n",
                $orig, $value
            );
        }
        elsif ( $opt->{type} == SANE_TYPE_FIXED ) {
            printstderr(
                sprintf
                  "$prog_name: rounded value of $opt->{name} from %g to %g\n",
                $orig, $value
            );
        }
    }
    if ( $info & SANE_INFO_RELOAD_OPTIONS ) { fetch_options($device) }
    return;
}

sub process_backend_option {
    ( $device, my $optnum, my $optarg ) = @_;

    my $opt = $device->get_option_descriptor($optnum);

    if ( $opt and ( $opt->{cap} & SANE_CAP_INACTIVE ) ) {
        die "$prog_name: attempted to set inactive option $opt->{name}\n";
    }

    if (    ( $opt->{cap} & SANE_CAP_AUTOMATIC )
        and $optarg
        and $optarg =~ /^auto$/xsmi )
    {
        try {
            $device->set_auto($optnum);
        }
        catch {
            die
              "$prog_name: failed to set option --$opt->{name} to automatic ("
              . $_->error . ")\n";
        };
        return;
    }

    my $value;
    if ( $opt->{type} == SANE_TYPE_BOOL ) {
        $value = 1;    # no argument means option is set
        if ($optarg) {
            if ( $optarg =~ /^yes$/xsmi ) {
                $value = 1;
            }
            elsif ( $optarg =~ /^no$/xsmi ) {
                $value = 0;
            }
            else {
                die
"$prog_name: option --$opt->{name}: bad option value `$optarg'\n";
            }
        }
    }
    elsif (
             $opt->{type} == SANE_TYPE_INT
          or $opt->{type} == SANE_TYPE_FIXED
      )
    {
        my @vector = parse_vector( $opt, $optarg );
        $value = \@vector;
    }
    elsif ( $opt->{type} == SANE_TYPE_STRING ) {
        $value = $optarg;
    }
    elsif ( $opt->{type} == SANE_TYPE_BUTTON) {
        $value = 0;    # value doesn't matter
    }
    else {
        warn "$prog_name: duh, got unknown option type $opt->{type}\n";
        return;
    }
    set_option( $device, $optnum, $value );
    return;
}

sub write_pnm_header {
    my ( $frame_format, $width, $height, $depth ) = @_;

    # The netpbm-package does not define raw image data with maxval > 255.
    # But writing maxval 65535 for 16bit data gives at least a chance
    # to read the image.

    if (   $frame_format == SANE_FRAME_RED
        or $frame_format == SANE_FRAME_GREEN
        or $frame_format == SANE_FRAME_BLUE
        or $frame_format == SANE_FRAME_RGB )
    {
        printf "P6\n# SANE data follows\n%d %d\n%d\n", $width, $height,
          ( $depth > $_8_BIT ) ? $MAXVAL_16_BIT : $MAXVAL_8_BIT;
    }
    else {
        if ( $depth == 1 ) {
            printf "P4\n# SANE data follows\n%d %d\n", $width, $height;
        }
        else {
            printf "P5\n# SANE data follows\n%d %d\n%d\n", $width, $height,
              ( $depth > $_8_BIT ) ? $MAXVAL_16_BIT : $MAXVAL_8_BIT;
        }
    }
    return;
}

sub scan_it {
    my $first_frame = 1;
    my $offset      = 0;
    my $must_buffer = 0;
    my $min         = $MAXVAL_8_BIT;
    my $max         = 0;
    my %image;
    my @format_name = qw( gray RGB red green blue );
    my $total_bytes = 0;

    # my $hang_over = $INFINITY;

    my $parm;
    while (1) {
        if ( not $first_frame ) {
            try {
                $device->start;
            }
            catch {
                printstderr( "$prog_name: sane_start: " . $_->error . "\n" );
                log_bytes_read( $parm, $total_bytes );
            };
        }

        try {
            $parm = $device->get_parameters;
        }
        catch {
            printstderr(
                "$prog_name: sane_get_parameters: " . $_->error . "\n" );
        };
        log_frame_info( $parm, $total_bytes, $first_frame, @format_name );

        ( $must_buffer, $offset ) = initialise_scan( $parm, $first_frame );
        my $hundred_percent = $parm->{bytes_per_line} * $parm->{lines} * (
            (
                     $parm->{format} == SANE_FRAME_RGB
                  or $parm->{format} == SANE_FRAME_GRAY
            ) ? 1 : $RGB_FRAMES
        );

        while (1) {
            my ( $buffer, $len );
            $status = SANE_STATUS_GOOD;
            try {
                ( $buffer, $len ) = $device->read($buffer_size);
                $total_bytes += $len;
                my $progr = ( ( $total_bytes * $HUNDRED ) / $hundred_percent );
                if ( $progr > $HUNDRED ) { $progr = $HUNDRED }
                if ($progress) {
                    printstderr( sprintf "Progress: %3.1f%%\r", $progr );
                }
            }
            catch {
                $status = $_->status;
                if ( $verbose and $parm->{depth} == $_8_BIT ) {
                    printstderr(
                        sprintf "$prog_name: min/max graylevel value = %d/%d\n",
                        $min, $max
                    );
                }
                if ( $status != SANE_STATUS_EOF ) {
                    printstderr( "$prog_name: sane_read: " . $_->error . "\n" );
                    return;
                }
            };
            if ($status) { last }

            $offset =
              buffer_data( $parm, $buffer, $len, \%image, $offset,
                $must_buffer );

            if ( $verbose and $parm->{depth} == $_8_BIT ) {
                for ( split $EMPTY, $buffer ) {
                    my $c = ord;
                    if ( $c >= $max ) {
                        $max = $c;
                    }
                    elsif ( $c < $min ) {
                        $min = $c;
                    }
                }
            }

        }
        $first_frame = 0;
        if ( $parm->{last_frame} ) { last }
    }

    if ($must_buffer) {
        write_buffer( \%image, $parm );
    }

    # flush the output buffer
    STDOUT->flush;

    log_bytes_read( $parm, $total_bytes );
    return;
}

sub log_frame_info {
    my ( $parm, $total_bytes, $first_frame, @format_name ) = @_;

    if ($verbose) {
        if ($first_frame) {
            if ( $parm->{lines} >= 0 ) {
                printstderr(
                    sprintf
                      "$prog_name: scanning image of size %dx%d pixels at "
                      . "%d bits/pixel\n",
                    $parm->{pixels_per_line},
                    $parm->{lines},
                    $parm->{depth} *
                      ( $parm->{format} == SANE_FRAME_RGB ? $RGB_FRAMES : 1 )
                );
            }
            else {
                printstderr(
                    sprintf "$prog_name: scanning image %d pixels wide and "
                      . "variable height at %d bits/pixel\n",
                    $parm->{pixels_per_line},
                    $parm->{depth} *
                      ( $parm->{format} == SANE_FRAME_RGB ? $RGB_FRAMES : 1 )
                );
            }
        }

        printstderr(
            sprintf "$prog_name: acquiring %s frame\n",
            $parm->{format} <= SANE_FRAME_BLUE
            ? $format_name[ $parm->{format} ]
            : 'Unknown'
        );
    }
    return;
}

sub log_bytes_read {
    my ( $parm, $total_bytes ) = @_;
    my $expected_bytes = $parm->{bytes_per_line} * $parm->{lines} * (
        (
                 $parm->{format} == SANE_FRAME_RGB
              or $parm->{format} == SANE_FRAME_GRAY
        ) ? 1 : $RGB_FRAMES
    );
    if ( $parm->{lines} < 0 ) { $expected_bytes = 0 }
    if ( $total_bytes > $expected_bytes and $expected_bytes != 0 ) {
        printstderr(
            sprintf '%s: WARNING: read more data than announced by backend '
              . "(%u/%u)\n",
            $prog_name, $total_bytes, $expected_bytes );
    }
    elsif ($verbose) {
        printstderr( sprintf "%s: read %u bytes in total\n",
            $prog_name, $total_bytes );
    }
    return;
}

sub initialise_scan {
    my ( $parm, $first_frame ) = @_;
    my ( $must_buffer, $offset );
    if ($first_frame) {
        if (   $parm->{format} == SANE_FRAME_RED
            or $parm->{format} == SANE_FRAME_GREEN
            or $parm->{format} == SANE_FRAME_BLUE )
        {
            if ( $parm->{depth} != $_8_BIT ) {
                die # FIXME: compare message with SANE source, and give them patch if necessary
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 8)\n";
            }
            $must_buffer = 1;
            $offset      = $parm->{format} - SANE_FRAME_RED;
        }
        elsif ( $parm->{format} == SANE_FRAME_RGB ) {
            if (    ( $parm->{depth} != $_8_BIT )
                and ( $parm->{depth} != $_16_BIT ) )
            {
                die # FIXME: compare message with SANE source, and give them patch if necessary
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 8 or 16)\n";
            }
        }
        if (   $parm->{format} == SANE_FRAME_RGB
            or $parm->{format} == SANE_FRAME_GRAY )
        {
            if (    ( $parm->{depth} != 1 )
                and ( $parm->{depth} != $_8_BIT )
                and ( $parm->{depth} != $_16_BIT ) )
            {
                die # FIXME: compare message with SANE source, and give them patch if necessary
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 1, 8 or 16)\n";
            }
            if ( $parm->{lines} < 0 ) {
                $must_buffer = 1;
                $offset      = 0;
            }
            else {

      #     if ($output_format == OUTPUT_TIFF) {
      #       sanei_write_tiff_header ($parm->{format},
      #                                $parm->{pixels_per_line}, $parm->{lines},
      #                                $parm->{depth}, $resolution_value,
      #                                icc_profile);
      #     else {
                write_pnm_header(
                    $parm->{format}, $parm->{pixels_per_line},
                    $parm->{lines},  $parm->{depth}
                );

                #      }
            }
        }
    }
    else {
        die # FIXME: compare message with SANE source, and give them patch if necessary
"Error: frame format $parm->{format}, but expected SANE_FRAME_RED, SANE_FRAME_GREEN, or SANE_FRAME_BLUE\n"
          if ( $parm->{format} < SANE_FRAME_RED
            or $parm->{format} > SANE_FRAME_BLUE );
        $offset = $parm->{format} - SANE_FRAME_RED;
    }
    return $must_buffer, $offset;
}

sub buffer_data {    ## no critic (ProhibitManyArgs)
    my ( $parm, $buffer, $len, $image, $offset, $must_buffer ) = @_;
    if ($must_buffer) {

        # We're either scanning a multi-frame image or the
        # scanner doesn't know what the eventual image height
        # will be (common for hand-held scanners).  In either
        # case, we need to buffer all data before we can write
        # the image
        if (   $parm->{format} == SANE_FRAME_RED
            or $parm->{format} == SANE_FRAME_GREEN
            or $parm->{format} == SANE_FRAME_BLUE )
        {
            for my $i ( 0 .. $len - 1 ) {
                $image->{data}[ $offset + $RGB_FRAMES * $i ] = substr $buffer,
                  $i, 1;
            }
            $offset += $RGB_FRAMES * $len;
        }
        elsif ($parm->{format} == SANE_FRAME_RGB
            or $parm->{format} == SANE_FRAME_GRAY )
        {
            for my $i ( 0 .. $len - 1 ) {
                $image->{data}[ $offset + $i ] = substr $buffer, $i, 1;
            }
            $offset += $len;
        }
    }
    else {    # ! must_buffer

        #    if (($output_format == OUTPUT_TIFF) or ($parm->{depth} != 16)) {
        #     printstdout($buffer);
        #    }
        #    else {
##if !defined(WORDS_BIGENDIAN)
        #     my $start = 0;
        #
        #     # check if we have saved one byte from the last sane_read
        #     if ($hang_over >= 0) {
        #      if ($len > 0) {
        #       printstdout($buffer);
        #       $buffer = $hang_over.$buffer;
        #       $hang_over = $INFINITY;
        #       $start = 1;
        #      }
        #     }
        #     # now do the byte-swapping
        #     $buffer = reverse $buffer;
        #
        #     # check if we have an odd number of bytes
        #     if ((($len - $start) % 2) != 0) {
        #      $hang_over = substr($buffer, $len - 1, 1);
        #      $len--;
        #     }
##endif
        printstdout($buffer);

        #    }
    }
    return $offset;
}

sub write_buffer {
    my ( $image, $parm ) = @_;
    if ( $parm->{lines} > 0 ) {
        $image->{height} = $parm->{lines};
    }
    else {
        $image->{height} = @{ $image->{data} } / $parm->{pixels_per_line};
        if (   $parm->{format} == SANE_FRAME_RED
            or $parm->{format} == SANE_FRAME_GREEN
            or $parm->{format} == SANE_FRAME_BLUE )
        {
            $image->{height} /= $RGB_FRAMES;
        }
    }

#  if ($output_format == OUTPUT_TIFF) {
#   sanei_write_tiff_header ($parm->{format}, $parm->{pixels_per_line},
#                             $parm->{lines}, $parm->{depth}, $resolution_value,
#                             icc_profile);
#  }
#  else {
    write_pnm_header(
        $parm->{format},  $parm->{pixels_per_line},
        $image->{height}, $parm->{depth}
    );

    #  }
    #  if (($output_format == OUTPUT_TIFF) or ($image->{Bpp} == 1)
    #      or ($image->{Bpp} == 3)) {
    #   printstdout($image->{data});
    #  }
    #  else { # $image->{Bpp} == 2 or $image->{Bpp} == 6 assumed
##if !defined(WORDS_BIGENDIAN)
#   for (my $i = 0; $i < $image->{Bpp} * $image->{height} * $image->{width}; $i += 2) {
#    my $LSB = $image->{data}[$i];
#    $image->{data}[$i] = $image->{data}[$i + 1];
#    $image->{data}[$i + 1] = $LSB;
#   }
##endif
    for ( @{ $image->{data} } ) { print }  ## no critic (RequireCheckedSyscalls)

    #  }
    return;
}

sub log_batch_scan {
    if ($batch) {
        if ( not defined $format or $format eq $EMPTY ) {

            #  if ($output_format == OUTPUT_TIFF) {
            #   $format = "out%d.tif";
            #  }
            #  else {
            $format = 'out%d.pnm';

            #  }
        }

        if ( $version > $_1_0_25 ) {
            my $plural = $batch_count == 1 ? $EMPTY : 's';
            if ( $batch_count == $INFINITY ) {
                printstderr( sprintf 'Scanning infinity ' );
            }
            else {
                printstderr( sprintf 'Scanning %d ', $batch_count );
            }
            printstderr(
                sprintf "page%s, incrementing by %d, numbering from %d\n",
                $plural, $batch_increment, $batch_start_at );
        }
        else {
            printstderr(
                sprintf
                  "Scanning %d pages, incrementing by %d, numbering from %d\n",
                $batch_count, $batch_increment, $batch_start_at );
        }
    }
    return;
}

sub scan_pages {
    my $n = $batch_start_at;

    log_batch_scan();
    while (1) {
        my ( $path, $part_path, $fh );
        if ($batch) {    # format is NULL unless batch mode
            $path = sprintf $format, $n;
            $part_path = "$path.part";

            if ($batch_prompt) {
                printstderr( sprintf "Place document no. %d on the scanner.\n",
                    $n );
                printstderr("Press <RETURN> to continue.\n");
                printstderr("Press Ctrl + D to terminate.\n");

                if ( not defined <> ) {
                    printstderr( sprintf "Batch terminated, %d pages scanned\n",
                        ( $n - $batch_increment ) );
                    last;    # get out of this loop
                }
            }
            printstderr( sprintf "Scanning page %d\n", $n );
        }

        $status = SANE_STATUS_GOOD;
        try {
            $device->start;
        }
        catch {
            $status = $_->status;
            printstderr( "$prog_name: sane_start: " . $_->error . "\n" );
        };
        if ($status) { last }

        # write to .part file while scanning is in progress
        if (
            $batch
            and not(
                open $fh, '>',    ## no critic (RequireBriefOpen)
                $part_path and STDOUT->fdopen( $fh, '>' )
            )
          )
        {
            printstderr("cannot open $part_path\n");
            $device->cancel;
            scanimage_exit(SANE_STATUS_ACCESS_DENIED);
        }

        scan_it();
        if ($batch) {
            printstderr( sprintf 'Scanned page %d.',         $n );
            printstderr( sprintf " (scanner status = %d)\n", $status );
        }

        if ( $status == SANE_STATUS_EOF ) {
            if ($batch) {

               # close output file by redirecting, do not close stdout here!
                if (
                    open $fh, '>',    ## no critic (RequireBriefOpen)
                    '/dev/null' and STDOUT->fdopen( $fh, '>' )
                  )
                {

                    # let the fully scanned file show up
                    if ( not rename $part_path, $path ) {
                        printstderr("cannot rename $part_path to $path\n");
                        try {
                            $device->cancel;
                        }
                        catch {};
                        return SANE_STATUS_ACCESS_DENIED;
                    }
                }
                else {
                    printstderr("cannot open /dev/null\n");
                    try {
                        $device->cancel;
                    }
                    catch {};
                    return SANE_STATUS_ACCESS_DENIED;
                }
            }
        }
        elsif ( $status == SANE_STATUS_GOOD ) {
            if ($batch) {
                close $fh or warn "cannot close file\n";
                unlink $part_path;
            }
            last;
        }
        $n += $batch_increment;

        if ( not ok_for_next_page() ) { last }
    }
    if ( $batch and $version > $_1_0_25 ) {
        printstderr(
            sprintf "Batch terminated, %d pages scanned\n",
            ( $n - $batch_start_at ) / $batch_increment
        );
    }

    try {
        $device->cancel;
    }
    catch {};
    return;
}

sub ok_for_next_page {
    return (
        $batch and ( $batch_count == $INFINITY
            or --$batch_count )
          and ($status == SANE_STATUS_GOOD
            or $status == SANE_STATUS_EOF )
    );
}

sub pass_fail {
    my ( $max, $len, $buffer ) = @_;

    if ( $status != SANE_STATUS_GOOD ) {  ## no critic (ProhibitCascadingIfElse)
        printstderr( 'FAIL Error: ' . $_->error . "\n" );
    }
    elsif ( $len < length $buffer ) {
        printstderr( sprintf "FAIL Cheat: %d bytes\n", length $buffer );
    }
    elsif ( $len > $max ) {
        printstderr( sprintf "FAIL Overflow: %d bytes\n", $len );
    }
    elsif ( $len == 0 ) {
        printstderr("FAIL No data\n");
    }
    else {
        printstderr("PASS\n");
    }
    return;
}

sub test_it {
    my ( %image, $parm, $len );
    my @format_name = qw( gray RGB red green blue );
    $status = SANE_STATUS_GOOD;

    try {
        $device->start;
    }
    catch {
        $status = $_->status;
        printstderr( "$prog_name: sane_start: " . $_->error . "\n" );
        goto CLEANUP;
    };

    try {
        $parm = $device->get_parameters;
    }
    catch {
        $status = $_->status;
        printstderr( "$prog_name: sane_get_parameters: " . $_->error . "\n" );
        goto CLEANUP;
    };

    if ( $parm->{lines} >= 0 ) {
        printstderr(
            sprintf "$prog_name: scanning image of size %dx%d pixels at "
              . "%d bits/pixel\n",
            $parm->{pixels_per_line},
            $parm->{lines},
            $parm->{depth} *
              ( $parm->{format} == SANE_FRAME_RGB ? $RGB_FRAMES : 1 )
        );
    }
    else {
        printstderr(
            sprintf "$prog_name: scanning image %d pixels wide and "
              . "variable height at %d bits/pixel\n",
            $parm->{pixels_per_line},
            $parm->{depth} *
              ( $parm->{format} == SANE_FRAME_RGB ? $RGB_FRAMES : 1 )
        );
    }
    printstderr(
        sprintf "$prog_name: acquiring %s frame, %d bits/sample\n",
        $parm->{format} <= SANE_FRAME_BLUE
        ? $format_name[ $parm->{format} ]
        : 'Unknown',
        $parm->{depth}
    );

    printstderr( sprintf "$prog_name: reading one scanline, %d bytes...\t",
        $parm->{bytes_per_line} );
    try {
        ( $image{data}, $len ) = $device->read( $parm->{bytes_per_line} );
        pass_fail( $parm->{bytes_per_line}, $len, $image{data} );
    }
    catch {
        $status = $_->status;
        goto CLEANUP;
    };

    printstderr("$prog_name: reading one byte...\t\t");
    try {
        ( $image{data}, $len ) = $device->read(1);
        pass_fail( 1, $len, $image{data} );
    }
    catch {
        $status = $_->status;
        goto CLEANUP;
    };

    my $i;
    for ( $i = 2 ; $i < $parm->{bytes_per_line} * 2 ; $i *= 2 )
    {    ## no critic (ProhibitCStyleForLoops)
        printstderr( sprintf "$prog_name: stepped read, %d bytes... \t", $i );
        try {
            ( $image{data}, $len ) = $device->read($i);
            pass_fail( $i, $len, $image{data} );
        }
        catch {
            $status = $_->status;
            goto CLEANUP;
        };
    }

    for ( $i /= 2 ; $i > 2 ; $i /= 2 ) {   ## no critic (ProhibitCStyleForLoops)
        printstderr( sprintf "$prog_name: stepped read, %d bytes... \t",
            $i - 1 );
        try {
            ( $image{data}, $len ) = $device->read( $i - 1 );
            pass_fail( $i - 1, $len, $image{data} );
        }
        catch {
            $status = $_->status;
            goto CLEANUP;
        };
    }

  CLEANUP:
    $device->cancel;
    return $status;
}

sub scanimage_exit {
    my ($exit_status) = @_;
    if ($device) {
        if ( $verbose > 1 ) {
            printstderr("Closing device\n");
        }
        undef $device;
    }
    if ( $verbose > 1 ) {
        printstderr("Calling sane_exit\n");
    }

    #  Image::Sane->_exit();

    if ( $verbose > 1 ) {
        printstderr("scanimage: finished\n");
    }
    exit $exit_status;
}

# @brief print device options to stdout
#
# @param device struct of the opened device to describe
# @param num_dev_options number of device options
# @param ro SANE_TRUE to print read-only options
sub print_options {
    ( $device, my $num_dev_options, my $ro ) = @_;

    for my $i ( 1 .. $num_dev_options - 1 ) {
        my $opt;

        # scan area uses modified option struct
        for my $j ( 0 .. $I_TL_Y ) {
            if ( $i == $window[$j] ) {
                $opt = $window_option[$j];
            }
        }
        if ( not defined $opt ) { $opt = $device->get_option_descriptor($i) }

        if (   $ro
            or $opt->{cap} & SANE_CAP_SOFT_SELECT
            or $opt->{type} == SANE_TYPE_GROUP )
        {
            print_option( $device, $i, $opt );
        }
    }
    if ($num_dev_options) { printstdout("\n") }
    return;
}

sub process_arguments {

    # re-enable error printing and arg permutation
    Getopt::Long::Configure('no_pass_through');

 # There seems to be a bug in Getopt::Long 2.37 where l is treated as L whilst
 # l is not in @args. Therefore the workaround is to rename l to m for the first
 # scan and back to l for the second.
    for (@ARGV) {
        if ( $_ eq '-m' ) { $_ = '-l' }
        if ( $_ eq '-u' ) { $_ = '-t' }
    }
    my @argv_old = @ARGV;
    if ( not GetOptions(@args) ) { scanimage_exit(1) }

    # As it isn't possible to get the argument order from Getopt::Long 2.37, do
    # this myself
    for (@argv_old) {
        my $ch;
        if (/--(.*)/xsm) {
            $ch = $1;
            my $i = index $ch, q{=};
            if ( $i >= 0 ) {
                $ch = substr $ch, 0, $i;
            }
        }
        elsif (/-(.)/xsm) {
            $ch = $1;
        }
        else {
            next;
        }
        if ( defined $options{$ch} ) {
            if ( $ch eq 'x' ) {
                $window_val_user[0] = 1;
                ( $window_val[0] ) =
                  parse_vector( $window_option[0], $options{x} );
            }
            elsif ( $ch eq 'y' ) {
                $window_val_user[1] = 1;
                ( $window_val[1] ) =
                  parse_vector( $window_option[1], $options{y} );
            }
            elsif ( $ch eq 'l') {    # tl-x
                process_backend_option( $device, $window[2], $options{l} );
            }
            elsif ( $ch eq 't') {    # tl-y
                process_backend_option( $device, $window[$I_TL_Y],
                    $options{t} );
            }
            else {
                process_backend_option( $device, $option_number{$ch},
                    $options{$ch} );
            }
        }
    }

    # convert x/y to br_x/br_y
    for my $index ( 0 .. 1 ) {
        if ( $window[$index] and defined $window_val[$index] ) {
            my $val = $window_val[$index];
            if ( $window[ $index + 2 ] ) {
                my $pos = $device->get_option( $window[ $index + 2 ] );
                $val += $pos;
            }
            set_option( $device, $window[$index], $val );
        }
    }
    return;
}

sub list_device_names {
    printstdout(
"Type ``$prog_name --help -d DEVICE'' to get list of all options for DEVICE.\n\nList of available devices:"
    );
    my @device_list = Image::Sane->get_devices;
    if ( $status == SANE_STATUS_GOOD ) {
        my $column = $END_COLUMN;

        for (@device_list) {
            if ( $column + length( $_->{name} ) + 1 >= $END_COLUMN ) {
                printstdout("\n    ");
                $column = $INDENT;
            }
            if ( $column > $INDENT ) {
                printstdout($SPACE);
                $column += 1;
            }
            printstdout( $_->{name} );
            $column += length( $_->{name} );
        }
    }
    printstdout("\n");
    return;
}

sub list_devices_verbose {
    my @device_list = Image::Sane->get_devices;
    if ( $status != SANE_STATUS_GOOD ) {
        die "$prog_name: sane_get_devices() failed: " . $_->error . "\n";
    }
    if ( defined $options{L} ) {
        for (@device_list) {
            printf "device `%s' is a %s %s %s\n", $_->{name}, $_->{vendor},
              $_->{model}, $_->{type};
        }
        if ( not @device_list ) {
            printf "\nNo scanners were identified. If you were expecting "
              . "something different,\ncheck that the scanner is plugged "
              . "in, turned on and detected by the\nsane-find-scanner tool "
              . "(if appropriate). Please read the documentation\nwhich came "
              . "with this software (README, FAQ, manpages).\n";
        }
    }
    else {
        for my $i ( 0 .. $#device_list ) {
            my $string_format = $options{f};
            $string_format =~ s/%d/$device_list[$i]->{name}/gsm;
            $string_format =~ s/%v/$device_list[$i]->{vendor}/gsm;
            $string_format =~ s/%m/$device_list[$i]->{model}/gsm;
            $string_format =~ s/%t/$device_list[$i]->{type}/gsm;
            $string_format =~ s/%i/$i/gsm;
            printstdout($string_format);
        }
    }
    if ( defined $ENV{'SANE_DEFAULT_DEVICE'} ) {
        printf "default device is `%s'\n", $ENV{'SANE_DEFAULT_DEVICE'};
    }
    return;
}

sub open_device {
    if ( not $devname ) {

        # If no device name was specified explicitly, we look at the
        # environment variable SANE_DEFAULT_DEVICE.  If this variable
        # is not set, we open the first device we find (if any):
        if ( defined $ENV{'SANE_DEFAULT_DEVICE'} ) {
            $devname = $ENV{'SANE_DEFAULT_DEVICE'};
        }
        else {
            my @device_list;
            try {
                @device_list = Image::Sane->get_devices;
            }
            catch {
                die "$prog_name: sane_get_devices() failed: "
                  . $_->error . "\n";
            };
            if ( not @device_list ) {
                die "$prog_name: no SANE devices found\n";
            }
            $devname = $device_list[0]{name};
        }
    }

    try {
        $device = Image::Sane::Device->open($devname);
    }
    catch {
        printstderr(
            "$prog_name: open of device $devname failed: " . $_->error . "\n" );
        if ( $devname =~ /^\//sm ) {
            printstderr( "\nYou seem to have specified a UNIX device name, "
                  . "or filename instead of selecting\nthe SANE scanner or "
                  . "image acquisition device you want to use. As an example,\n"
                  . 'you might want "epson:/dev/sg0" or '
                  . "\"hp:/dev/usbscanner0\". If any supported\ndevices are "
                  . 'installed in your system, you should be able to see a '
                  . "list with\n\"$prog_name --list-devices\".\n" );
        }
        if ($help) {
            undef $device;
        }
        else {
            scanimage_exit(1);
        }
    };
    return;
}

# There seems to be a bug in Getopt::Long 2.37 where l is treated as L whilst
# l is not in @args. Therefore the workaround is to rename l to m for the first
# scan and back to l for the second.
sub munge_args {
    for (@ARGV) {
        if ( $_ eq '-l' ) { $_ = '-m' }
        if ( $_ eq '-t' ) { $_ = '-u' }
    }
    return;
}

munge_args();

# make a first pass through the options with error printing and argument
# permutation disabled:
GetOptions(@args);

if ( defined $options{L} or defined $options{f} ) {
    list_devices_verbose();
    scanimage_exit(0);
}

if ( defined $options{V} ) {
    printf "%s %s; backend version %d.%d.%d\n", $prog_name,
      $Image::Sane::VERSION, Image::Sane->get_version;
    scanimage_exit(0);
}

if ($help) {
    printf <<'EOS', $prog_name;
Usage: %s [OPTION]...

Start image acquisition on a scanner device and write image data to
standard output.

Parameters are separated by a blank from single-character options (e.g.
-d epson) and by a "=" from multi-character options (e.g. --device-name=epson).
-d, --device-name=DEVICE   use a given scanner device (e.g. hp:/dev/scanner)
    --format=pnm|tiff      file format of output file
-i, --icc-profile=PROFILE  include this ICC profile into TIFF file
-L, --list-devices         show available scanner devices
-f, --formatted-device-list=FORMAT similar to -L, but the FORMAT of the output
                           can be specified: %%d (device name), %%v (vendor),
                           %%m (model), %%t (type), %%i (index number), and
                           %%n (newline)
-b, --batch[=FORMAT]       working in batch mode, FORMAT is `out%%d.pnm' or
                           `out%%d.tif' by default depending on --format
    --batch-start=#        page number to start naming files with
    --batch-count=#        how many pages to scan in batch mode
    --batch-increment=#    increase page number in filename by #
    --batch-double         increment page number by two, same as
                           --batch-increment=2
    --batch-prompt         ask for pressing a key before scanning a page
    --accept-md5-only      only accept authorization requests using md5
-p, --progress             print progress messages
-n, --dont-scan            only set options, don't actually scan
-T, --test                 test backend thoroughly
-A, --all-options          list all available backend options
-h, --help                 display this help message and exit
-v, --verbose              give even more status messages
-B, --buffer-size=#        change input buffer size (in kB, default 32)
-V, --version              print version information
EOS
}

open_device();

if ( defined $device ) {
    fetch_options($device);
    process_arguments();

    # output device-specific help
    if ($help) {
        printf "\nOptions specific to device `%s':\n", $devname;
        print_options( $device, $num_dev_options, SANE_FALSE );
    }

    # list all device-specific options
    if ($all) {
        printf "\nAll options specific to device `%s':\n", $devname;
        print_options( $device, $num_dev_options, SANE_TRUE );
        scanimage_exit(0);
    }
}

# output device list
if ($help) {
    list_device_names();
    scanimage_exit(0);
}

if ($dont_scan) { scanimage_exit(0) }

if ($batch_double)     { $batch_increment = 2 }
if ( defined $format ) { $batch           = 1 }
if ($batch_count) {
    $batch = 1;
}
elsif ($batch) {
    $batch_count = $INFINITY;
}
else {
    $batch_count = 1;
}

if ( $test == 0 ) {
    scan_pages();
}
else {
    test_it();
}

scanimage_exit($status);

## no critic (RequirePodSections)
__END__

=head1 NAME

scanimage - scan an image

=head1 SYNOPSIS

B<scanimage>
B<[ -d | --device-name>
I<dev ]>
B<[ --format>
I<format ]>
B<[ -i | --icc-profile>
I<profile ]>
B<[ -L | --list-devices ]>
B<[ -f | --formatted-device-list >
I<format ]>
B<[ --batch >
I<[= format ]]>
B<[ --batch-start>
I<start ]>
B<[ --batch-count>
I<count ]>
B<[ --batch-increment>
I<increment ]>
B<[ --batch-double ]>
B<[ --accept-md5-only ]>
B<[ -p | --progress ]>
B<[ -n | --dont-scan ]>
B<[ -T | --test ]>
B<[ -h | --help ]>
B<[ -v | --verbose ]>
B<[ -B | --buffersize ]>
B<[ -V | --version ]>
I<[ device-specific-options ]>

=head1 DESCRIPTION

B<scanimage>
is a command-line interface to control image acquisition devices such
as flatbed scanners or cameras.  The device is controlled via
command-line options.  After command-line processing,
B<scanimage>
normally proceeds to acquire an image.  The image data is written to
standard output in one of the PNM (portable aNyMaP) formats (PBM for
black-and-white images, PGM for grayscale images, and PPM for color
images) or in TIFF (black-and-white, grayscale or color).
B<scanimage>
accesses image acquisition devices through the
B<SANE>
(Scanner Access Now Easy) interface and can thus support any device for which
there exists a
B<SANE>
backend (try
B<apropos>
I<sane->
to get a list of available backends).

=head1 EXAMPLES

To get a list of devices:

  scanimage -L

To scan with default settings to the file image.pnm:

  scanimage >image.pnm

To scan 100x100 mm to the file image.tiff (-x and -y may not be available with
all devices):

  scanimage -x 100 -y 100 --format=tiff >image.tiff

To print all available options:

  scanimage -h

=head1 OPTIONS

Parameters are separated by a blank from single-character options (e.g.
-d epson) and by a "=" from multi-character options (e.g. --device-name=epson).

The
B<-d>
or
B<--device-name>
options must be followed by a
B<SANE>
device-name like 
I<` epson:/dev/sg0 '>
or 
I<` hp:/dev/usbscanner0 '.>
A (partial) list of available devices can be obtained with the
B<--list-devices>
option (see below).  If no device-name is specified explicitly,
B<scanimage>
reads a device-name from the environment variable
B<SANE_DEFAULT_DEVICE .>
If this variable is not set, 
B<scanimage>
will attempt to open the first available device.

The
B<--format >
I<format>
option selects how image data is written to standard output.
I<format>
can be
B<pnm>
or
B<tiff.>
If
B<--format>
is not used, PNM is written.

The
B<-i>
or
B<--icc-profile>
option is used to include an ICC profile into a TIFF file.

The
B<-L>
or
B<--list-devices>
option requests a (partial) list of devices that are available.  The
list is not complete since some devices may be available, but are not
listed in any of the configuration files (which are typically stored
in directory I</etc/sane.d ).>
This is particularly the case when accessing scanners through the network.  If
a device is not listed in a configuration file, the only way to access it is
by its full device name.  You may need to consult your system administrator to
find out the names of such devices.

The
B<-f>
or
B<--formatted-device-list>
option works similar to
B<--list-devices ,>
but requires a format string.
B<scanimage>
replaces the placeholders
B<%d %v %m %t %i>
with the device name, vendor name, model name, scanner type and an index
number respectively. The command

=over

=item B<scanimage -f>
I<\*(lq scanner number %i device %d is a %t, model %m, produced by %v \*(rq>

=back

will produce something like:

=over

=item scanner number 0  device sharp:/dev/sg1 is  a  flatbed scanner, model JX250
SCSI, produced by SHARP

=back

The
B<--batch*>
options provide the features for scanning documents using document
feeders.  
B<--batch>
I<[ format ]>
is used to specify the format of the filename that each page will be written
to.  Each page is written out to a single file.  If
I<format>
is not specified, the default of out%d.pnm (or out%d.tif for --format tiff)
will be used.  
I<format>
is given as a printf style string with one integer parameter.
B<--batch-start>
I<start>
selects the page number to start naming files with. If this option is not
given, the counter will start at 0.
B<--batch-count>
I<count>
specifies the number of pages to attempt to scan.  If not given, 
scanimage will continue scanning until the scanner returns a state
other than OK.  Not all scanners with document feeders signal when the
ADF is empty, use this command to work around them.
With
B<--batch-increment>
I<increment>
you can change the amount that the number in the filename is incremented
by.  Generally this is used when you are scanning double-sided documents
on a single-sided document feeder.  A specific command is provided to
aid this:
B<--batch-double>
will automatically set the increment to 2.
B<--batch-prompt>
will ask for pressing RETURN before scanning a page. This can be used for
scanning multiple pages without an automatic document feeder.

The
B<--accept-md5-only>
option only accepts user authorization requests that support MD5 security. The
B<SANE>
network daemon
B<( saned )>
is capable of doing such requests. See
B<saned (8).>

The
B<-p>
or
B<--progress>
option requests that
B<scanimage>
prints a progress counter. It shows how much image data of the current image has
already been received by
B<scanimage >
(in percent).

The
B<-n>
or
B<--dont-scan>
option requests that
B<scanimage>
only sets the options provided by the user but doesn't actually perform a
scan. This option can be used to e.g. turn off the scanner's lamp (if
supported by the backend).

The
B<-T>
or
B<--test>
option requests that
B<scanimage>
performs a few simple sanity tests to make sure the backend works as
defined by the
B<SANE>
API (in particular the
B<sane_read>
function is exercised by this test).

The
B<-h>
or
B<--help>
options request help information.  The information is printed on
standard output and in this case, no attempt will be made to acquire
an image.

The
B<-v>
or
B<--verbose>
options increase the verbosity of the operation of
B<scanimage.>
The option may be specified repeatedly, each time increasing the verbosity
level.

The
B<-B>
or
B<--buffersize>
option changes the input buffersize that
B<scanimage>
uses from default 32*1024 to 1024*1024 kbytes.

The
B<-V>
or
B<--version>
option requests that
B<scanimage>
prints the program and package name, the version number of
the
B<SANE>
distribution that it came with and the version of the backend that it
loads. Usually that's the dll backend. If more information about the version
numbers of the backends are necessary, the
B<DEBUG>
variable for the dll backend can be used. Example: SANE_DEBUG_DLL=3 scanimage
-L.

As you might imagine, much of the power of
B<scanimage>
comes from the fact that it can control any
B<SANE>
backend.  Thus, the exact set of command-line options depends on the
capabilities of the selected device.  To see the options for a device named
I<dev ,>
invoke
B<scanimage>
via a command-line of the form:

=over

=item B<scanimage --help --device-name>
I<dev>

=back

The documentation for the device-specific options printed by
B<--help>
is best explained with a few examples:

 -l 0..218mm [0]
    Top-left x position of scan area.

=over

=item The description above shows that option
B<-l>
expects an option value in the range from 0 to 218 mm.  The
value in square brackets indicates that the current option value is 0
mm. Most backends provide similar geometry options for top-left y position (-t),
width (-x) and height of scan-area (-y).

=back

 --brightness -100..100% [0]
    Controls the brightness of the acquired image.

=over

=item The description above shows that option
B<--brightness>
expects an option value in the range from -100 to 100 percent.  The
value in square brackets indicates that the current option value is 0
percent.

=back

 --default-enhancements
    Set default values for enhancement controls.

=over

=item The description above shows that option
B<--default-enhancements>
has no option value.  It should be thought of as having an immediate
effect at the point of the command-line at which it appears.  For
example, since this option resets the
B<--brightness>
option, the option-pair
B<--brightness 50 --default-enhancements>
would effectively be a no-op.

=back

 --mode Lineart|Gray|Color [Gray]
    Selects the scan mode (e.g., lineart or color).

=over

=item The description above shows that option
B<--mode>
accepts an argument that must be one of the strings
B<Lineart ,>
B<Gray ,>
or
B<Color .>
The value in the square bracket indicates that the option is currently
set to
B<Gray .>
For convenience, it is legal to abbreviate the string values as long as
they remain unique.  Also, the case of the spelling doesn't matter.  For
example, option setting
B<--mode col>
is identical to
B<"--mode Color" .>

=back

 --custom-gamma[=(yes|no)] [inactive]
    Determines whether a builtin or a custom gamma-table
    should be used.

=over

=item The description above shows that option
B<--custom-gamma>
expects either no option value, a "yes" string, or a "no" string.
Specifying the option with no value is equivalent to specifying "yes".
The value in square-brackets indicates that the option is not
currently active.  That is, attempting to set the option would result
in an error message.  The set of available options typically depends
on the settings of other options.  For example, the
B<--custom-gamma>
table might be active only when a grayscale or color scan-mode has
been requested.

=back

Note that the
B<--help>
option is processed only after all other options have been processed.
This makes it possible to see the option settings for a particular
mode by specifying the appropriate mode-options along
with the
B<--help>
option.  For example, the command-line:

B< scanimage --help --mode>
I<color>

would print the option settings that are in effect when the color-mode
is selected.

 --gamma-table 0..255,...
    Gamma-correction table.  In color mode this option
    equally affects the red, green, and blue channels
    simultaneously (i.e., it is an intensity gamma table).

=over

=item The description above shows that option
B<--gamma-table>
expects zero or more values in the range 0 to 255.  For example, a
legal value for this option would be "3,4,5,6,7,8,9,10,11,12".  Since
it's cumbersome to specify long vectors in this form, the same can be
expressed by the abbreviated form "[0]3-[9]12".  What this means is
that the first vector element is set to 3, the 9-th element is set to
12 and the values in between are interpolated linearly.  Of course, it
is possible to specify multiple such linear segments.  For example,
"[0]3-[2]3-[6]7,[7]10-[9]6" is equivalent to "3,3,3,4,5,6,7,10,8,6".
The program
B<gamma4scanimage>
can be used to generate such gamma tables (see 
B<gamma4scanimage (1)>
for details).

=back

 --filename <string> [/tmp/input.ppm]
    The filename of the image to be loaded.

=over

=item The description above is an example of an option that takes an
arbitrary string value (which happens to be a filename).  Again,
the value in brackets show that the option is current set to the
filename 
B</tmp/input.ppm .>

=back

=head1 ENVIRONMENT

=over

=item B<SANE_DEFAULT_DEVICE>

The default device-name.

=back

=head1 FILES

=over

=item I</etc/sane.d>

This directory holds various configuration files.  For details, please
refer to the manual pages listed below.

=item I<~/.sane/pass>

This file contains lines of the form

=item user:password:resource

scanimage uses this information to answer user authorization requests
automatically. The file must have 0600 permissions or stricter. You should
use this file in conjunction with the --accept-md5-only option to avoid
server-side attacks. The resource may contain any character but is limited
to 127 characters.

=back

=head1 SEE ALSO

B<sane (7),>
B<gamma4scanimage (1),>
B<xscanimage (1),>
B<xcam(1) ,>
B<xsane(1) ,>
B<scanadf (1),>
B<sane-dll (5),>
B<sane-net (5),>
B<sane-"backendname" (5)>

=head1 AUTHOR

Transliterated from the C original by Jeffrey Ratcliffe.

=head1 BUGS

All the bugs of scanimage and much, much more.
