Paste: Served simple mmap counter
Author: | tsculpt |
Mode: | factor |
Date: | Wed, 3 Mar 2010 05:33:35 |
Plain Text |
USING: accessors alien.c-types arrays command-line io
io.encodings.ascii io.encodings.binary io.files io.files.temp
io.mmap io.servers.connection kernel math math.order
math.parser memoize namespaces sequences specialized-arrays
system threads ;
IN: mmap-count
SPECIALIZED-ARRAY: int
SYMBOLS: mmap-count-array mmap-count-server ;
CONSTANT: num-counters 10
MEMO: mmap-count-path ( -- path ) "counts" temp-file ;
: ensure-counts-file ( -- )
mmap-count-path exists? [
num-counters <int-array>
mmap-count-path binary set-file-contents
] unless ;
: (count-at) ( i -- count )
mmap-count-array get nth ;
: (increment-counter) ( i -- )
mmap-count-array get
[ 1 + ] change-nth ;
: counter-in-bounds? ( i -- ? )
0 num-counters 1 - between? ;
: (handle-mmap-count-client) ( -- )
readln string>number dup dup
[ counter-in-bounds? and ] when*
[ dup (increment-counter) (count-at) number>string ]
[ drop
"Specify a counter in the range [0,"
num-counters 1 - number>string "]" 3array "" join
] if
print flush ;
: <mmap-count-server> ( -- threaded-server )
ascii <threaded-server> "mmap-count-server" >>name
1234 local-server >>insecure [ (handle-mmap-count-client) ] >>handler ;
: start-mmap-count-server ( -- )
ensure-counts-file <mmap-count-server> mmap-count-server set
[
mmap-count-path int [
mmap-count-array set
mmap-count-server get start-server
] with-mapped-array
] in-thread ;
: check-args ( -- )
command-line get
[ length 1 = ] [ first string>number ] bi and
[ "Usage: mmap-count <n>" print 1 exit ] unless ;
: increment-and-respond ( i -- )
mmap-count-path int [
[ [ 1 + ] change-nth ]
[ nth number>string print ] 2bi
] with-mapped-array ;
: exit-out-of-bounds ( i -- )
number>string write " not in counter range [0," num-counters 1 -
number>string "]" 3array "" join print 1 exit ;
: handle-command-line ( -- )
check-args command-line get first string>number
dup counter-in-bounds?
[ ensure-counts-file increment-and-respond ] [ exit-out-of-bounds ] if ;
MAIN: handle-command-line
New Annotation