« back to all changes in this revision
Viewing changes to bin/scanadf-perl
- browse files at revision 22
- compare with another revision
- download diff
- download tarball
- view history from revision 22
- Committer: Package Import Robot
- Author(s): Jeffrey Ratcliffe
- Date: 2013-10-08 09:38:10 UTC
- mfrom: (1.3.11)
- Revision ID: package-import@ubuntu.com-20131008093810-dhoer6ktpjentiox
Tags: 1.1.3-1
* New upstream release
Closes: #723784 (gscan2pdf: New upstream version available)
* Removed all patches
Removed Build-Depends: quilt
Updated rules not to use quilt
* Bumped standards to 3.9.4 (no changes required)
Closes: #723784 (gscan2pdf: New upstream version available)
* Removed all patches
Removed Build-Depends: quilt
Updated rules not to use quilt
* Bumped standards to 3.9.4 (no changes required)
- files added:
- lib/Gscan2pdf/Dialog
- lib/Gscan2pdf/Dialog/Scan
- files removed:
- .gitignore
- debian/patches
- files modified:
- History
added
removed
bin/scanadf-perl
2
2
3
3
use warnings;
4
4
use strict;
5
use feature "switch";
5
6
use Sane;
6
7
use Data::Dumper;
7
8
use Getopt::Long qw(:config no_ignore_case pass_through);
10
11
11
12
#$Sane::DEBUG = 1;
12
13
13
my (
14
%options, @window_val_user, @window_option,
15
@window_val, @window, $device,
16
$format, $devname, %option_number
17
);
14
my ( %options, @window_val_user, @window_option, @window_val, @window, $device,
15
$devname, %option_number );
18
16
my $num_dev_options = 0;
19
17
my $verbose = 0;
20
18
my $help = 0;
101
99
sub print_unit {
102
100
my ($unit) = @_;
103
101
104
if ( $unit == SANE_UNIT_PIXEL ) {
105
print "pel";
106
}
107
elsif ( $unit == SANE_UNIT_BIT ) {
108
print "bit";
109
}
110
elsif ( $unit == SANE_UNIT_MM ) {
111
print "mm";
112
}
113
elsif ( $unit == SANE_UNIT_DPI ) {
114
print "dpi";
115
}
116
elsif ( $unit == SANE_UNIT_PERCENT ) {
117
print "%";
118
}
119
elsif ( $unit == SANE_UNIT_MICROSECOND ) {
120
print "us";
102
given ($unit) {
103
when (SANE_UNIT_PIXEL) {
104
print "pel";
105
}
106
when (SANE_UNIT_BIT) {
107
print "bit";
108
}
109
when (SANE_UNIT_MM) {
110
print "mm";
111
}
112
when (SANE_UNIT_DPI) {
113
print "dpi";
114
}
115
when (SANE_UNIT_PERCENT) {
116
print "%";
117
}
118
when (SANE_UNIT_MICROSECOND) {
119
print "us";
120
}
121
121
}
122
122
return;
123
123
}
124
124
125
125
sub print_option {
126
my ( $device, $opt_num, $short_name ) = @_;
127
128
my $not_first = SANE_FALSE;
129
my $maxwindow = 0;
126
( $device, my $opt_num, my $short_name ) = @_;
130
127
131
128
my $opt = $device->get_option_descriptor($opt_num);
132
129
137
134
printf " --%s", $opt->{name};
138
135
}
139
136
137
print_option_choices($opt);
138
print_current_option_value( $opt, $opt_num );
139
140
print " [inactive]"
141
if ( $opt->{type} != SANE_TYPE_BUTTON and $opt->{cap} & SANE_CAP_INACTIVE );
142
143
print "\n ";
144
145
if ( $short_name eq 'x' ) {
146
print "Width of scan-area.";
147
}
148
elsif ( $short_name eq 'y' ) {
149
print "Height of scan-area.";
150
}
151
else {
152
my $column = 8;
153
my $last_break = 0;
154
my $start = 0;
155
for ( my $pos = 0 ; $pos < length( $opt->{desc} ) ; ++$pos ) {
156
++$column;
157
$last_break = $pos if ( substr( $opt->{desc}, $pos, 1 ) eq ' ' );
158
if ( $column >= 79 and $last_break ) {
159
print substr( $opt->{desc}, $start++, 1 ) while ( $start < $last_break );
160
$start = $last_break + 1; # skip blank
161
print "\n ";
162
$column = 8 + $pos - $start;
163
}
164
}
165
print substr( $opt->{desc}, $start++, 1 )
166
while ( $start < length( $opt->{desc} ) );
167
}
168
print "\n";
169
return;
170
}
171
172
sub print_option_choices { ## no critic (ProhibitExcessComplexity)
173
my ($opt) = @_;
140
174
if ( $opt->{type} == SANE_TYPE_BOOL ) {
141
175
print "[=(";
142
176
print "auto|" if ( $opt->{cap} & SANE_CAP_AUTOMATIC );
146
180
print ' ';
147
181
if ( $opt->{cap} & SANE_CAP_AUTOMATIC ) {
148
182
print "auto|";
149
$not_first = SANE_TRUE;
150
183
}
151
184
if ( $opt->{constraint_type} == SANE_CONSTRAINT_NONE ) {
152
185
if ( $opt->{type} == SANE_TYPE_INT ) {
161
194
print ",..." if ( $opt->{max_values} > 1 );
162
195
}
163
196
elsif ( $opt->{constraint_type} == SANE_CONSTRAINT_RANGE ) {
164
my $format = "%g..%g";
165
$format = "%d..%d" if ( $opt->{type} == SANE_TYPE_INT );
197
my $string_format = "%g..%g";
198
$string_format = "%d..%d" if ( $opt->{type} == SANE_TYPE_INT );
166
199
if ( $opt->{name} eq SANE_NAME_SCAN_BR_X ) {
167
$maxwindow = $opt->{constraint}{max} - $tl_x;
168
printf $format, $opt->{constraint}{min}, $maxwindow;
200
printf $string_format, $opt->{constraint}{min},
201
$opt->{constraint}{max} - $tl_x;
169
202
}
170
203
elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_Y ) {
171
$maxwindow = $opt->{constraint}{max} - $tl_y;
172
printf $format, $opt->{constraint}{min}, $maxwindow;
204
printf $string_format, $opt->{constraint}{min},
205
$opt->{constraint}{max} - $tl_y;
173
206
}
174
207
else {
175
printf $format, $opt->{constraint}{min}, $opt->{constraint}{max};
208
printf $string_format, $opt->{constraint}{min}, $opt->{constraint}{max};
176
209
}
177
210
print_unit( $opt->{unit} );
178
211
print ",..." if ( $opt->{max_values} > 1 );
184
217
{
185
218
for ( my $i = 0 ; $i < @{ $opt->{constraint} } ; ++$i ) {
186
219
print '|' if ( $i > 0 );
220
my $string_format = $opt->{type} == SANE_TYPE_FIXED ? '%g' : '%s';
187
221
188
print $opt->{constraint}[$i];
222
printf $string_format, $opt->{constraint}[$i];
189
223
}
190
224
if ( $opt->{constraint_type} == SANE_CONSTRAINT_WORD_LIST ) {
191
225
print_unit( $opt->{unit} );
193
227
}
194
228
}
195
229
}
230
return;
231
}
232
233
sub print_current_option_value {
234
my ( $opt, $opt_num ) = @_;
196
235
if ( $opt->{max_values} == 1 ) {
197
236
198
237
# print current option value
203
242
print( $val ? "yes" : "no" );
204
243
}
205
244
elsif ( $opt->{type} == SANE_TYPE_INT or $opt->{type} == SANE_TYPE_FIXED ) {
206
my $format = "%g";
207
$format = "%d" if ( $opt->{type} == SANE_TYPE_INT );
208
if ( $opt->{name} eq SANE_NAME_SCAN_TL_X ) {
209
$tl_x = $val;
210
printf $format, $tl_x;
211
}
212
elsif ( $opt->{name} eq SANE_NAME_SCAN_TL_Y ) {
213
$tl_y = $val;
214
printf $format, $tl_y;
215
}
216
elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_X ) {
217
$br_x = $val;
218
$w_x = $br_x - $tl_x;
219
printf $format, $w_x;
220
}
221
elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_Y ) {
222
$br_y = $val;
223
$h_y = $br_y - $tl_y;
224
printf $format, $h_y;
225
}
226
else {
227
printf $format, $val;
245
my $string_format = "%g";
246
$string_format = "%d" if ( $opt->{type} == SANE_TYPE_INT );
247
given ( $opt->{name} ) {
248
when (SANE_NAME_SCAN_TL_X) {
249
$tl_x = $val;
250
printf $string_format, $tl_x;
251
}
252
when (SANE_NAME_SCAN_TL_Y) {
253
$tl_y = $val;
254
printf $string_format, $tl_y;
255
}
256
when (SANE_NAME_SCAN_BR_X) {
257
$br_x = $val;
258
$w_x = $br_x - $tl_x;
259
printf $string_format, $w_x;
260
}
261
when (SANE_NAME_SCAN_BR_Y) {
262
$br_y = $val;
263
$h_y = $br_y - $tl_y;
264
printf $string_format, $h_y;
265
}
266
default {
267
printf $string_format, $val;
268
}
228
269
}
229
270
}
230
271
elsif ( $opt->{type} == SANE_TYPE_STRING ) {
233
274
print ']';
234
275
}
235
276
}
236
237
print " [inactive]" if ( $opt->{cap} & SANE_CAP_INACTIVE );
238
239
print "\n ";
240
241
if ( $short_name eq 'x' ) {
242
print "Width of scan-area.";
243
}
244
elsif ( $short_name eq 'y' ) {
245
print "Height of scan-area.";
246
}
247
else {
248
my $column = 8;
249
my $last_break = 0;
250
my $start = 0;
251
for ( my $pos = 0 ; $pos < length( $opt->{desc} ) ; ++$pos ) {
252
++$column;
253
$last_break = $pos if ( substr( $opt->{desc}, $pos, 1 ) eq ' ' );
254
if ( $column >= 79 and $last_break ) {
255
print substr( $opt->{desc}, $start++, 1 ) while ( $start < $last_break );
256
$start = $last_break + 1; # skip blank
257
print "\n ";
258
$column = 8 + $pos - $start;
259
}
260
}
261
print substr( $opt->{desc}, $start++, 1 )
262
while ( $start < length( $opt->{desc} ) );
263
}
264
print "\n";
265
277
return;
266
278
}
267
279
290
302
my ( $opt, $str ) = @_;
291
303
292
304
my ( $v, $unit );
293
if ( $str =~ /^(\d*\.?\d*)(cm|mm|in|\"|b|B|dpi|%|us)?/ ) {
305
if (
306
$str =~ /^
307
(\d*\.?\d*) # value
308
(cm|mm|in|\"|b|B|dpi|%|us)? # optional unit
309
/x
310
)
311
{
294
312
$v = $1;
295
313
$unit = $2;
296
314
$unit = '' if not defined $unit;
344
362
my $separator = '';
345
363
my ( @vector, $value );
346
364
do {
347
if ( $str =~ /^\[/ ) {
348
if ( $str =~ /^\[(\d*\.?\d*)\]/ ) {
349
$index = $1;
350
}
351
else {
365
if ( $str =~ /^\[(\d*\.?\d*)(\])?/x ) {
366
$index = $1;
367
unless ( $2 eq '\]' ) {
352
368
print STDERR "$prog_name: option --$opt->{name}: closing bracket missing "
353
369
. "(rest of option: $str)\n";
354
370
exit(1);
368
384
# read value
369
385
( $value, $str ) = parse_scalar( $opt, $str );
370
386
371
if ( $str ne '' and $str !~ /^[-,]/ ) {
387
if ( $str ne '' and $str !~ /^[-,]/x ) {
372
388
print STDERR
373
389
"$prog_name: option --$opt->{name}: illegal separator (rest of option: $str)\n";
374
390
exit(1);
405
421
}
406
422
407
423
sub fetch_options {
408
my $device = shift;
424
$device = shift;
409
425
410
426
# We got a device, find out how many options it has:
411
427
$num_dev_options = $device->get_option(0);
427
443
and ( $opt->{unit} == SANE_UNIT_DPI )
428
444
and ( $opt->{name} eq SANE_NAME_SCAN_RESOLUTION ) );
429
445
430
# Keep track of top-left corner options (if they exist at
431
# all) and replace the bottom-right corner options by a
432
# width/height option (if they exist at all).
433
if ( ( $opt->{type} == SANE_TYPE_FIXED || $opt->{type} == SANE_TYPE_INT )
434
and ( $opt->{unit} == SANE_UNIT_MM || $opt->{unit} == SANE_UNIT_PIXEL ) )
435
{
436
if ( $opt->{name} eq SANE_NAME_SCAN_TL_X ) {
446
update_geometry( $opt, $i );
447
448
if ( $opt->{type} == SANE_TYPE_BOOL ) {
449
push @args, "$opt->{name}:s";
450
}
451
elsif ( $opt->{type} == SANE_TYPE_BUTTON ) {
452
push @args, $opt->{name};
453
}
454
else {
455
push @args, "$opt->{name}=s";
456
}
457
}
458
459
# Initialize width & height options based on backend default
460
# values for top-left x/y and bottom-right x/y:
461
for ( my $i = 0 ; $i < 2 ; ++$i ) {
462
if ( $window[$i] and $window[ $i + 2 ] and not $window_val_user[$i] ) {
463
my $pos = $device->get_option( $window[ $i + 2 ] );
464
$window_val[$i] = $window_val[$i] - $pos if ( defined $pos );
465
}
466
}
467
return;
468
}
469
470
# Keep track of top-left corner options (if they exist at
471
# all) and replace the bottom-right corner options by a
472
# width/height option (if they exist at all).
473
sub update_geometry {
474
my ( $opt, $i ) = @_;
475
if ( ( $opt->{type} == SANE_TYPE_FIXED || $opt->{type} == SANE_TYPE_INT )
476
and ( $opt->{unit} == SANE_UNIT_MM || $opt->{unit} == SANE_UNIT_PIXEL ) )
477
{
478
given ( $opt->{name} ) {
479
when (SANE_NAME_SCAN_TL_X) {
437
480
$window[2] = $i;
438
481
$opt->{name} = 'l';
439
482
}
440
elsif ( $opt->{name} eq SANE_NAME_SCAN_TL_Y ) {
483
when (SANE_NAME_SCAN_TL_Y) {
441
484
$window[3] = $i;
442
485
$opt->{name} = 't';
443
486
}
444
elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_X ) {
487
when (SANE_NAME_SCAN_BR_X) {
445
488
$window[0] = $i;
446
489
$opt->{name} = 'x';
447
490
$window_option[0] = $opt;
450
493
$window_val[0] = $device->get_option($i)
451
494
if ( !$window_val_user[0] );
452
495
}
453
elsif ( $opt->{name} eq SANE_NAME_SCAN_BR_Y ) {
496
when (SANE_NAME_SCAN_BR_Y) {
454
497
$window[1] = $i;
455
498
$opt->{name} = 'y';
456
499
$window_option[1] = $opt;
460
503
if ( !$window_val_user[1] );
461
504
}
462
505
}
463
464
if ( $opt->{type} == SANE_TYPE_BOOL ) {
465
push @args, "$opt->{name}:s";
466
}
467
elsif ( $opt->{type} == SANE_TYPE_BUTTON ) {
468
push @args, $opt->{name};
469
}
470
else {
471
push @args, "$opt->{name}=s";
472
}
473
}
474
475
# Initialize width & height options based on backend default
476
# values for top-left x/y and bottom-right x/y:
477
for ( my $i = 0 ; $i < 2 ; ++$i ) {
478
if ( $window[$i] and $window[ $i + 2 ] and not $window_val_user[$i] ) {
479
my $pos = $device->get_option( $window[ $i + 2 ] );
480
$window_val[$i] = $window_val[$i] - $pos if ( defined $pos );
481
}
482
506
}
483
507
return;
484
508
}
485
509
486
510
sub set_option {
487
my ( $device, $optnum, $value ) = @_;
511
( $device, my $optnum, my $value ) = @_;
488
512
489
513
my $opt = $device->get_option_descriptor($optnum);
490
514
if ( $opt and ( $opt->{cap} & SANE_CAP_INACTIVE ) ) {
518
542
}
519
543
520
544
sub process_backend_option {
521
my ( $device, $optnum, $optarg ) = @_;
545
( $device, my $optnum, my $optarg ) = @_;
522
546
523
547
my $opt = $device->get_option_descriptor($optnum);
524
548
529
553
530
554
if ( ( $opt->{cap} & SANE_CAP_AUTOMATIC )
531
555
and $optarg
532
and $optarg =~ /^auto$/i )
556
and $optarg =~ /^auto$/ix )
533
557
{
534
558
$device->set_auto($optnum);
535
559
if ( $Sane::STATUS != SANE_STATUS_GOOD ) {
541
565
}
542
566
543
567
my $value;
544
if ( $opt->{type} == SANE_TYPE_BOOL ) {
545
$value = 1; # no argument means option is set
546
if ($optarg) {
547
if ( $optarg =~ /^yes$/i ) {
548
$value = 1;
549
}
550
elsif ( $optarg =~ /^no$/i ) {
551
$value = 0;
552
}
553
else {
554
printf STDERR
555
"$prog_name: option --$opt->{name}: bad option value `$optarg'\n";
556
exit(1);
557
}
558
}
559
}
560
elsif ( $opt->{type} == SANE_TYPE_INT or $opt->{type} == SANE_TYPE_FIXED ) {
561
my @vector = parse_vector( $opt, $optarg );
562
$value = \@vector;
563
}
564
elsif ( $opt->{type} == SANE_TYPE_STRING ) {
565
$value = $optarg;
566
}
567
elsif ( $opt->{type} == SANE_TYPE_BUTTON ) {
568
$value = 0; # value doesn't matter
569
}
570
else {
571
printf STDERR "$prog_name: duh, got unknown option type $opt->{type}\n";
572
return;
568
given ( $opt->{type} ) {
569
when (SANE_TYPE_BOOL) {
570
$value = 1; # no argument means option is set
571
if ($optarg) {
572
if ( $optarg =~ /^yes$/ix ) {
573
$value = 1;
574
}
575
elsif ( $optarg =~ /^no$/ix ) {
576
$value = 0;
577
}
578
else {
579
printf STDERR
580
"$prog_name: option --$opt->{name}: bad option value `$optarg'\n";
581
exit(1);
582
}
583
}
584
}
585
when ( $opt->{type} == SANE_TYPE_INT or $opt->{type} == SANE_TYPE_FIXED ) {
586
my @vector = parse_vector( $opt, $optarg );
587
$value = \@vector;
588
}
589
when (SANE_TYPE_STRING) {
590
$value = $optarg;
591
}
592
when (SANE_TYPE_BUTTON) {
593
$value = 0; # value doesn't matter
594
}
595
default {
596
printf STDERR "$prog_name: duh, got unknown option type $opt->{type}\n";
597
return;
598
}
573
599
}
574
600
set_option( $device, $optnum, $value );
575
601
return;
576
602
}
577
603
578
604
sub write_pnm_header_to_file {
579
my ( $fh, $format, $width, $height, $depth ) = @_;
605
my ( $fh, $frame_format, $width, $height, $depth ) = @_;
580
606
581
607
# The netpbm-package does not define raw image data with maxval > 255.
582
608
# But writing maxval 65535 for 16bit data gives at least a chance
583
609
# to read the image.
584
610
585
if ($format == SANE_FRAME_RED
586
or $format == SANE_FRAME_GREEN
587
or $format == SANE_FRAME_BLUE
588
or $format == SANE_FRAME_RGB )
611
if ($frame_format == SANE_FRAME_RED
612
or $frame_format == SANE_FRAME_GREEN
613
or $frame_format == SANE_FRAME_BLUE
614
or $frame_format == SANE_FRAME_RGB )
589
615
{
590
616
printf $fh "P6\n# SANE data follows\n%d %d\n%d\n", $width, $height,
591
617
( $depth <= 8 ) ? 255 : 65535;
592
618
}
593
elsif ( $format == SANE_FRAME_GRAY ) {
619
elsif ( $frame_format == SANE_FRAME_GRAY ) {
594
620
if ( $depth == 1 ) {
595
621
printf $fh "P4\n# SANE data follows\n%d %d\n", $width, $height;
596
622
}
603
629
}
604
630
605
631
sub scan_it_raw {
606
my ( $fname, $raw, $script ) = @_;
632
( my $fname, $raw, my $script ) = @_;
607
633
608
634
my $first_frame = 1, my $offset = 0, my $must_buffer = 0;
609
635
my $min = 0xff, my $max = 0;
612
638
my $parm;
613
639
{
614
640
do { # extra braces to get last to work.
615
$device->start;
616
if ( $Sane::STATUS != SANE_STATUS_GOOD ) {
617
print STDERR "$prog_name: sane_start: $Sane::STATUS\n"
618
if ( $Sane::STATUS != SANE_STATUS_NO_DOCS );
619
goto cleanup;
620
}
621
622
$parm = $device->get_parameters;
623
if ( $Sane::STATUS != SANE_STATUS_GOOD ) {
624
print STDERR "$prog_name: sane_get_parameters: $Sane::STATUS\n";
625
goto cleanup;
626
}
627
628
open $fp, '>', $fname; ## no critic
629
if ( !$fp ) {
630
print STDERR "Error opening output `$fname': $@\n";
631
$Sane::_status = SANE_STATUS_IO_ERROR;
632
goto cleanup;
633
}
634
635
if ($verbose) {
636
if ($first_frame) {
637
if ( sane_isbasicframe( $parm->{format} ) ) {
638
if ( $parm->{lines} >= 0 ) {
639
printf STDERR "$prog_name: scanning image of size %dx%d pixels at "
640
. "%d bits/pixel\n",
641
$parm->{pixels_per_line}, $parm->{lines},
642
8 * $parm->{bytes_per_line} / $parm->{pixels_per_line};
643
}
644
else {
645
printf STDERR "$prog_name: scanning image %d pixels wide and "
646
. "variable height at %d bits/pixel\n",
647
$parm->{pixels_per_line},
648
8 * $parm->{bytes_per_line} / $parm->{pixels_per_line};
649
}
650
}
651
else {
652
printf STDERR "$prog_name: receiving %s frame "
653
. "bytes/line=%d, "
654
. "pixels/line=%d, "
655
. "lines=%d, "
656
. "depth=%d\n",
657
, sane_strframe( $parm->{format} ),
658
$parm->{bytes_per_line},
659
$parm->{pixels_per_line},
660
$parm->{lines},
661
$parm->{depth};
662
}
663
}
664
665
printf STDERR "$prog_name: acquiring %s frame\n",
666
sane_strframe( $parm->{format} );
667
}
668
669
if ($first_frame) {
670
if ($parm->{format} == SANE_FRAME_RED
671
or $parm->{format} == SANE_FRAME_GREEN
672
or $parm->{format} == SANE_FRAME_BLUE )
673
{
674
die unless ( $parm->{depth} == 8 );
675
$must_buffer = 1;
676
$offset = $parm->{format} - SANE_FRAME_RED;
677
}
678
elsif ( $parm->{format} == SANE_FRAME_RGB ) {
679
die unless ( $parm->{depth} == 8 );
680
}
681
if ($parm->{format} == SANE_FRAME_RGB
682
or $parm->{format} == SANE_FRAME_GRAY )
683
{
684
die unless ( ( $parm->{depth} == 1 ) || ( $parm->{depth} == 8 ) );
685
686
# if we're writing raw, we skip the header and never
687
# have to buffer a single frame format.
688
if ( $raw == SANE_FALSE ) {
689
if ( $parm->{lines} < 0 ) {
690
$must_buffer = 1;
691
$offset = 0;
692
}
693
else {
694
write_pnm_header_to_file( $fp, $parm->{format}, $parm->{pixels_per_line},
695
$parm->{lines}, $parm->{depth} );
696
}
697
}
698
}
699
elsif ( $parm->{format} == $SANE_FRAME_TEXT
700
or $parm->{format} == $SANE_FRAME_JPEG
701
or $parm->{format} == $SANE_FRAME_G31D
702
or $parm->{format} == $SANE_FRAME_G32D
703
or $parm->{format} == $SANE_FRAME_G42D )
704
{
705
if ( !$parm->{last_frame} ) {
706
$Sane::_status = SANE_STATUS_INVAL;
707
printf STDERR "$prog_name: bad %s frame: must be last_frame\n",
708
sane_strframe( $parm->{format} );
709
goto cleanup;
710
}
711
}
712
713
# write them out without a header; don't buffer
714
else {
715
716
# Default action for unknown frametypes; write them out
717
# without a header; issue a warning in verbose mode.
718
# Since we're not writing a header, there's no need to
719
# buffer.
720
printf STDERR "$prog_name: unknown frame format $parm->{format}\n"
721
if ($verbose);
722
if ( !$parm->{last_frame} ) {
723
$Sane::_status = SANE_STATUS_INVAL;
724
printf STDERR "$prog_name: bad %s frame: must be last_frame\n",
725
sane_strframe( $parm->{format} );
726
goto cleanup;
727
}
728
}
729
}
730
else {
731
die
732
unless ( $parm->{format} >= SANE_FRAME_RED
733
&& $parm->{format} <= SANE_FRAME_BLUE );
734
$offset = $parm->{format} - SANE_FRAME_RED;
735
$image{x} = $image{y} = 0;
736
}
641
log_frame_info( $parm, $fp, $fname, $first_frame );
642
643
my ( $must_buffer, $offset ) = initialise_scan( $parm, $first_frame, $fp );
737
644
738
645
while (1) {
739
646
my ( $buffer, $len ) = $device->read($buffer_size);
747
654
last;
748
655
}
749
656
750
if ($must_buffer) {
751
752
# We're either scanning a multi-frame image or the
753
# scanner doesn't know what the eventual image height
754
# will be (common for hand-held scanners). In either
755
# case, we need to buffer all data before we can write
756
# the image
757
if ($parm->{format} == SANE_FRAME_RED
758
or $parm->{format} == SANE_FRAME_GREEN
759
or $parm->{format} == SANE_FRAME_BLUE )
760
{
761
for ( my $i = 0 ; $i < $len ; ++$i ) {
762
$image{data}[ $offset + 3 * $i ] = substr( $buffer, $i, 1 );
763
}
764
$offset += 3 * $len;
765
}
766
elsif ( $parm->{format} == SANE_FRAME_RGB
767
or $parm->{format} == SANE_FRAME_GRAY )
768
{
769
for ( my $i = 0 ; $i < $len ; ++$i ) {
770
$image{data}[ $offset + $i ] = substr( $buffer, $i, 1 );
771
}
772
$offset += $len;
773
}
774
else {
775
776
# optional frametypes are never buffered
777
printf STDERR "$prog_name: ERROR: trying to buffer %s frametype\n",
778
sane_strframe( $parm->{format} );
779
}
780
}
781
else {
782
print $fp $buffer;
783
}
657
$offset =
658
buffer_data( $fp, $parm, $buffer, $len, \%image, $offset, $must_buffer );
784
659
785
660
if ( $verbose && $parm->{depth} == 8 ) {
786
661
for ( split( //, $buffer ) ) {
800
675
}
801
676
802
677
if ($must_buffer) {
803
if ( $parm->{lines} > 0 ) {
804
$image{height} = $parm->{lines};
805
}
806
else {
807
$image{height} = @{ $image{data} } / $parm->{pixels_per_line};
808
$image{height} /= 3
809
if ( $parm->{format} == SANE_FRAME_RED
810
or $parm->{format} == SANE_FRAME_GREEN
811
or $parm->{format} == SANE_FRAME_BLUE );
812
}
813
if ( $raw == SANE_FALSE ) {
814
815
# if we're writing raw, we skip the header
816
write_pnm_header_to_file( $fp, $parm->{format}, $parm->{pixels_per_line},
817
$image{height}, $parm->{depth} );
818
}
819
for ( @{ $image{data} } ) { print $fp $_; }
678
write_buffer( $fp, \%image, $parm );
820
679
}
821
680
822
681
if ($fp) {
829
688
return;
830
689
}
831
690
691
sub log_frame_info {
692
my ( $parm, $fp, $fname, $first_frame ) = @_;
693
$device->start;
694
if ( $Sane::STATUS != SANE_STATUS_GOOD ) {
695
print STDERR "$prog_name: sane_start: $Sane::STATUS\n"
696
if ( $Sane::STATUS != SANE_STATUS_NO_DOCS );
697
goto cleanup;
698
}
699
700
$parm = $device->get_parameters;
701
if ( $Sane::STATUS != SANE_STATUS_GOOD ) {
702
print STDERR "$prog_name: sane_get_parameters: $Sane::STATUS\n";
703
goto cleanup;
704
}
705
706
unless ( open $fp, '>', $fname ) ## no critic (RequireBriefOpen)
707
{
708
print STDERR "Error opening output `$fname': $@\n";
709
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
710
SANE_STATUS_IO_ERROR;
711
goto cleanup;
712
}
713
714
if ($verbose) {
715
if ($first_frame) {
716
if ( sane_isbasicframe( $parm->{format} ) ) {
717
if ( $parm->{lines} >= 0 ) {
718
printf STDERR "$prog_name: scanning image of size %dx%d pixels at "
719
. "%d bits/pixel\n",
720
$parm->{pixels_per_line}, $parm->{lines},
721
8 * $parm->{bytes_per_line} / $parm->{pixels_per_line};
722
}
723
else {
724
printf STDERR "$prog_name: scanning image %d pixels wide and "
725
. "variable height at %d bits/pixel\n",
726
$parm->{pixels_per_line},
727
8 * $parm->{bytes_per_line} / $parm->{pixels_per_line};
728
}
729
}
730
else {
731
printf STDERR "$prog_name: receiving %s frame "
732
. "bytes/line=%d, "
733
. "pixels/line=%d, "
734
. "lines=%d, "
735
. "depth=%d\n",, sane_strframe( $parm->{format} ),
736
$parm->{bytes_per_line},
737
$parm->{pixels_per_line},
738
$parm->{lines},
739
$parm->{depth};
740
}
741
}
742
743
printf STDERR "$prog_name: acquiring %s frame\n",
744
sane_strframe( $parm->{format} );
745
}
746
return;
747
}
748
749
sub initialise_scan { ## no critic (ProhibitExcessComplexity)
750
my ( $parm, $first_frame, $fp ) = @_;
751
my ( $must_buffer, $offset );
752
if ($first_frame) {
753
if ($parm->{format} == SANE_FRAME_RED
754
or $parm->{format} == SANE_FRAME_GREEN
755
or $parm->{format} == SANE_FRAME_BLUE )
756
{
757
die # FIXME: compare message with SANE source, and give them patch if necessary
758
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 8)\n"
759
unless ( $parm->{depth} == 8 );
760
$must_buffer = 1;
761
$offset = $parm->{format} - SANE_FRAME_RED;
762
}
763
elsif ( $parm->{format} == SANE_FRAME_RGB ) {
764
die # FIXME: compare message with SANE source, and give them patch if necessary
765
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 8)\n"
766
unless ( $parm->{depth} == 8 );
767
}
768
if ($parm->{format} == SANE_FRAME_RGB
769
or $parm->{format} == SANE_FRAME_GRAY )
770
{
771
die # FIXME: compare message with SANE source, and give them patch if necessary
772
"Error: frame format $parm->{format}, but image depth=$parm->{depth} (expected 1 or 8)\n"
773
unless ( ( $parm->{depth} == 1 ) || ( $parm->{depth} == 8 ) );
774
775
# if we're writing raw, we skip the header and never
776
# have to buffer a single frame format.
777
if ( $raw == SANE_FALSE ) {
778
if ( $parm->{lines} < 0 ) {
779
$must_buffer = 1;
780
$offset = 0;
781
}
782
else {
783
write_pnm_header_to_file( $fp, $parm->{format}, $parm->{pixels_per_line},
784
$parm->{lines}, $parm->{depth} );
785
}
786
}
787
}
788
elsif ( $parm->{format} == $SANE_FRAME_TEXT
789
or $parm->{format} == $SANE_FRAME_JPEG
790
or $parm->{format} == $SANE_FRAME_G31D
791
or $parm->{format} == $SANE_FRAME_G32D
792
or $parm->{format} == $SANE_FRAME_G42D )
793
{
794
if ( !$parm->{last_frame} ) {
795
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
796
SANE_STATUS_INVAL;
797
printf STDERR "$prog_name: bad %s frame: must be last_frame\n",
798
sane_strframe( $parm->{format} );
799
goto cleanup;
800
}
801
}
802
803
# write them out without a header; don't buffer
804
else {
805
806
# Default action for unknown frametypes; write them out
807
# without a header; issue a warning in verbose mode.
808
# Since we're not writing a header, there's no need to
809
# buffer.
810
printf STDERR "$prog_name: unknown frame format $parm->{format}\n"
811
if ($verbose);
812
if ( !$parm->{last_frame} ) {
813
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
814
SANE_STATUS_INVAL;
815
printf STDERR "$prog_name: bad %s frame: must be last_frame\n",
816
sane_strframe( $parm->{format} );
817
goto cleanup;
818
}
819
}
820
}
821
else {
822
die # FIXME: compare message with SANE source, and give them patch if necessary
823
"Error: frame format $parm->{format}, but expected SANE_FRAME_RED, SANE_FRAME_GREEN, or SANE_FRAME_BLUE\n"
824
if ( $parm->{format} < SANE_FRAME_RED
825
or $parm->{format} > SANE_FRAME_BLUE );
826
$offset = $parm->{format} - SANE_FRAME_RED;
827
}
828
return $must_buffer, $offset;
829
}
830
831
sub buffer_data { ## no critic (ProhibitManyArgs)
832
my ( $fp, $parm, $buffer, $len, $image, $offset, $must_buffer ) = @_;
833
if ($must_buffer) {
834
835
# We're either scanning a multi-frame image or the
836
# scanner doesn't know what the eventual image height
837
# will be (common for hand-held scanners). In either
838
# case, we need to buffer all data before we can write
839
# the image
840
if ($parm->{format} == SANE_FRAME_RED
841
or $parm->{format} == SANE_FRAME_GREEN
842
or $parm->{format} == SANE_FRAME_BLUE )
843
{
844
for ( my $i = 0 ; $i < $len ; ++$i ) {
845
$image->{data}[ $offset + 3 * $i ] = substr( $buffer, $i, 1 );
846
}
847
$offset += 3 * $len;
848
}
849
elsif ( $parm->{format} == SANE_FRAME_RGB
850
or $parm->{format} == SANE_FRAME_GRAY )
851
{
852
for ( my $i = 0 ; $i < $len ; ++$i ) {
853
$image->{data}[ $offset + $i ] = substr( $buffer, $i, 1 );
854
}
855
$offset += $len;
856
}
857
else {
858
859
# optional frametypes are never buffered
860
printf STDERR "$prog_name: ERROR: trying to buffer %s frametype\n",
861
sane_strframe( $parm->{format} );
862
}
863
}
864
else {
865
print $fp $buffer;
866
}
867
return $offset;
868
}
869
870
sub write_buffer {
871
my ( $fp, $image, $parm ) = @_;
872
if ( $parm->{lines} > 0 ) {
873
$image->{height} = $parm->{lines};
874
}
875
else {
876
$image->{height} = @{ $image->{data} } / $parm->{pixels_per_line};
877
$image->{height} /= 3
878
if ( $parm->{format} == SANE_FRAME_RED
879
or $parm->{format} == SANE_FRAME_GREEN
880
or $parm->{format} == SANE_FRAME_BLUE );
881
}
882
if ( $raw == SANE_FALSE ) {
883
884
# if we're writing raw, we skip the header
885
write_pnm_header_to_file( $fp, $parm->{format}, $parm->{pixels_per_line},
886
$image->{height}, $parm->{depth} );
887
}
888
for ( @{ $image->{data} } ) { print $fp $_; }
889
return;
890
}
891
832
892
sub scan_docs {
833
my ( $start, $end, $no_overwrite, $raw, $outfmt, $script ) = @_;
893
my ( $start, $end, $outfmt, $script ) = @_;
834
894
835
$Sane::_status = SANE_STATUS_GOOD;
895
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
896
SANE_STATUS_GOOD;
836
897
my $scannedPages = 0;
837
898
838
899
while ( $end < 0 || $start <= $end ) {
842
903
843
904
# does the filename already exist?
844
905
if ( $no_overwrite and -r $fname ) {
845
$Sane::_status = SANE_STATUS_INVAL;
906
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
907
SANE_STATUS_INVAL;
846
908
print STDERR "Filename $fname already exists; will not overwrite\n";
847
909
}
848
910
853
915
if ( $Sane::STATUS == SANE_STATUS_NO_DOCS ) {
854
916
855
917
# out of paper in the hopper; this is our normal exit
856
$Sane::_status = SANE_STATUS_GOOD;
918
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
919
SANE_STATUS_GOOD;
857
920
last;
858
921
}
859
922
elsif ( $Sane::STATUS == SANE_STATUS_EOF ) {
860
923
861
924
# done with this doc
862
$Sane::_status = SANE_STATUS_GOOD;
925
$Sane::_status = ## no critic (ProhibitPackageVars ProtectPrivateVars)
926
SANE_STATUS_GOOD;
863
927
print STDERR "Scanned document $fname\n";
864
928
$scannedPages++;
865
929
$start++;
877
941
return;
878
942
}
879
943
944
sub process_arguments {
945
946
# re-enable error printing and arg permutation
947
Getopt::Long::Configure('no_pass_through');
948
949
# There seems to be a bug in Getopt::Long 2.37 where l is treated as L whilst
950
# l is not in @args. Therefore the workaround is to rename l to m for the first
951
# scan and back to l for the second.
952
for (@ARGV) {
953
$_ = '-l' if ( $_ eq '-m' );
954
$_ = '-t' if ( $_ eq '-u' );
955
}
956
my @ARGV_old = @ARGV;
957
exit 1 if ( !GetOptions(@args) );
958
959
# As it isn't possible to get the argument order from Getopt::Long 2.37, do
960
# this myself
961
for (@ARGV_old) {
962
my $ch;
963
if (/--(.*)/x) {
964
$ch = $1;
965
my $i = index( $ch, '=' );
966
$ch = substr( $ch, 0, $i ) if ( $i > -1 );
967
}
968
elsif (/-(.)/x) {
969
$ch = $1;
970
}
971
else {
972
next;
973
}
974
if ( defined $options{$ch} ) {
975
given ($ch) {
976
when ('x') {
977
$window_val_user[0] = 1;
978
( $window_val[0] ) = parse_vector( $window_option[0], $options{x} );
979
}
980
when ('y') {
981
$window_val_user[1] = 1;
982
( $window_val[1] ) = parse_vector( $window_option[1], $options{y} );
983
}
984
when ('l') { # tl-x
985
process_backend_option( $device, $window[2], $options{l} );
986
}
987
when ('t') { # tl-y
988
process_backend_option( $device, $window[3], $options{t} );
989
}
990
default {
991
process_backend_option( $device, $option_number{$ch}, $options{$ch} );
992
}
993
}
994
}
995
}
996
997
for ( my $index = 0 ; $index < 2 ; ++$index ) {
998
if ( $window[$index] and defined( $window_val[$index] ) ) {
999
my $val = $window_val[$index] - 1;
1000
if ( $window[ $index + 2 ] ) {
1001
my $pos = $device->get_option( $window[ $index + 2 ] );
1002
$val = $pos + $window_val[$index] if ( defined $pos );
1003
}
1004
set_option( $device, $window[$index], $val );
1005
}
1006
}
1007
return;
1008
}
1009
1010
sub print_options {
1011
printf "\nOptions specific to device `%s':\n", $devname;
1012
1013
for ( my $i = 0 ; $i < $num_dev_options ; ++$i ) {
1014
my $short_name = '';
1015
1016
my $opt = 0;
1017
for ( my $j = 0 ; $j < 4 ; ++$j ) {
1018
if ( $i == $window[$j] ) {
1019
$short_name = substr( "xylt", $j, 1 );
1020
$opt = $window_option[$j] if ( $j < 2 );
1021
}
1022
}
1023
$opt = $device->get_option_descriptor($i) if ( !$opt );
1024
1025
printf " %s:\n", $opt->{title} if ( $opt->{type} == SANE_TYPE_GROUP );
1026
1027
next if ( !( $opt->{cap} & SANE_CAP_SOFT_SELECT ) );
1028
1029
print_option( $device, $i, $short_name );
1030
}
1031
print "\n" if ($num_dev_options);
1032
return;
1033
}
1034
1035
sub list_device_names {
1036
printf
1037
"Type ``$prog_name --help -d DEVICE'' to get list of all options for DEVICE.\n\nList of available devices:";
1038
my @device_list = Sane->get_devices;
1039
if ( $Sane::STATUS == SANE_STATUS_GOOD ) {
1040
my $column = 80;
1041
1042
foreach (@device_list) {
1043
if ( $column + length( $_->{name} ) + 1 >= 80 ) {
1044
printf "\n ";
1045
$column = 4;
1046
}
1047
if ( $column > 4 ) {
1048
print ' ';
1049
$column += 1;
1050
}
1051
print $_->{name};
1052
$column += length( $_->{name} );
1053
}
1054
}
1055
print "\n";
1056
return;
1057
}
1058
880
1059
# There seems to be a bug in Getopt::Long 2.37 where l is treated as L whilst
881
1060
# l is not in @args. Therefore the workaround is to rename l to m for the first
882
1061
# scan and back to l for the second.
916
1095
}
917
1096
918
1097
if ($help) {
919
print "Usage: $prog_name [OPTION]...\n
1098
print <<"EOS";
1099
Usage: $prog_name [OPTION]...
1100
920
1101
Start image acquisition on a scanner device and write image data to
921
output files.\n
1102
output files.
1103
922
1104
[ -d | --device-name <device> ] use a given scanner device.
923
1105
[ -h | --help ] display this help message and exit.
924
1106
[ -L | --list-devices ] show available scanner devices.
925
1107
[ -v | --verbose ] give even more status messages.
926
1108
[ -V | --version ] print version information.
927
[ -N | --no-overwrite ] don't overwrite existing files.\n
1109
[ -N | --no-overwrite ] don't overwrite existing files.
1110
928
1111
[ -o | --output-file <name> ] name of file to write image data
929
1112
(\%d replacement in output file name).
930
1113
[ -S | --scan-script <name> ] name of script to run after every scan.
931
1114
[ --script-wait ] wait for scripts to finish before exit
932
1115
[ -s | --start-count <num> ] page count of first scanned image.
933
1116
[ -e | --end-count <num> ] last page number to scan.
934
[ -r | --raw ] write raw image data to file.\n";
1117
[ -r | --raw ] write raw image data to file.
1118
EOS
935
1119
}
936
1120
937
1121
if ( !$devname ) {
963
1147
964
1148
if ( defined($device) ) {
965
1149
fetch_options($device);
966
967
# re-enable error printing and arg permutation
968
Getopt::Long::Configure('no_pass_through');
969
970
# There seems to be a bug in Getopt::Long 2.37 where l is treated as L whilst
971
# l is not in @args. Therefore the workaround is to rename l to m for the first
972
# scan and back to l for the second.
973
for (@ARGV) {
974
$_ = '-l' if ( $_ eq '-m' );
975
$_ = '-t' if ( $_ eq '-u' );
976
}
977
my @ARGV_old = @ARGV;
978
exit 1 if ( !GetOptions(@args) );
979
980
# As it isn't possible to get the argument order from Getopt::Long 2.37, do
981
# this myself
982
for (@ARGV_old) {
983
my $ch;
984
if (/--(.*)/) {
985
$ch = $1;
986
my $i = index( $ch, '=' );
987
$ch = substr( $ch, 0, $i ) if ( $i > -1 );
988
}
989
elsif (/-(.)/) {
990
$ch = $1;
991
}
992
else {
993
next;
994
}
995
if ( defined $options{$ch} ) {
996
if ( $ch eq 'x' ) {
997
$window_val_user[0] = 1;
998
( $window_val[0] ) = parse_vector( $window_option[0], $options{x} );
999
}
1000
elsif ( $ch eq 'y' ) {
1001
$window_val_user[1] = 1;
1002
( $window_val[1] ) = parse_vector( $window_option[1], $options{y} );
1003
}
1004
elsif ( $ch eq 'l' ) { # tl-x
1005
process_backend_option( $device, $window[2], $options{l} );
1006
}
1007
elsif ( $ch eq 't' ) { # tl-y
1008
process_backend_option( $device, $window[3], $options{t} );
1009
}
1010
else {
1011
process_backend_option( $device, $option_number{$ch}, $options{$ch} );
1012
}
1013
}
1014
}
1015
1016
for ( my $index = 0 ; $index < 2 ; ++$index ) {
1017
if ( $window[$index] and defined( $window_val[$index] ) ) {
1018
my $val = $window_val[$index] - 1;
1019
if ( $window[ $index + 2 ] ) {
1020
my $pos = $device->get_option( $window[ $index + 2 ] );
1021
$val = $pos + $window_val[$index] if ( defined $pos );
1022
}
1023
set_option( $device, $window[$index], $val );
1024
}
1025
}
1150
process_arguments();
1151
1026
1152
if ($help) {
1027
printf "\nOptions specific to device `%s':\n", $devname;
1028
1029
for ( my $i = 0 ; $i < $num_dev_options ; ++$i ) {
1030
my $short_name = '';
1031
1032
my $opt = 0;
1033
for ( my $j = 0 ; $j < 4 ; ++$j ) {
1034
if ( $i == $window[$j] ) {
1035
$short_name = substr( "xylt", $j, 1 );
1036
$opt = $window_option[$j] if ( $j < 2 );
1037
}
1038
}
1039
$opt = $device->get_option_descriptor($i) if ( !$opt );
1040
1041
printf " %s:\n", $opt->{title} if ( $opt->{type} == SANE_TYPE_GROUP );
1042
1043
next if ( !( $opt->{cap} & SANE_CAP_SOFT_SELECT ) );
1044
1045
print_option( $device, $i, $short_name );
1046
}
1047
print "\n" if ($num_dev_options);
1153
print_options();
1048
1154
}
1049
1155
}
1050
1156
1051
1157
if ($help) {
1052
printf
1053
"Type ``$prog_name --help -d DEVICE'' to get list of all options for DEVICE.\n\nList of available devices:";
1054
my @device_list = Sane->get_devices;
1055
if ( $Sane::STATUS == SANE_STATUS_GOOD ) {
1056
my $column = 80;
1057
1058
foreach (@device_list) {
1059
if ( $column + length( $_->{name} ) + 1 >= 80 ) {
1060
printf "\n ";
1061
$column = 4;
1062
}
1063
if ( $column > 4 ) {
1064
print ' ';
1065
$column += 1;
1066
}
1067
print $_->{name};
1068
$column += length( $_->{name} );
1069
}
1070
}
1071
print "\n";
1158
list_device_names();
1072
1159
exit(0);
1073
1160
}
1074
1161
1077
1164
local $SIG{PIPE} = \&sighandler;
1078
1165
local $SIG{TERM} = \&sighandler;
1079
1166
1080
scan_docs( $startNum, $endNum, $no_overwrite, $raw, $outputFile, $scanScript );
1167
scan_docs( $startNum, $endNum, $outputFile, $scanScript );
1081
1168
1082
1169
exit $Sane::STATUS;
1083
1170
Loggerhead is a web-based interface for Breezy
Version: 2.0.1