extra/io/encodings/detect/detect.factor

   1 ! Copyright (C) 2010 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: byte-arrays combinators continuations io io.encodings
   4 io.encodings.ascii io.encodings.binary io.encodings.iana
   5 io.encodings.latin1 io.encodings.string io.encodings.utf16
   6 io.encodings.utf32 io.encodings.utf8 io.files kernel literals
   7 math namespaces sequences strings ;
   8 IN: io.encodings.detect
   9
  10 SYMBOL: default-encoding
  11 default-encoding [ latin1 ] initialize
  12
  13 <PRIVATE
  14
  15 : prolog-tag ( bytes -- string )
  16     CHAR: > over index [ 1 + head-slice ] when* >string ;
  17
  18 : prolog-encoding ( string -- iana-encoding )
  19     '[
  20         _ "encoding=" over subseq-start
  21         10 + swap [ [ 1 - ] dip nth ] [ index-from ] [ swapd subseq ] 2tri
  22     ] [ drop "UTF-8" ] recover ;
  23
  24 : detect-xml-prolog ( bytes -- encoding )
  25     prolog-tag prolog-encoding name>encoding [ ascii ] unless* ;
  26
  27 : valid-utf8? ( bytes -- ? )
  28     utf8 decode but-last-slice replacement-char swap member? not ;
  29
  30 PRIVATE>
  31
  32 : detect-byte-array ( bytes -- encoding )
  33     {
  34         { [ dup B{ 0x00 0x00 0xFE 0xFF } head? ] [ drop utf32be ] }
  35         { [ dup B{ 0xFF 0xFE 0x00 0x00 } head? ] [ drop utf32le ] }
  36         { [ dup B{ 0xFE 0xFF } head? ] [ drop utf16be ] }
  37         { [ dup B{ 0xFF 0xFE } head? ] [ drop utf16le ] }
  38         { [ dup B{ 0xEF 0xBB 0xBF } head? ] [ drop utf8 ] }
  39         { [ dup $[ "<?xml" >byte-array ] head? ] [ detect-xml-prolog ] }
  40         { [ 0 over member? ] [ drop binary ] }
  41         { [ dup empty? ] [ drop utf8 ] }
  42         { [ dup valid-utf8? ] [ drop utf8 ] }
  43         [ drop default-encoding get ]
  44     } cond ;
  45
  46 : detect-stream ( stream -- sample encoding )
  47     256 swap stream-read dup detect-byte-array ;
  48
  49 : detect-file ( file -- encoding )
  50     binary [ input-stream get detect-stream nip ] with-file-reader ;