module "ring.pli" module "/pliant/admin/file.pli"
function clear_size filename -> size arg Str filename ; arg Int size size := undefined if filename:len>3 and (filename filename:len-3 3)=".gz" (var Stream s) open filename in+safe s raw_read addressof:(var (Array uInt8 10) hdr) 10 if hdr:0=1Fh and hdr:1=8Bh and hdr:3=2^4 var Str comment := "" while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>0 and not s:atend } comment += character ch size := comment option "pliant_clear_size" Intn
if false
type CompressStreamDriver field Link:StreamDriver support StreamDriver maybe CompressStreamDriver method sd read buf mini maxi -> red arg_rw CompressStreamDriver sd ; arg Address buf ; arg Int mini maxi red red := sd:support read buf mini maxi method sd write buf mini maxi -> written arg_rw CompressStreamDriver sd ; arg Address buf ; arg Int mini maxi written written := sd:support write buf mini maxi method sd flush level -> status arg_rw CompressStreamDriver sd ; arg Int level ; arg Status status status := sd:support flush level method sd close -> status arg_rw CompressStreamDriver sd ; arg ExtendedStatus status status := sd:support close method sd query command stream answer -> status oarg_rw CompressStreamDriver sd ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status status := sd:support query command stream answer method sd configure command stream -> status arg_rw CompressStreamDriver sd ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status status := sd:support configure command stream
type CompressFileSystem void FileSystem maybe CompressFileSystem
method fs query filename options flags info -> status arg_rw CompressFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw FileInfo info ; arg ExtendedStatus status status := pliant_default_file_system query filename options flags info if status=failure var Intn csize := clear_size filename+".gz" if csize<>undefined status := pliant_default_file_system query filename+".gz" options flags info info size := csize
method fs list filename options flags files -> supported_flags oarg_rw CompressFileSystem fs ; arg Str filename options ; arg Int flags supported_flags ; arg_rw List files supported_flags := pliant_default_file_system list filename options flags files var Pointer:Arrow cur :> files first while cur<>null var Pointer:FileInfo file :> cur map FileInfo var Int csize := clear_size file:name if csize<>undefined file name := file:name 0 file:name:len-3 file size := csize cur :> files next cur
method fs open filename options flags stream support -> status oarg_rw CompressFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status if (flags .and. in+out+append)=out if (clear_size filename+".gz")<>undefined file_delete filename+".gz" if (flags .and. in+out+append+seek)<>in file_configure "compress:"+filename "uncompress" status := pliant_default_file_system open filename options flags stream support if status=failure status := pliant_default_file_system open "gzip:"+filename+".gz" options flags stream support if status=success if (stream:stream_driver query "comment" stream (var Str answer))=failure or (answer option "pliant_clear_size" Intn)=undefined stream:stream_driver close status := failure "not a Pliant compressed file" # var Link:CompressStreamDriver drv :> new CompressStreamDriver # drv support :> stream stream_driver # stream stream_driver :> drv
method fs configure filename options command -> status arg_rw CompressFileSystem fs ; arg Str filename options command ; arg ExtendedStatus status status := failure if command="compress" var FileInfo info := file_query filename standard if info=success if (file_copy filename (string "gzip:"+filename+".gz")+" comment "+(string "pliant_clear_size "+(string info:size)) reduced)=success if (file_configure filename+".gz" "datetime "+(string info:datetime))=success file_delete filename status := success eif command="uncompress" var Intn csize := clear_size filename+".gz" if csize<>undefined if (file_copy "gzip:"+filename+".gz" filename reduced)=success if (file_configure filename "datetime "+(string (file_query filename+".gz" standard):datetime))=success file_delete filename+".gz" status := success eif command="delete" or (command option "datetime") status := pliant_default_file_system configure filename options command if status=failure and (clear_size filename+".gz")<>undefined status := pliant_default_file_system configure filename+".gz" options command else status := pliant_default_file_system configure filename options command
gvar CompressFileSystem compress_file_system pliant_multi_file_system mount "compress:" "" "" compress_file_system
|