#!/usr/bin/perl ## no critic (RequireVersionVar)
no
if
$] >= 5.018,
warnings
=>
'experimental::smartmatch'
;
Readonly
my
$BUFFER_SIZE
=> ( 32 * 1024 );
Readonly
my
$SANE_FRAME_TEXT
=> 10;
Readonly
my
$SANE_FRAME_JPEG
=> 11;
Readonly
my
$SANE_FRAME_G31D
=> 12;
Readonly
my
$SANE_FRAME_G32D
=> 13;
Readonly
my
$SANE_FRAME_G42D
=> 14;
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;
my
(
%options
,
@window_val_user
,
@window_option
,
@window_val
,
@window
,
$device
,
$devname
,
%option_number
);
my
$num_dev_options
= 0;
my
$verbose
= 0;
my
$help
= 0;
my
$test
= 0;
my
$batch_start_at
= 1;
my
$batch_increment
= 1;
my
$tl_x
= 0;
my
$tl_y
= 0;
my
$br_x
= 0;
my
$br_y
= 0;
my
$w_x
= 0;
my
$h_y
= 0;
my
$resolution_value
= 0;
my
$prog_name
= basename(
$PROGRAM_NAME
);
my
$no_overwrite
= 0;
my
$outputfile
=
'image-%04d'
;
my
$raw
= SANE_FALSE;
my
$scanscript
;
my
$startnum
= 1;
my
$endnum
= -1;
my
$SPACE
=
q{ }
;
my
$EMPTY
=
q{}
;
my
$DASH
=
q{-}
;
my
@args
= (
\
%options
,
'd|device-name=s'
=> \
$devname
,
'L|list-devices'
,
'h|help'
=> \
$help
,
'v|verbose+'
=> \
$verbose
,
'N|no-overwrite'
=> \
$no_overwrite
,
'o|output-file:s'
=> \
$outputfile
,
's|start-count=i'
=> \
$startnum
,
'e|end-count=i'
=> \
$endnum
,
'r|raw'
=> \
$raw
,
);
sub
sane_strframe {
my
$frame
=
shift
;
my
%frame
= (
SANE_FRAME_GRAY
=>
'gray'
,
SANE_FRAME_RGB
=>
'RGB'
,
SANE_FRAME_RED
=>
'red'
,
SANE_FRAME_GREEN
=>
'green'
,
SANE_FRAME_BLUE
=>
'blue'
,
$SANE_FRAME_TEXT
=>
'text'
,
$SANE_FRAME_JPEG
=>
'jpeg'
,
$SANE_FRAME_G31D
=>
'g31d'
,
$SANE_FRAME_G32D
=>
'g32d'
,
$SANE_FRAME_G42D
=>
'g42d'
,
);
if
(
defined
$frame
{
$frame
} ) {
return
$frame
{
$frame
};
}
else
{
return
'unknown'
;
}
}
sub
sane_isbasicframe {
my
$frame
=
shift
;
return
$frame
== SANE_FRAME_GRAY
||
$frame
== SANE_FRAME_RGB
||
$frame
== SANE_FRAME_RED
||
$frame
== SANE_FRAME_GREEN
||
$frame
== SANE_FRAME_BLUE;
}
sub
printstdout {
my
(
$msg
) =
@_
;
if
( not
print
$msg
) {
die
"Error writing to STDOUT\n"
}
return
;
}
sub
printstderr {
my
(
$msg
) =
@_
;
print
{
*STDERR
}
$msg
;
return
;
}
sub
sighandler {
my
$signum
=
shift
;
if
(
$device
) {
printstderr(
"$prog_name: stopping scanner...\n"
);
$device
->cancel;
}
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
$short_name
) =
@_
;
my
$opt
=
$device
->get_option_descriptor(
$opt_num
);
if
(
$short_name
) {
printf
' -%s'
,
$short_name
;
}
else
{
printf
' --%s'
,
$opt
->{name};
}
print_option_choices(
$opt
);
print_current_option_value(
$opt
,
$opt_num
);
if
(
$opt
->{type} != SANE_TYPE_BUTTON and
$opt
->{cap} & SANE_CAP_INACTIVE )
{
printstdout(
' [inactive]'
);
}
printstdout(
"\n "
);
if
(
$short_name
eq
'x'
) {
printstdout(
'Width of scan-area.'
);
}
elsif
(
$short_name
eq
'y'
) {
printstdout(
'Height of scan-area.'
);
}
else
{
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
;
}
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
) =
@_
;
if
(
$opt
->{type} == SANE_TYPE_BOOL ) {
printstdout(
'[=('
);
if
(
$opt
->{cap} & SANE_CAP_AUTOMATIC ) { printstdout(
'auto|'
) }
printstdout(
'yes|no)]'
);
}
elsif
(
$opt
->{type} != SANE_TYPE_BUTTON ) {
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 SANE_NAME_SCAN_BR_X ) {
printf
$string_format
,
$opt
->{constraint}{min},
$opt
->{constraint}{max} -
$tl_x
;
}
elsif
(
$opt
->{name} eq SANE_NAME_SCAN_BR_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
or
$opt
->{constraint_type} == 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
( !(
$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
(SANE_NAME_SCAN_TL_X) {
$tl_x
=
$val
;
printf
$string_format
,
$tl_x
;
}
when
(SANE_NAME_SCAN_TL_Y) {
$tl_y
=
$val
;
printf
$string_format
,
$tl_y
;
}
when
(SANE_NAME_SCAN_BR_X) {
$br_x
=
$val
;
$w_x
=
$br_x
-
$tl_x
;
printf
$string_format
,
$w_x
;
}
when
(SANE_NAME_SCAN_BR_Y) {
$br_y
=
$val
;
$h_y
=
$br_y
-
$tl_y
;
printf
$string_format
,
$h_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
);
if
(
$str
=~
qr{^
(\d*[.]?\d*) # value
(cm|mm|in|["bB%]|dpi|us)? # optional unit
}
xsm
)
{
$v
= $1;
$unit
= $2;
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
,
substr
$str
,
length
$v
+
length
$unit
,
length
$str
;
}
sub
parse_vector {
my
(
$opt
,
$str
) =
@_
;
my
$index
= -1;
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
) {
printstderr(
sprintf
"$prog_name: option --$opt->{name}: index $index out of range [0..%d]\n"
,
length
$str
);
exit
1;
}
(
$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"
;
}
$vector
[
$index
] =
$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
;
$vector
[
$i
] =
$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
;
$num_dev_options
=
$device
->get_option(0);
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
die
"$prog_name: unable to determine option count\n"
;
}
for
my
$i
( 0 ..
$num_dev_options
- 1 ) {
my
$opt
=
$device
->get_option_descriptor(
$i
);
next
if
( !(
$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
$window
[
$i
+ 2 ] and not
$window_val_user
[
$i
] ) {
my
$pos
=
$device
->get_option(
$window
[
$i
+ 2 ] );
if
(
defined
$pos
) {
$window_val
[
$i
] =
$window_val
[
$i
] -
$pos
}
}
}
return
;
}
sub
update_geometry {
my
(
$opt
,
$i
) =
@_
;
if
( (
$opt
->{type} == SANE_TYPE_FIXED ||
$opt
->{type} == SANE_TYPE_INT )
and (
$opt
->{unit} == SANE_UNIT_MM ||
$opt
->{unit} == SANE_UNIT_PIXEL )
)
{
given
(
$opt
->{name} ) {
when
(SANE_NAME_SCAN_TL_X) {
$window
[2] =
$i
;
$opt
->{name} =
'l'
;
}
when
(SANE_NAME_SCAN_TL_Y) {
$window
[3] =
$i
;
$opt
->{name} =
't'
;
}
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 scanning area.'
;
if
( !
$window_val_user
[0] ) {
$window_val
[0] =
$device
->get_option(
$i
);
}
}
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 scanning area.'
;
if
( !
$window_val_user
[1] ) {
$window_val
[1] =
$device
->get_option(
$i
);
}
}
}
}
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 ) {
warn
"$prog_name: ignored request to set inactive option $opt->{name}\n"
;
}
return
;
}
my
$info
=
$device
->set_option(
$optnum
,
$value
);
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
die
"$prog_name: setting of option --$opt->{name} failed ($Sane::STATUS)\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$/ixsm )
{
$device
->set_auto(
$optnum
);
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
die
"$prog_name: failed to set option --$opt->{name} to automatic ($Sane::STATUS)\n"
;
}
return
;
}
my
$value
;
given
(
$opt
->{type} ) {
when
(SANE_TYPE_BOOL) {
$value
= 1;
if
(
$optarg
) {
if
(
$optarg
=~ /^yes$/ixsm ) {
$value
= 1;
}
elsif
(
$optarg
=~ /^
no
$/ixsm ) {
$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_to_file {
my
(
$fh
,
$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
{
$fh
}
"P6\n# SANE data follows\n%d %d\n%d\n"
,
$width
,
$height
,
(
$depth
<=
$_8_BIT
) ?
$MAXVAL_8_BIT
:
$MAXVAL_16_BIT
;
}
elsif
(
$frame_format
== SANE_FRAME_GRAY ) {
if
(
$depth
== 1 ) {
printf
{
$fh
}
"P4\n# SANE data follows\n%d %d\n"
,
$width
,
$height
;
}
else
{
printf
{
$fh
}
"P5\n# SANE data follows\n%d %d\n%d\n"
,
$width
,
$height
,
(
$depth
<=
$_8_BIT
) ?
$MAXVAL_8_BIT
:
$MAXVAL_16_BIT
;
}
}
return
;
}
sub
scan_it_raw {
(
my
$fname
,
$raw
,
my
$script
) =
@_
;
my
$first_frame
= 1,
my
$offset
= 0,
my
$must_buffer
= 0;
my
$min
=
$MAXVAL_8_BIT
,
my
$max
= 0;
my
(
%image
,
$fp
);
my
$parm
;
while
( !
$parm
->{last_frame} ) {
log_frame_info(
$parm
,
$fp
,
$fname
,
$first_frame
);
my
(
$must_buffer
,
$offset
) =
initialise_scan(
$parm
,
$first_frame
,
$fp
);
while
(1) {
my
(
$buffer
,
$len
) =
$device
->
read
(
$BUFFER_SIZE
);
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
if
(
$verbose
&&
$parm
->{depth} ==
$_8_BIT
) {
printstderr(
sprintf
"$prog_name: min/max graylevel value = %d/%d\n"
,
$min
,
$max
);
}
if
(
$Sane::STATUS
!= SANE_STATUS_EOF ) {
warn
"$prog_name: sane_read: $Sane::STATUS\n"
;
return
;
}
last
;
}
$offset
=
buffer_data(
$fp
,
$parm
,
$buffer
,
$len
, \
%image
,
$offset
,
$must_buffer
);
if
(
$verbose
&&
$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
(
$must_buffer
) { write_buffer(
$fp
, \
%image
,
$parm
) }
if
(
$fp
) {
close
$fp
or
die
"Error closing file: $EVAL_ERROR\n"
;
undef
$fp
;
}
CLEANUP:
if
(
$fp
) {
close
$fp
or
die
"Error closing file: $EVAL_ERROR\n"
}
return
;
}
sub
log_frame_info {
my
(
$parm
,
$fp
,
$fname
,
$first_frame
) =
@_
;
$device
->start;
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
if
(
$Sane::STATUS
!= SANE_STATUS_NO_DOCS ) {
warn
"$prog_name: sane_start: $Sane::STATUS\n"
;
}
goto
CLEANUP;
}
$parm
=
$device
->get_parameters;
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
warn
"$prog_name: sane_get_parameters: $Sane::STATUS\n"
;
goto
CLEANUP;
}
if
( not
open
$fp
,
'>'
,
$fname
)
{
warn
"Error opening output `$fname': $EVAL_ERROR\n"
;
$Sane::_status
=
SANE_STATUS_IO_ERROR;
goto
CLEANUP;
}
if
(
$verbose
) {
if
(
$first_frame
) {
if
( sane_isbasicframe(
$parm
->{
format
} ) ) {
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},
$_8_BIT
*
$parm
->{bytes_per_line} /
$parm
->{pixels_per_line}
);
}
else
{
printstderr(
sprintf
"$prog_name: scanning image %d pixels wide and "
.
"variable height at %d bits/pixel\n"
,
$parm
->{pixels_per_line},
$_8_BIT
*
$parm
->{bytes_per_line} /
$parm
->{pixels_per_line}
);
}
}
else
{
printstderr(
sprintf
"$prog_name: receiving %s frame "
.
'bytes/line=%d, '
.
'pixels/line=%d, '
.
'lines=%d, '
.
"depth=%d\n"
,
,
sane_strframe(
$parm
->{
format
} ),
$parm
->{bytes_per_line},
$parm
->{pixels_per_line},
$parm
->{lines},
$parm
->{depth}
);
}
}
printstderr(
sprintf
"$prog_name: acquiring %s frame\n"
,
sane_strframe(
$parm
->{
format
} ) );
}
return
;
}
sub
initialise_scan {
my
(
$parm
,
$first_frame
,
$fp
) =
@_
;
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
) {
die
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 8)\n"
;
}
}
if
(
$parm
->{
format
} == SANE_FRAME_RGB
or
$parm
->{
format
} == SANE_FRAME_GRAY )
{
if
( (
$parm
->{depth} != 1 ) and (
$parm
->{depth} !=
$_8_BIT
) ) {
die
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 1 or 8)\n"
;
}
if
(
$raw
== SANE_FALSE ) {
if
(
$parm
->{lines} < 0 ) {
$must_buffer
= 1;
$offset
= 0;
}
else
{
write_pnm_header_to_file(
$fp
,
$parm
->{
format
},
$parm
->{pixels_per_line},
$parm
->{lines},
$parm
->{depth} );
}
}
}
elsif
(
$parm
->{
format
} ==
$SANE_FRAME_TEXT
or
$parm
->{
format
} ==
$SANE_FRAME_JPEG
or
$parm
->{
format
} ==
$SANE_FRAME_G31D
or
$parm
->{
format
} ==
$SANE_FRAME_G32D
or
$parm
->{
format
} ==
$SANE_FRAME_G42D
)
{
if
( !
$parm
->{last_frame} ) {
$Sane::_status
= SANE_STATUS_INVAL;
printstderr(
sprintf
"$prog_name: bad %s frame: must be last_frame\n"
,
sane_strframe(
$parm
->{
format
} ) );
goto
CLEANUP;
}
}
else
{
if
(
$verbose
) {
warn
"$prog_name: unknown frame format $parm->{format}\n"
;
}
if
( !
$parm
->{last_frame} ) {
$Sane::_status
= SANE_STATUS_INVAL;
printstderr(
sprintf
"$prog_name: bad %s frame: must be last_frame\n"
,
sane_strframe(
$parm
->{
format
} ) );
goto
CLEANUP;
}
}
}
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
(
$fp
,
$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
+ 3 *
$i
]
=
substr
$buffer
,
$i
, 1;
}
$offset
+= 3 *
$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
{
printstderr(
sprintf
"$prog_name: ERROR: trying to buffer %s frametype\n"
,
sane_strframe(
$parm
->{
format
} ) );
}
}
else
{
if
( not
print
{
$fp
}
$buffer
) {
die
"Error writing to file\n"
}
}
return
$offset
;
}
sub
write_buffer {
my
(
$fp
,
$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} /= 3;
}
}
if
(
$raw
== SANE_FALSE ) {
write_pnm_header_to_file(
$fp
,
$parm
->{
format
},
$parm
->{pixels_per_line},
$image
->{height},
$parm
->{depth} );
}
for
( @{
$image
->{data} } ) {
if
( not
print
{
$fp
}
$_
) {
die
"Error writing to file\n"
}
}
return
;
}
sub
scan_docs {
my
(
$start
,
$end
,
$outfmt
,
$script
) =
@_
;
$Sane::_status
=
SANE_STATUS_GOOD;
my
$scannedpages
= 0;
while
(
$end
< 0 ||
$start
<=
$end
) {
my
$fname
=
sprintf
$outfmt
,
$start
;
if
(
$no_overwrite
and -r
$fname
) {
$Sane::_status
= SANE_STATUS_INVAL;
warn
"Filename $fname already exists; will not overwrite\n"
;
}
if
(
$Sane::STATUS
== SANE_STATUS_GOOD ) {
scan_it_raw(
$fname
,
$raw
,
$script
);
}
if
(
$Sane::STATUS
== SANE_STATUS_NO_DOCS ) {
$Sane::_status
= SANE_STATUS_GOOD;
last
;
}
elsif
(
$Sane::STATUS
== SANE_STATUS_EOF ) {
$Sane::_status
= SANE_STATUS_GOOD;
warn
"Scanned document $fname\n"
;
$scannedpages
++;
$start
++;
}
else
{
warn
"$Sane::STATUS\n"
;
last
;
}
}
warn
"Scanned $scannedpages pages\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
;
exit
1
if
( !GetOptions(
@args
) );
for
(
@argv_old
) {
my
$ch
;
if
(/--(.*)/xsm) {
$ch
= $1;
my
$i
=
index
$ch
,
q{=}
;
if
(
$i
> -1 ) {
$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
[3],
$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
] - 1;
if
(
$window
[
$index
+ 2 ] ) {
my
$pos
=
$device
->get_option(
$window
[
$index
+ 2 ] );
if
(
defined
$pos
) {
$val
=
$pos
+
$window_val
[
$index
] }
}
set_option(
$device
,
$window
[
$index
],
$val
);
}
}
return
;
}
sub
print_options {
printf
"\nOptions specific to device `%s':\n"
,
$devname
;
for
my
$i
( 0 ..
$num_dev_options
- 1 ) {
my
$short_name
=
$EMPTY
;
my
$opt
= 0;
for
my
$j
( 0 ..
$INDENT
- 1 ) {
if
(
$i
==
$window
[
$j
] ) {
$short_name
=
substr
'xylt'
,
$j
, 1;
if
(
$j
< 2 ) {
$opt
=
$window_option
[
$j
] }
}
}
if
( !
$opt
) {
$opt
=
$device
->get_option_descriptor(
$i
) }
if
(
$opt
->{type} == SANE_TYPE_GROUP ) {
printf
" %s:\n"
,
$opt
->{title};
}
next
if
( !(
$opt
->{cap} & SANE_CAP_SOFT_SELECT ) );
print_option(
$device
,
$i
,
$short_name
);
}
if
(
$num_dev_options
) { printstdout(
"\n"
) }
return
;
}
sub
list_device_names {
printf
"Type ``$prog_name --help -d DEVICE'' to get list of all options for DEVICE.\n\nList of available devices:"
;
my
@device_list
= Sane->get_devices;
if
(
$Sane::STATUS
== SANE_STATUS_GOOD ) {
my
$column
=
$END_COLUMN
;
for
(
@device_list
) {
if
(
$column
+
length
(
$_
->{name} ) + 1 >=
$END_COLUMN
) {
printf
"\n "
;
$column
=
$INDENT
;
}
if
(
$column
>
$INDENT
) {
printstdout(
$SPACE
);
$column
+= 1;
}
printstdout(
$_
->{name} );
$column
+=
length
(
$_
->{name} );
}
}
printstdout(
"\n"
);
return
;
}
for
(
@ARGV
) {
if
(
$_
eq
'-l'
) {
$_
=
'-m'
}
if
(
$_
eq
'-t'
) {
$_
=
'-u'
}
}
GetOptions(
@args
);
if
(
defined
$options
{L} ) {
my
@device_list
= Sane->get_devices;
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
die
"$prog_name: sane_get_devices() failed: $Sane::STATUS\n"
;
}
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"
;
}
if
(
defined
$ENV
{
'SANE_DEFAULT_DEVICE'
} ) {
printf
"default device is `%s'\n"
,
$ENV
{'SANE_DEFAULT_DEVICE'};
}
exit
0;
}
if
(
defined
$options
{V} ) {
printf
"$prog_name (sane-backends) %s\n"
, Sane->get_version;
exit
0;
}
if
(
$help
) {
print
<<"EOS"; ## no critic (RequireCheckedSyscalls)
Usage: $prog_name [OPTION]...
Start image acquisition on a scanner device and write image data to
output files.
[ -d | --device-name <device> ] use a given scanner device.
[ -h | --help ] display this help message and exit.
[ -L | --list-devices ] show available scanner devices.
[ -v | --verbose ] give even more status messages.
[ -V | --version ] print version information.
[ -N | --no-overwrite ] don't overwrite existing files.
[ -o | --output-file <name> ] name of file to write image data
(\%d replacement in output file name).
[ -S | --scan-script <name> ] name of script to run after every scan.
[ --script-wait ] wait for scripts to finish before exit
[ -s | --start-count <num> ] page count of first scanned image.
[ -e | --end-count <num> ] last page number to scan.
[ -r | --raw ] write raw image data to file.
EOS
}
if
( !
$devname
) {
my
@device_list
= Sane->get_devices;
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
die
"$prog_name: sane_get_devices() failed: $Sane::STATUS\n"
;
}
if
( not
@device_list
) {
die
"$prog_name: no SANE devices found\n"
;
}
$devname
=
$device_list
[0]{name};
}
$device
= Sane::Device->
open
(
$devname
);
if
(
$Sane::STATUS
!= SANE_STATUS_GOOD ) {
warn
"$prog_name: open of device $devname failed: $Sane::STATUS\n"
;
if
(
$help
) {
undef
$device
;
}
else
{
exit
1;
}
}
if
(
defined
$device
) {
fetch_options(
$device
);
process_arguments();
if
(
$help
) {
print_options();
}
}
if
(
$help
) {
list_device_names();
exit
0;
}
local
$SIG
{HUP} = \
&sighandler
;
local
$SIG
{INT} = \
&sighandler
;
local
$SIG
{PIPE} = \
&sighandler
;
local
$SIG
{TERM} = \
&sighandler
;
scan_docs(
$startnum
,
$endnum
,
$outputfile
,
$scanscript
);
exit
$Sane::STATUS
;