barcoded.pl

#!/usr/bin/perl -w 
#
# I'm from /project/barcode/barcoded
# I was from /home/wwwutz/git/raspberry.git/PIPIBAR
#

use strict;
use Data::Dumper; $Data::Dumper::Sortkeys=1;
use Linux::USBKeyboard;
use HTTP::Request;
use LWP::UserAgent;
use IO::File;
use IO::Handle;
use IO::Select;
use Fcntl (':flock');
use POSIX "setsid";
use URI::Escape;

sub USAGE { "usage: $0 device\n"; }

sub slurp {
    my ($fn)=@_;
    open my $in,'<',$fn or die "$fn: $!\n";
    return join ('',<$in>);
}

# /usr/include/sys/sysmacros.h
#  MMMM.MMMM MMMM.MMMM MMMM.MMMM MMMM.MMMM mmmm.mmmm mmmm.MMMM MMMM.MMMM mmmm.mmmm

sub major { my ($st_dev)=@_ ; return ( (($st_dev>>8) & 0xfff ) | (($st_dev>>32) & ~0xfff) ); }
sub minor { my ($st_dev)=@_ ; return ( (($st_dev   ) &  0xff ) | (($st_dev>>12) &  ~0xff) ); }

my %LOCKS;
my $IAM=$0;
my $mtime =(stat($IAM))[9];
my ($vendor_id, $product_id) = (0x05e0,0x1200);

open DEBUG,'>&STDERR';
DEBUG->autoflush(1);


my $BUSNUM;
my $DEVNUM;
my $SERIAL;

if (@ARGV==0) {
    ( $BUSNUM, $DEVNUM, $SERIAL ) = findfirst();
} elsif (@ARGV==1) {
    my ($device)=(@ARGV);
    my @f=lstat($device) or die "$device: $!\n";
    my $st_rdev=$f[6];
    my ($major,$minor)=(major($st_rdev),minor($st_rdev));
    my $sysdev=sprintf '/sys/dev/char/%d:%d',$major,$minor;
    $BUSNUM=slurp("$sysdev/busnum")+0;
    $DEVNUM=slurp("$sysdev/devnum")+0;
    $SERIAL=slurp("$sysdev/serial");
} else {
    die USAGE;
}

# iSerial                 3 S/N:CDDCDCC34B72704F9374DD29325F75F1 Rev:NBRMSAACDM:21OCT103

my ($READERID) = $SERIAL =~ m{S[/_]N:([A-Z0-9]+)};

my $LOCK="/dev/shm/barcoded-${READERID}.lock";

if ( ! Lock($LOCK) ) {
  print DEBUG scalar localtime() . ": already locked: $LOCK\n";
  exit 0;
}


# my $kb = Linux::USBKeyboard->new(busnum => 1, devnum => 2);
# my $fh = Linux::USBKeyboard->open_keys($vendor_id, $product_id);

{
  local *X =  $LOCKS{$LOCK};
  truncate(X,0);
  print X "$$\n";
  $0="$0 $READERID";
}

my $bcfh = Linux::USBKeyboard->open_keys(busnum => ${BUSNUM}, devnum => ${DEVNUM});

printf DEBUG scalar localtime() . ": open_keys() child =%d\n",$bcfh->pid;

my $sel = IO::Select->new;

$sel->add($bcfh);

my $code='';

print DEBUG "go go go\n";

my $ua = LWP::UserAgent->new;
$ua->max_redirect(0);

my $quit = 0;
while(my @ready = $sel->can_read) {
 # my $nt = (stat($IAM))[9];
 # print DEBUG "stat: $? : $!";
 #if ( $nt ne $mtime ) {
 #    print DEBUG "script $IAM changed. $nt != $mtime restarting\n"; 
 #    $_ = `perl -c $IAM`;
 #    if (!$?) {
 #      exec $IAM;
 #    }
 #    print DEBUG "### SYNTAX ERROR: $0\n$_\n";
 #    sleep 20;
 # }
 
 
  foreach my $fh (@ready) {
    my $line = <$fh>;
    defined $line or exit 0;
    chomp($line);
    #print DEBUG "--> $line <-- ($?)\n";
    if ($line eq '') {
        print DEBUG scalar localtime() . ": empty line ... exit()\n";
        $quit=1;
    }
    my ($k, @bits) = split(/ /, $line);
    my %bucky = map({$_ => 1} @bits);
      
    if ( $k eq 'tab' ) {
      if ($code eq 'EXITDAEMON') {
         $quit++;
         last;
      }

      my $url = 'http://barcode.molgen.mpg.de/code/'. uri_escape($READERID) . '/' . uri_escape($code) ;
      
      print DEBUG scalar localtime() . ": GET $url\n";
      my $r = HTTP::Request->new(GET => $url);
      my $response = $ua->request($r); # actually ask
      # print DEBUG Dumper(\$response);
      $code = '';
      $k = '';
    }
    $code .= $k;
  }
  last if ($quit);
}
print DEBUG "exit()\n";

exit;

sub Lock {
  my $l= shift;
  $LOCKS{$l} = new IO::File("+>>$l");
  unless (exists $LOCKS{$l}) {
     die "can't lock file $l $!";
  }
  my $r = flock($LOCKS{$l},&LOCK_EX+&LOCK_NB);
  return $r;
}

sub UnLock {
  my $l= shift;
  my $r;
  if (exists $LOCKS{$l}) {
     $r = flock($LOCKS{$l},&LOCK_UN);
     $LOCKS{$l}->close;
  }
  return $r;
}

# sucht einfach den ersten scanner. fuer manuellen aufruf und zum debugen.
# return busnum/devnum/serial
sub findfirst {
  # bug im lsusb, nur root darf serial lesen
  # also haendisch

  my ($vendor, $product) = ('05e0','1200');

  my ($busnum,$devnum,$serial)=(undef,undef,undef);
  
  my @USBdev=(</sys/bus/usb/devices/*>);
  for my $dev (@USBdev) {
    my $v = '';
    if ( -e "$dev/idVendor" ) {
      if (open I,'<',"$dev/idVendor" or warn "cannot read $dev/idVendor: $!" ) {
        $v=<I>||'';chomp($v);
        close I;
      }
      if ( $v eq $vendor ) {
        my $p = '';
        if (open I,'<',"$dev/idProduct" or warn "cannot read $dev/idProduct: $!" ) {
          $p=<I>||'';chomp($p);
          close I;
        }
        if ( $p eq $product ) {
          if (open I,'<',"$dev/serial" or warn "cannot read $dev/serial: $!" ) {
            $serial=<I>||'';chomp($serial);
            close I;
          }
          if (open I,'<',"$dev/busnum" or warn "cannot read $dev/busnum: $!" ) {
            $busnum=<I>||'';chomp($busnum);
            close I;
          }
          if (open I,'<',"$dev/devnum" or warn "cannot read $dev/devnum: $!" ) {
            $devnum=<I>||'';chomp($devnum);
            close I;
          }
          print DEBUG "FOUND [$busnum]/[$devnum] [$v]/[$p] [$serial]\n";
          last;
        }
      }
    }
  }
  return($busnum,$devnum,$serial);
}