#!/usr/bin/perl
no
if
$] >= 5.018,
warnings
=>
'experimental::smartmatch'
;
use
sigtrap
qw/handler sighandler normal-signals/
;
Readonly
my
$BUFFER_SIZE
=> ( 32 * 1024 );
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;
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
;
}
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
) =
@_
;
given
(
$unit
) {
when
(SANE_UNIT_PIXEL) {
printstdout(
'pel'
);
}
when
(SANE_UNIT_BIT) {
printstdout(
'bit'
);
}
when
(SANE_UNIT_MM) {
printstdout(
'mm'
);
}
when
(SANE_UNIT_DPI) {
printstdout(
'dpi'
);
}
when
(SANE_UNIT_PERCENT) {
printstdout(
q{%}
);
}
when
(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
(
$opt
->{cap} & SANE_CAP_SOFT_SELECT
and
$opt
->{cap} & SANE_CAP_HARD_SELECT )
{
printstderr(
"$prog_name: invalid option caps, SS+HS\n"
);
return
;
}
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
;
}
if
(
not(
$opt
->{cap} & (
SANE_CAP_SOFT_SELECT | SANE_CAP_HARD_SELECT |
SANE_CAP_SOFT_DETECT
)
)
)
{
return
;
}
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;
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
) =
@_
;
given
(
$opt
->{type} ) {
when
(SANE_TYPE_BOOL) {
printstdout(
'[=('
);
if
(
$opt
->{cap} & SANE_CAP_AUTOMATIC ) { printstdout(
'auto|'
) }
printstdout(
'yes|no)]'
);
}
when
(SANE_TYPE_BUTTON) { }
default
{
printstdout(
$SPACE
);
if
(
$opt
->{cap} & SANE_CAP_AUTOMATIC ) {
printstdout(
'auto|'
);
}
given
(
$opt
->{constraint_type} ) {
when
(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(
',...'
) }
}
when
(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})"
);
}
}
when
( SANE_CONSTRAINT_STRING_LIST | SANE_CONSTRAINT_WORD_LIST )
{
for
my
$i
( 0 .. $
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'
}
given
(
$opt
->{name} ) {
when
(
'l'
) {
$tl_x
=
$val
;
printf
$string_format
,
$tl_x
;
}
when
(
't'
) {
$tl_y
=
$val
;
printf
$string_format
,
$tl_y
;
}
when
(
'x'
) {
$br_x
=
$val
;
printf
$string_format
,
$br_x
-
$tl_x
;
}
when
(
'y'
) {
$br_y
=
$val
;
printf
$string_format
,
$br_y
-
$tl_y
;
}
default
{
printf
$string_format
,
$val
;
}
}
}
elsif
(
$opt
->{type} == SANE_TYPE_STRING ) {
printstdout(
$val
);
}
printstdout(
']'
);
}
}
return
;
}
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
;
}
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"
;
}
(
$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"
;
}
push
@vector
,
$value
;
if
(
$separator
eq
$DASH
) {
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"
;
};
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"
;
}
}
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
;
}
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 )
)
{
given
(
$opt
->{name} ) {
when
(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'
;
}
when
(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'
;
}
when
(SANE_NAME_SCAN_TL_X) {
$window
[2] =
$i
;
$window_option
[2] =
$opt
;
$window_option
[2]->{name} =
'l'
;
}
when
(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
;
given
(
$opt
->{type} ) {
when
(SANE_TYPE_BOOL) {
$value
= 1;
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"
;
}
}
}
when
(
$opt
->{type} == SANE_TYPE_INT
or
$opt
->{type} == SANE_TYPE_FIXED
)
{
my
@vector
= parse_vector(
$opt
,
$optarg
);
$value
= \
@vector
;
}
when
(SANE_TYPE_STRING) {
$value
=
$optarg
;
}
when
(SANE_TYPE_BUTTON) {
$value
= 0;
}
default
{
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
) =
@_
;
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
$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
);
}
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
"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
"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
"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
{
write_pnm_header(
$parm
->{
format
},
$parm
->{pixels_per_line},
$parm
->{lines},
$parm
->{depth}
);
}
}
}
else
{
die
"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 {
my
(
$parm
,
$buffer
,
$len
,
$image
,
$offset
,
$must_buffer
) =
@_
;
if
(
$must_buffer
) {
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
{
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
;
}
}
write_pnm_header(
$parm
->{
format
},
$parm
->{pixels_per_line},
$image
->{height},
$parm
->{depth}
);
for
( @{
$image
->{data} } ) {
print
}
return
;
}
sub
log_batch_scan {
if
(
$batch
) {
if
( not
defined
$format
or
$format
eq
$EMPTY
) {
$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
) {
$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
;
}
}
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
}
if
(
$batch
and not(
open
$fh
,
'>'
,
$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
);
}
given
(
$status
) {
when
(SANE_STATUS_EOF) {
if
(
$batch
) {
if
(
open
$fh
,
'>'
,
'/dev/null'
and STDOUT->fdopen(
$fh
,
'>'
)
)
{
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;
}
}
}
when
(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 ) {
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 )
{
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 ) {
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"
);
}
if
(
$verbose
> 1 ) {
printstderr(
"scanimage: finished\n"
);
}
exit
$exit_status
;
}
sub
print_options {
(
$device
,
my
$num_dev_options
,
my
$ro
) =
@_
;
for
my
$i
( 1 ..
$num_dev_options
- 1 ) {
my
$opt
;
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 {
Getopt::Long::Configure(
'no_pass_through'
);
for
(
@ARGV
) {
if
(
$_
eq
'-m'
) {
$_
=
'-l'
}
if
(
$_
eq
'-u'
) {
$_
=
'-t'
}
}
my
@argv_old
=
@ARGV
;
if
( not GetOptions(
@args
) ) { scanimage_exit(1) }
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
} ) {
given
(
$ch
) {
when
(
'x'
) {
$window_val_user
[0] = 1;
(
$window_val
[0] ) =
parse_vector(
$window_option
[0],
$options
{x} );
}
when
(
'y'
) {
$window_val_user
[1] = 1;
(
$window_val
[1] ) =
parse_vector(
$window_option
[1],
$options
{y} );
}
when
(
'l'
) {
process_backend_option(
$device
,
$window
[2],
$options
{l} );
}
when
(
't'
) {
process_backend_option(
$device
,
$window
[
$I_TL_Y
],
$options
{t} );
}
default
{
process_backend_option(
$device
,
$option_number
{
$ch
},
$options
{
$ch
} );
}
}
}
}
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
(
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
;
}
sub
munge_args {
for
(
@ARGV
) {
if
(
$_
eq
'-l'
) {
$_
=
'-m'
}
if
(
$_
eq
'-t'
) {
$_
=
'-u'
}
}
return
;
}
munge_args();
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();
if
(
$help
) {
printf
"\nOptions specific to device `%s':\n"
,
$devname
;
print_options(
$device
,
$num_dev_options
, SANE_FALSE );
}
if
(
$all
) {
printf
"\nAll options specific to device `%s':\n"
,
$devname
;
print_options(
$device
,
$num_dev_options
, SANE_TRUE );
scanimage_exit(0);
}
}
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
);