Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
barcode/html/code.pl
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
executable file
153 lines (123 sloc)
2.8 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/local/bin/perl -w | |
| use strict; | |
| use warnings; | |
| use URI::Escape; | |
| use CGI qw(-utf8 -no_xhtml :standard); | |
| use CGI::Carp qw(fatalsToBrowser); | |
| use Data::Dumper; | |
| use Barcode; | |
| my $NOW = time(); # this event time, atomic | |
| my $q = CGI->new; | |
| my $SC = $ENV{PATH_INFO}; $SC =~ s{^/}{}; | |
| my ($SERIAL,$CODE) = split('/',$SC,2); | |
| my $REMOTE = $ENV{REMOTE_ADDR}; | |
| # | |
| # defaults if not defined | |
| # | |
| # FROM ? / WHICH SCANNER ? / WHAT WAS SCANNED ? | |
| $REMOTE ||= 'unknown'; # host who sent code | |
| $SERIAL ||= 'unknown'; # serial of barcode-scanner | |
| $CODE ||= 'unknown'; # scanned code | |
| log_scan($REMOTE,$SERIAL,$CODE, $NOW); | |
| store_in_db($REMOTE,$SERIAL,$CODE, $NOW); | |
| my ($type,$url) = code2url($CODE); | |
| if ($type ne 'unknown') { | |
| print $q->redirect($url); | |
| exit; | |
| } | |
| print $q->header(-type => 'text/html',-charset=>'utf-8'); | |
| print <<"__EOHTML__"; | |
| <!DOCTYPE html> | |
| <html> | |
| <head> | |
| </head> | |
| <body> | |
| __EOHTML__ | |
| print "<xmp> $type / $url \n" . Dumper(\%CONF) . "</xmp>"; | |
| my $TEST = 'lastscanned'; | |
| if ( open O,'>',$TEST ) { | |
| print O uri_unescape($CODE); | |
| close O; | |
| } | |
| print <<"__EOHTML__"; | |
| </body> | |
| __EOHTML__ | |
| exit; | |
| sub log_scan { | |
| my ( $REMOTE, $READERID, $CODE, $TIME ) = @_; | |
| my $l = scalar localtime($TIME) . ": $REMOTE:$READERID:$CODE"; | |
| my $BC = $CONF{path}->{logfile}; | |
| if ( open O,'>>',$BC ) { | |
| print O "$l\n"; | |
| close O; | |
| print "$l\n"; | |
| } | |
| else { | |
| die "error logging: $BC $?:$!\n"; | |
| } | |
| } | |
| sub store_in_db { | |
| my ( $REMOTE, $READERID, $CODE , $TIME) = @_; | |
| use DBI; | |
| our $dbh; | |
| my $db = $CONF{path}->{dbfile}; | |
| sub db_open { | |
| my $f = shift; | |
| $dbh=DBI->connect("dbi:SQLite:dbname=$f","","",{ | |
| # AutoCommit=>1, | |
| PrintError=>0, | |
| RaiseError=>1, | |
| PrintWarn=>1, | |
| # sqlite_use_immediate_transaction => 1, | |
| }); | |
| $dbh or die "$DBI::errstr\n"; | |
| } | |
| sub db_create { | |
| #print "creating tables ...\n"; | |
| $dbh->do('CREATE TABLE codes ( time INTEGER, remote TEXT, readerid TEXT, code TEXT );'); | |
| } | |
| # | |
| # try to open database | |
| # | |
| db_open($db); | |
| if (! -e $db or -z $db) { | |
| db_create(); | |
| } | |
| $dbh->do('INSERT INTO codes(rowid, time,remote,readerid,code) VALUES(NULL,?,?,?,?)',undef, | |
| $TIME, | |
| $REMOTE, | |
| $READERID, | |
| $CODE | |
| ) | |
| } | |
| sub repl { | |
| my $find = shift; | |
| my $replace = shift; | |
| my $var = shift; | |
| my @items = ( $var =~ $find ); | |
| $var =~ s/$find/$replace/; | |
| for( reverse 0 .. $#items ){ | |
| my $n = $_ + 1; | |
| $var =~ s/\$$n/${items[$_]}/g ; | |
| } | |
| return $var; | |
| }; | |
| sub code2url { | |
| my $code = shift; | |
| my $type = 'unknown'; | |
| my $url = ''; | |
| for my $fr ( keys %{$CONF{re2url}} ) { | |
| if ($code =~ m/$fr/) { | |
| my $to = $CONF{re2url}->{$fr}; | |
| if ( exists($CONF{retype}->{$fr}) ) { | |
| $type = $CONF{retype}->{$fr}; | |
| } | |
| if ( $url = repl( $fr, $to, $code ) ) { | |
| last; | |
| } | |
| } | |
| } | |
| # if ($url =~ /^http:/) { | |
| # } | |
| return ($type,$url); | |
| }; |