clx-3185w scanner - fixed

#!/usr/bin/perl
# Licence: WTFPL
#
use IO::Socket;
use strict;
use File::Temp qw/ tempdir /;
our $DEBUG=undef ;

our $sock;
our $prefix=0X1BA8;
our $PRINTERIP="192.168.1.9";
our $filename=$ARGV[0];
our $dpi=$ARGV[1];

our $dir=tempdir( CLEANUP => 1 );
usage() if ( !defined($filename));
usage() if ( -e "$filename" );
if (defined($dpi) )
{
    usage()     if ( $dpi !~ m/^\d+$/ );
}



doit();
presentit();


sub applypercent
{
    my $percent=shift;
    my $max=shift,
    $percent=0.01 if ($percent>1);
    return $max*$percent;
}
# Fournit les settings a utiliser au scanner
# init_scan <width%> <height%> <right corner x> <right corner y> <color type:1|2|3> <dpi>
sub init_scan
{
    my $cmd=0X24;
    my $length=0X13;
    my $static1=0X30;
    my $null=0X00;
    my $_width=shift;
    my $maxwidth=0X2778;
    my $_height=shift;
    my $maxheight=0X3200;
    my $rightcornerx=shift;
    my $rightcornery=shift;
    my $color=shift;
    my $_dpi=shift;

#my $height=applypercent($_height,$maxheight);
#   my $width=applypercent($_width,$maxwidth);
    my $height=$maxheight;
    my $width=$maxwidth;
    print "height : ".b2h($height)."\n" if($DEBUG);
    print "Width : ".b2h($width)."\n" if($DEBUG);


    my $colorprefix=0X0506;
    if ($color==1) {
        $colorprefix=0X0506;
    }elsif ($color==2) {
        $colorprefix=0X0306;
    }elsif ($color==3) {
        $colorprefix=0X0004;
    }

    my $static1=0x30;
    my $static2=0x0;
    my $static3=0x07;
    my $static4=0x02;
    my $static5=0x40;

    my $dpi=0X0;
    if ($_dpi<100){
        $dpi=0X0;
    }elsif($_dpi< 150){
        $dpi=0x0a0a;
    }elsif($_dpi< 200){
        $dpi=0x0202;
    }elsif($_dpi< 300){
        $dpi=0x0909;
    }elsif($_dpi< 600){
        $dpi=0x0505;
    }elsif($_dpi< 1200){
        $dpi=0x0707;
    }elsif($_dpi>= 1200){
        $dpi=0x0808;
    }
    print "dpi $_dpi : ".b2h($dpi)."\n" if($DEBUG);

    my $pkt=pack ("nCCCnnnnnnnnCCCC",
    $prefix,
    $cmd,$length,
    $static1,$static2,
    $width,$static2,
    $height,
    $dpi,
    $rightcornerx,$rightcornery,
    $colorprefix,
    $static3,$static4,$static5,$static1);
    return $pkt;
}

#Envoie une commande simple (pas d'arguments spécifiques)
#uniquement le numéro de la commande et la longueur du padding est nécessaire.
#envoie la commande $cmd, suivi 0{length} en data (la taille du paquet est géré)
sub sendsimplecmd
{
    my $cmd=shift;
    my $length=shift;
    $length=0 if ($length<0);
    my $pkt;
    if($length==0){
        $pkt=pack "nCC",$prefix,$cmd,$length
    }else{
        $pkt=pack "nCCx$length",$prefix,$cmd,$length;
    }
    return $pkt;
}
#Effectue le processus d'identification (cmd 12 puis 13)
sub identificate
{
    my $data=sendsimplecmd(0x12,0);
    send_data($data);
    my $ret=get();
    my $data=sendsimplecmd(0x13,0Xfb);
    send_data($data);
    $ret=get();
    return $ret;
}
#
#permet de préparer le scanner a changer les settings (cmd 16 puis 25)
sub preparescan
{
    my $data=sendsimplecmd(0x16,0);
    send_data($data);
    my $ret=get();
    my $data=sendsimplecmd(0x25,0Xfb);
    send_data($data);
    $ret=get();
    return $ret;
}
#demande au scanner si une partie est prête a être récuperée
sub isnotfinish
{
    my $pkt=sendsimplecmd(0x28,0);
    send_data($pkt);
    my $ret=get();

    my ($valid,$size,$high)=unpack("CNN",$ret);
    my $state;
    $state=1 if ($valid==0x80);
    $state=2 if ($valid==0x81);

    $state=0 if (defined ($state) and $size==0);
    return $state,$size,$high;

}
#Récupére l'ensemble des parties et les stocke dans un fichier
sub waitscan
{
    my ($state,$size,$high)=isnotfinish();
    my $number=0;
SCAN:   while (defined($state)){
        if ($state==1 or $state==2)
        {

        print "my state is $state (".b2h($size).")\n" if ($DEBUG);
            my $pkt=sendsimplecmd(0x29,0);
            send_data($pkt);
            getJFIF($size,$number++);
        }elsif($state==0)
        {
            sleep(1);
        }else{
            last SCAN;
        }
        last SCAN if ($state==2);
        ($state,$size,$high)=isnotfinish();
    }
    return $state;
}
#ferme la cx au scanner proprement (permet de dropper le cache chez le scanner
sub endcx
{
    my $ret;
    my $pkt=sendsimplecmd(0x6,0);
    send_data($pkt);
    my $ret2=get();
    $pkt=sendsimplecmd(0x17,0);
    send_data($pkt);
    $ret2=get();
    return $ret;

}
sub getfilename
{
    my $num=shift;
    if ($num<10){$num="000$num";}
    elsif ($num<100){$num="00$num";}
    elsif ($num<1000){$num="0$num";}
    else              {$num="$num";}
    return "$dir/$num.jpg";
}
#récupere une partie des images
sub getJFIF
{
    my $size=shift;
    my $number=shift;
    if (!defined($size))
    {
        print "impossible de recuperer : taille non définie\n";
        return;
    }
    open(FH,">".getfilename($number));
    binmode(FH);
    my $buff='';
    my $rc=$sock->read($buff,$size);
    print FH $buff;
    return $rc;
}
#Affiche une chaine en hexa
sub b2h {
    my $bytes=shift;
    my @myArray=unpack('C*', $bytes);
    my $myStringHex = '';

    foreach my $c (@myArray) {
      $myStringHex .= " " . sprintf ("%lx", $c);
    }
    return  $myStringHex;
}
#envoie les données sur le socket
sub send_data{
    my $data=shift;
    if (defined($sock))
    {
        print $sock $data;
    }else
    {
        print "Paquet envoyé";
        print "\n=============\n";
        print $data;
        print "\n=============\n";
    }
}
#récupère les données de conf issues du serveur (tout sauf les images)
sub get
{
    my $pf;
    my $length;
    my $data;
    if (defined($sock)){
        $sock->read($pf,2);
        print "recu pf :".b2h($pf)."\n" if($DEBUG);
        $sock->read($length,1);
        $length=unpack("C",$length);
        print "lgth = ".b2h($length)."\n" if ($DEBUG);
        if ($length==0){
            $sock->read($length,3);

            print "recu length longue :".b2h($length)."\n" if ($DEBUG);
            (undef,undef,$length)=unpack("CCC",$length);
#   $length=0xf9;
        }
        $sock->read($data,$length);
    }

    print "read done\n" if ($DEBUG);
    if (defined($data)){
    #   my @array=unpack "C*",$data;
    #   return \@array;
        return $data;
    }else{
        return undef;
    }

}
#ouvre la cx au scanner
sub createcx
{
    my $addr=shift;
    my $port=shift;
    $port=9400 if (!defined($port));
    print "$addr:$port\n";

    $sock=new IO::Socket::INET (
            PeerAddr => $addr,
            PeerPort => $port,
            Proto => 'tcp'
            );
    die "Could not create socket: $!\n" unless $sock;
    $sock->autoflush(1);
    binmode($sock);

}
#effectue l'ensemble des opérations afin de récuperer
sub doit
{
    my ($percw,$perch,$crw,$crh,$color,$_dpi)=(1,1,0,0,1,650);
    $dpi=$_dpi if (!defined($dpi));
    my $ret;
print "====cx===\n" if($DEBUG);
    #on se connecte au serveur
    createcx($PRINTERIP,"9400");
print "====id===\n" if($DEBUG);
    #on récupère les infos du scanner
    identificate();
print "====pr===\n" if($DEBUG);
    #on prépare le scanner a faire un scan
    preparescan();
    #on lui file les settings qui nous intéresse.

print "====in===\n" if($DEBUG);
    my $pkt=init_scan($percw,$perch,$crw,$crh,$color,$dpi);
    send_data($pkt);
    $ret=get();
print "====la===\n" if($DEBUG);
    #on lui indique de lancer le scan
    my $data=sendsimplecmd(0x31,0);
    send_data($data);
    $ret=get();
print "====wa===\n" if($DEBUG);
    $ret=waitscan();
print "====en===\n" if($DEBUG);
    endcx();

}

sub presentit
{
    `convert "$dir"/*.jpg  -append -normalize "$filename"`
}
sub usage
{
    print "Script : <nom_du_fichier_de_dest> [dpi]\n";
    die;
}