Created
December 13, 2019 12:57
-
-
Save hungerburg/bb57f72bbbe7b14359db4563606c4351 to your computer and use it in GitHub Desktop.
Quorion Registrierkasse fernsteuern
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/bin/perl | |
# Quorion Registrierkasse fernsteuern | |
# - Berichte holen | |
# - Uhr stellen | |
# und vielleicht auch anderes | |
# | |
# Braucht ein POSIX System | |
# Konfiguration wie Windows QDriver | |
# Copyright (c) 2016-10-22 Hungerburg | |
# | |
# Permission is hereby granted, free of charge, to any person obtaining a copy | |
# of this software and associated documentation files (the "Software"), to deal | |
# in the Software without restriction, including without limitation the rights | |
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |
# copies of the Software, and to permit persons to whom the Software is | |
# furnished to do so, subject to the following conditions: | |
# | |
# The above copyright notice and this permission notice shall be included in | |
# all copies or substantial portions of the Software. | |
# | |
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | |
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | |
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | |
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE | |
# SOFTWARE. | |
# ;; Beispielstapel | |
# VISIBLE=1 | |
# PORT=9999 | |
# IP=192.168.0.100 | |
# REGISTER=1 | |
# ;; Anmelden mit Kennwort | |
# COMMAND=LI666 | |
# ;; Uhr stellen | |
# COMMAND=TSYSTEM | |
# ;; E-Journal holen | |
# DFILE=/tmp/Journal.csv | |
# COMMAND=RUx101001001 | |
# COMMAND=LO | |
use IO::Socket; | |
use File::Basename; | |
use POSIX qw(strftime); | |
use strict; | |
# Some Globals | |
my ($DBG, $host, $port, $sock, $out); | |
# Network Commands | |
sub open_net { | |
print "NET: $host:$port\n" if $DBG; | |
$sock = IO::Socket::INET->new( | |
Proto => 'udp', | |
PeerPort => $port, | |
PeerAddr => $host | |
) or die "Socket nicht angelegt: $!\n"; | |
# Nicht ewig warten: timeout nach 5 Sekunden | |
setsockopt($sock, SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', +5, 0)); | |
} | |
sub send_net { | |
my $data = shift; | |
defined $sock->send($data) or die "Senden fehlgeschlagen: $!\n"; | |
} | |
sub read_net { | |
my $buf; | |
while (1) { | |
defined $sock->recv($buf, 1024) or die "Empfangen fehlgeschlagen: $!"; | |
die "Login fehlgeschlagen" if $buf =~ /^\x06\x3a/; | |
last if $buf =~ /^\x06\x00/; # Übertragung Ende | |
defined $out or die "Keine Ausgabedatei\n"; | |
print $out "$buf\r\n"; | |
send_net "\x{06}"; # ACK | |
print "." if $DBG; | |
} | |
return unless defined $out; | |
print "\n" if $DBG; | |
close $out; | |
undef $out; | |
} | |
# Internal Commands | |
my $opts = { | |
TSYSTEM => sub { | |
return strftime("T%H%M%S%d%m%Y", localtime()); | |
} | |
}; | |
# Workers | |
sub set_dbg { | |
$DBG = shift; | |
return unless $DBG; | |
print "DBG: VISIBLE=$DBG\n"; | |
$|++; | |
} | |
sub set_host { | |
$host = shift; | |
open_net if $host && $port; | |
} | |
sub set_port { | |
$port = shift; | |
$port = 2030 if $port == 9999; | |
open_net if $host && $port; | |
} | |
sub set_register { | |
my $reg = shift; | |
die "Register nicht unterstützt" if $reg != 1; | |
} | |
sub do_command { | |
die "Netzwerk nicht an\n" unless defined $sock; | |
my $opt = shift; | |
if (exists $opts->{$opt}) { | |
$opt = $opts->{$opt}->(); | |
print "OPT: $opt\n" if $DBG; | |
} | |
send_net $opt; | |
read_net; | |
} | |
sub do_nfile { | |
my $path = shift; | |
defined $out and close($out); | |
print "OUT: $path\n" if $DBG; | |
open($out, ">", $path) or die "Ausgabedatei nicht möglich: $!\n"; | |
} | |
sub do_dfile { | |
my $path = shift; | |
my $time = strftime("%Y-%m-%dT%H-%M-%S", localtime()); | |
defined $out and close($out); | |
my ($base, $dir, $ext) = fileparse($path, qr/\.[^.]*$/); | |
$path = $dir . $base . "_" . $time . $ext; | |
print "OUT: $path\n" if $DBG; | |
open($out, ">", $path) or die "Ausgabedatei nicht möglich: $!\n"; | |
} | |
# External Commands | |
my $cmds = { | |
VISIBLE => \&set_dbg, | |
PORT => \&set_port, | |
IP => \&set_host, | |
REGISTER => \&set_register, | |
COMMAND => \&do_command, | |
NEWFILE => \&do_nfile, | |
DFILE => \&do_dfile | |
}; | |
# Main | |
my $cfg = shift; | |
defined $cfg or die "Keine Stapeldatei angegeben\n"; | |
open(FILE, "<:crlf", $cfg) or die "Fehler Stapeldatei: $!: $cfg\n"; | |
while (<FILE>) { | |
s/^\s+|\s+$//g; # Trim | |
next if m/^;/; # Kommentare | |
next if m/^$/; # Leerzeilen | |
my ($cmd, $opt) = split /=/, $_; | |
if (exists $cmds->{$cmd}) { | |
print "ACT: $_\n" if $DBG; | |
$cmds->{$cmd}->($opt); | |
} else { | |
print "IGN: $_\n" if $DBG; | |
} | |
} | |
defined $out and close($out); | |
# Netz wird von selber abgebaut |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Great utility, thanks for it! Now I can replace wine+qdriver...