5 use Data::Dump qw(dump);
11 my $socket = IO::Socket::INET->new(
18 print "$0 waiting for client connection on port 4096\n";
23 BW => 0.0, # just paper cost
24 COLOR => 3.99, # FIXME
29 our $client_socket = $socket->accept();
32 my $text = join('', @_);
34 print $client_socket "$text\r\n";
38 my $line = <$client_socket>;
39 $line =~ s/[\r\n]+$//;
44 # get the host and port number of newly connected client.
45 my $peer_address = $client_socket->peerhost();
46 my $peer_port = $client_socket->peerport();
48 print "Connection from: $peer_address:$peer_port\n";
51 my $total_charged = 0.00;
54 my $v = shift || $credit;
55 return sprintf "%1.2f kn", $v;
58 while ($client_socket->connected) {
60 my $line = client_line;
62 if ( $line =~ m/^\.SQ ([\d\.]+) (\S+)/ ) {
63 my ($version,$serial) = ($1,$2);
65 #client_send ".SQ FAILED message";
66 } elsif ( $line =~ m/^\.CFG/ ) {
67 client_send ".CFG OK %s";
68 } elsif ( $line =~ m/\.SERVER LIST/ ) {
69 client_send ".ERROR NO-ENTERPRISE";
70 } elsif ( $line =~ m/\.CARD (\S+)/ ) {
72 client_send ".CARD OK Ime Prezime (nobody\@example.com)";
73 } elsif ( $line =~ m/\.ACTION$/ ) {
74 client_send ".ACTION CMENUS0"; # FIXME can be CMENUS2
76 } elsif ( $line =~ m/\.ACTION COPY/ ) {
77 client_send ".ACTION COPY"; # safeq sends this twice
78 client_send ".COPY Mozete kopirati |".credit;
80 client_send ".CREDIT ".credit;
81 } elsif ( $line =~ m/\.COPY (.+)/ ) {
84 foreach ( split(/,/,$1) ) {
85 die "can't find [$_] in prices=",dump($prices) unless exists $prices->{$_};
86 $charge += $prices->{$_};
88 warn "CHARGE: $charge\n";
90 $total_charged += $charge;
92 client_send ".CREDIT ".credit;
93 client_send ".COPY 1"; # I verified that you are allowed to copy 1 page?
96 } elsif ( $line =~ m/\.ACTION LIST/ ) {
99 } elsif ( $line =~ m/\.ACTION PRINT ALL/ ) {
102 } elsif ( $line =~ m/(\.NOP)/ ) {
104 } elsif ( $line =~ m/^\.END/ ) {
105 client_send ".DONE BLK WAIT";
107 my $nop = client_line;
108 client_send "DONE $total_pages ".credit($total_charged);
109 warn "expected NOP got: $nop" unless $nop =~ m/NOP/;
110 my $null = client_line;
111 $client_socket->close;
113 warn "UNKNOWN: ",dump($line);
120 warn "# return to accept";