Patch title: Release 93 bulk changes
Abstract:
File: /language/stream/zlib.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


type CompressZlibStreamDriver
  field Link:Stream s
  field z_stream_s w
  field z_stream_s r
  field Int flags
  if undocumented
    field CBool gzip
    field CBool zip
    field CBool deflate
    field uInt w_crc w_size
    field uInt r_crc r_size
    field Int zip_flags <- 0
    field Str name
    field DateTime datetime
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


type CompressZlibStreamDriver
  field Link:Stream s
  field z_stream_s w
  field z_stream_s r
  field Int flags
  if undocumented
    field CBool gzip
    field CBool zip
    field CBool deflate
    field uInt w_crc w_size
    field uInt r_crc r_size
    field Int zip_flags <- 0
    field Str name
    field DateTime datetime
    field Str comment
StreamDriver maybe CompressZlibStreamDriver



method drv query command stream answer -> status
  oarg_rw CompressZlibStreamDriver drv ; arg Str command ; a
  if command="encoding"
    if undocumented
      answer := shunt drv:gzip "gzip" drv:zip "zip" drv:defl
    else
      answer := "zlib"
    status := success
  eif undocumented and command="name"
    answer := drv name
    status := success
  eif undocumented and command="datetime"
    answer := string drv:datetime
    status := success
StreamDriver maybe CompressZlibStreamDriver



method drv query command stream answer -> status
  oarg_rw CompressZlibStreamDriver drv ; arg Str command ; a
  if command="encoding"
    if undocumented
      answer := shunt drv:gzip "gzip" drv:zip "zip" drv:defl
    else
      answer := "zlib"
    status := success
  eif undocumented and command="name"
    answer := drv name
    status := success
  eif undocumented and command="datetime"
    answer := string drv:datetime
    status := success
  eif undocumented and command="comment"
    answer := drv comment
    status := success
  else
    status := drv:s:stream_driver query command drv:s answer



method fs open name options flags stream support -> status
  oarg_rw CompressZlibFileSystem fs ; arg Str name options ;
  if undocumented
    var CBool gzip := options option "gzip"
    var CBool zip := options option "zip"
    var CBool deflate := gzip or zip or (options option "def
  var Int level := options option "level" Int
  var Link:Stream s
  if exists:support
    s :> support
  else
    var Link:Stream s :> new Stream
    s open name options (flags .and. in+out+append+safe)
    if s=failure
      return failure
  var Link:CompressZlibStreamDriver drv :> new CompressZlibS
  if (flags .and. out)<>0
    if (options option "header" Str)<>""
      s writeline (options option "header" Str)
      s writeline ""
    if undocumented and gzip
  else
    status := drv:s:stream_driver query command drv:s answer



method fs open name options flags stream support -> status
  oarg_rw CompressZlibFileSystem fs ; arg Str name options ;
  if undocumented
    var CBool gzip := options option "gzip"
    var CBool zip := options option "zip"
    var CBool deflate := gzip or zip or (options option "def
  var Int level := options option "level" Int
  var Link:Stream s
  if exists:support
    s :> support
  else
    var Link:Stream s :> new Stream
    s open name options (flags .and. in+out+append+safe)
    if s=failure
      return failure
  var Link:CompressZlibStreamDriver drv :> new CompressZlibS
  if (flags .and. out)<>0
    if (options option "header" Str)<>""
      s writeline (options option "header" Str)
      s writeline ""
    if undocumented and gzip
      var Str comment := options option "comment" Str
      var GzipHeader h
      var GzipHeader h
      h id1 := 1Fh ; h id2 := 8Bh ; h cm := 8 ; h flg := 0 ;
      h id1 := 1Fh ; h id2 := 8Bh ; h cm := 8 ; h flg := shunt comment:len<>0 2^4 0 ; h xfl := 2 ; h os := 255
      s raw_write addressof:h GzipHeader:size
      s raw_write addressof:h GzipHeader:size
      if comment:len<>0
        s writechars comment
        s writechars character:0
      drv w_crc := 0 ; drv w_size := 0
    memory_clear (addressof drv:w) z_stream_s:size
    drv:w data_type := 2
    if pliant_alloc
      drv:w zalloc := (the_function pliant_zalloc Address uI
      drv:w zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (deflateInit2 drv:w (shunt level=defined level -1) 
        return failure
    else
      if (deflateInit drv:w (shunt level=defined level -1))<
        return failure
  if (flags .and. in)<>0
    if (options option "header")
      while s:readline<>""
        void
    if undocumented and gzip
      s raw_read addressof:(var GzipHeader h) GzipHeader:siz
      if h:id1<>1Fh or h:id2<>8Bh
        return failure:"not a gzip stream"
      if h:cm<>8
        return failure:"no at gzip stream"
      if (h:flg .and. 2^2)<>0 # FEXTRA
        s raw_read addressof:(var uInt16_li xlen) 2
        while xlen>=0 and not s:atend
          s read_available (var Address adr) (var Int size) 
          xlen -= size
      if (h:flg .and. 2^3)<>0 # FNAME
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^4)<>0 # COMMENT
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
      drv w_crc := 0 ; drv w_size := 0
    memory_clear (addressof drv:w) z_stream_s:size
    drv:w data_type := 2
    if pliant_alloc
      drv:w zalloc := (the_function pliant_zalloc Address uI
      drv:w zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (deflateInit2 drv:w (shunt level=defined level -1) 
        return failure
    else
      if (deflateInit drv:w (shunt level=defined level -1))<
        return failure
  if (flags .and. in)<>0
    if (options option "header")
      while s:readline<>""
        void
    if undocumented and gzip
      s raw_read addressof:(var GzipHeader h) GzipHeader:siz
      if h:id1<>1Fh or h:id2<>8Bh
        return failure:"not a gzip stream"
      if h:cm<>8
        return failure:"no at gzip stream"
      if (h:flg .and. 2^2)<>0 # FEXTRA
        s raw_read addressof:(var uInt16_li xlen) 2
        while xlen>=0 and not s:atend
          s read_available (var Address adr) (var Int size) 
          xlen -= size
      if (h:flg .and. 2^3)<>0 # FNAME
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
      if (h:flg .and. 2^4)<>0 # COMMENT
        while { s raw_read addressof:(var uInt8 ch) 1 ; ch<>
          void
          drv comment += character ch
      if (h:flg .and. 2^1)<>0 # FHCRC
        s raw_read addressof:(var uInt16 crc16) 2
      drv r_crc := 0 ; drv r_size := 0
    if undocumented and zip
      s raw_read addressof:(var ZipHeader zh) ZipHeader:size
      if zh:signature<>04034B50h
        return failure:"not a zip stream"
      drv zip_flags := zh flags
      if zh:compressed_size=0 and zh:clear_size=0 and (zh:fl
        drv zip_flags += 2^16
      drv:name resize zh:name_length
      drv datetime := datetime 1980+zh:date\2^9 zh:date\2^5%
      s raw_read drv:name:characters zh:name_length
      for (var Int i) 1 zh:extra_length
        s raw_read addressof:(var Byte drop) 1
    memory_clear (addressof drv:r) z_stream_s:size
    drv:r data_type := 2
    if pliant_alloc
      drv:r zalloc := (the_function pliant_zalloc Address uI
      drv:r zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (drv:zip_flags .and. 2^16)=0
        if (inflateInit2 drv:r (shunt deflate -15 15))<>0
          return failure
    else
      if (inflateInit drv:r)<>0
        return failure
  drv s :> s
  drv flags := flags
  if undocumented
    drv gzip := gzip
    drv zip := zip
    drv deflate := deflate
  stream stream_driver :> drv
  status := success


gvar CompressZlibFileSystem compress_zlib_file_system
pliant_multi_file_system mount "zlib:" "" compress_zlib_file
if undocumented
  pliant_multi_file_system mount "deflate:" "" "deflate" com
  pliant_multi_file_system mount "gzip:" "" "gzip" compress_
  pliant_multi_file_system mount "zip:" "" "zip" compress_zl
      if (h:flg .and. 2^1)<>0 # FHCRC
        s raw_read addressof:(var uInt16 crc16) 2
      drv r_crc := 0 ; drv r_size := 0
    if undocumented and zip
      s raw_read addressof:(var ZipHeader zh) ZipHeader:size
      if zh:signature<>04034B50h
        return failure:"not a zip stream"
      drv zip_flags := zh flags
      if zh:compressed_size=0 and zh:clear_size=0 and (zh:fl
        drv zip_flags += 2^16
      drv:name resize zh:name_length
      drv datetime := datetime 1980+zh:date\2^9 zh:date\2^5%
      s raw_read drv:name:characters zh:name_length
      for (var Int i) 1 zh:extra_length
        s raw_read addressof:(var Byte drop) 1
    memory_clear (addressof drv:r) z_stream_s:size
    drv:r data_type := 2
    if pliant_alloc
      drv:r zalloc := (the_function pliant_zalloc Address uI
      drv:r zfree := (the_function pliant_zfree Address Addr
    if undocumented
      if (drv:zip_flags .and. 2^16)=0
        if (inflateInit2 drv:r (shunt deflate -15 15))<>0
          return failure
    else
      if (inflateInit drv:r)<>0
        return failure
  drv s :> s
  drv flags := flags
  if undocumented
    drv gzip := gzip
    drv zip := zip
    drv deflate := deflate
  stream stream_driver :> drv
  status := success


gvar CompressZlibFileSystem compress_zlib_file_system
pliant_multi_file_system mount "zlib:" "" compress_zlib_file
if undocumented
  pliant_multi_file_system mount "deflate:" "" "deflate" com
  pliant_multi_file_system mount "gzip:" "" "gzip" compress_
  pliant_multi_file_system mount "zip:" "" "zip" compress_zl