[REBOL] lp/R
From: sqlab::gmx::net at: 26-Jul-2001 15:40
From the series
What the Rebol world does not need.
another protocol handler.
lp/R offers a simple way for Non/Pro users to send
jobs to line printer demons for printing and formatting
(and gives in conjunction with lpd-win from Gernot Zander
command and shell access).
There are some possible problems of usage.
If more than one running Rebol instance sends jobs to lpd,
they should be started from different directories (last jobnumber
is stored in the file %jobnro.lpr) and should not
send to the same lpd queue, as this can create equal job names
overwriting a former job.
According the RFCs 1179 a lpd command should be terminated by LF, but
during my tests most Unix lpdemons wanted CR LF, before giving back
the reply.
More modes of operation (primarily a matter of the lpd) can be supported by
adding lines in the control block after
either port/init-vector: select [
as
cif [#"c" ]
dvi [#"d" ]
plot [#"g" ]
raster [#"v" ]
As this protocol is not heavily tested, I would like to get some feedback.
AR
REBOL [title: "lp/R"
date: 26-July-2001
Author: "Anton Reisacher"
Email: [sqlab--gmx--net]
File: %lp.r
Version: 1.0
Description: {line printer (lpr) client }
Usage: {write lpr://[username--hostname]/queuename read %file
sends a job to the host into the queue, that belongs to the
user.
read lpr://.....
reads the status
default mode of operation is plain text, if you want to use
different modes, you can use /custom .... [post] for postscript or [leave]
leaving the job data unaltered by the host. It is recommended that you use [leave]
for jobs already formatted for the printer, especially in the windows world.
}
Category: 'net
]
make root-protocol [
scheme: 'lpr
port-id: 515
port-flags: system/standard/port-flags/pass-thru
jobs: 0
space: #" "
zero: "^@"
dfa: "dfa"
print-job: ["^A" port/target newline]
receive-job: ["^B" port/target newline]
queue-status: ["^D" port/target space port/user newline] ;
receive-control: ["^B" (form port/state/num: length? port/local-service)
space "cfa" port/last-remote-service system/network/host newline]
receive-data: ["^C" (form port/state/num: length? port/user-data) space
dfa port/last-remote-service system/network/host newline]
control: [#"H" system/network/host newline
#"P" port/user newline
#"U" dfa port/last-remote-service system/network/host newline
either port/init-vector: select [
plain [#"f"]
leave [#"l"]
post [#"o"]
] port/state/custom [port/init-vector] [#"f"] dfa
port/last-remote-service system/network/host newline
]
jobnro: func [/local tmp] [
save %jobnro.lpr jobs: jobs + 1
at tail join system/words/copy/part "000" 3 - length? form jobs jobs
-3
]
send-command: func [port command [block!]] [
bind command 'port
command: join first command next command
system/words/insert port/sub-port net-utils/net-log command
reply port
]
send-data: func [port data [string!] len /local sendlen] [
system/words/insert tail data zero
net-utils/net-log [len "Bytes sending"]
while [
not empty? data: at data 1 + sendlen: write-io port/sub-port
data len
] [
net-utils/net-log ["low level write of " sendlen "bytes"]
if sendlen < 1 [throw make error! "Write-Error"]
len: len - sendlen
]
reply port
]
reply: func [port /local reply temp] [
reply: make string! 130
read-io port/sub-port reply 128
if "^@" <> net-utils/net-log reply [throw make error! "ReplyError"]
reply
]
open: func [port [port! url!]
] [
open-proto port
port/state/flags: port/state/flags or
system/standard/port-flags/direct
port/sub-port/state/flags: port/sub-port/state/flags
error? try [if jobs = 0 [jobs: load %jobnro.lpr]]
port/user: any [port/user "anonymous"]
if port/state/custom [port/state/custom: port/state/custom/1]
send-command port receive-job
]
insert: func [port [port!] data] [
port/last-remote-service: jobnro
bind control 'port
port/user-data: data
send-command port receive-data
send-data port port/user-data port/state/num + 1
port/local-service: join control/1 next control
send-command port receive-control
send-data port port/local-service port/state/num + 1
]
close: func [port [port!]] [
system/words/close port/sub-port
]
copy: func [
port
/local command c-port
] [
bind queue-status 'port
c-port: system/words/open/lines join tcp:// [port/host ":"
port/port-id]
system/words/insert c-port net-utils/net-log join queue-status/1
next queue-status
msg: net-utils/net-log system/words/copy c-port
system/words/close c-port
msg
]
net-utils/net-install 'lpr self 515
]
--
GMXler aufgepasst - jetzt viele 1&1 New WebHosting Pakete ohne
Einrichtungsgebuehr + 1 Monat Grundgebuehrbefreiung!
http://puretec.de/index.html?ac=OM.PU.PU003K00717T0492a
