basis/ftp/client/listing-parser/listing-parser.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators io.files.types kernel math.parser
   4 sequences splitting ;
   5 IN: ftp.client.listing-parser
   6
   7 : ch>file-type ( ch -- type )
   8     {
   9         { CHAR: b [ +block-device+ ] }
  10         { CHAR: c [ +character-device+ ] }
  11         { CHAR: d [ +directory+ ] }
  12         { CHAR: l [ +symbolic-link+ ] }
  13         { CHAR: s [ +socket+ ] }
  14         { CHAR: p [ +fifo+ ] }
  15         { CHAR: - [ +regular-file+ ] }
  16         [ drop +unknown+ ]
  17     } case ;
  18
  19 : file-type>ch ( type -- string )
  20     {
  21         { +block-device+ [ CHAR: b ] }
  22         { +character-device+ [ CHAR: c ] }
  23         { +directory+ [ CHAR: d ] }
  24         { +symbolic-link+ [ CHAR: l ] }
  25         { +socket+ [ CHAR: s ] }
  26         { +fifo+ [ CHAR: p ] }
  27         { +regular-file+ [ CHAR: - ] }
  28         [ drop CHAR: - ]
  29     } case ;
  30
  31 : parse-permissions ( remote-file str -- remote-file )
  32     [ first ch>file-type >>type ] [ rest >>permissions ] bi ;
  33
  34 TUPLE: remote-file
  35 type permissions links owner group size month day time year
  36 name target ;
  37
  38 : <remote-file> ( -- remote-file ) remote-file new ;
  39
  40 : parse-list-11 ( lines -- seq )
  41     [
  42         11 f pad-tail
  43         <remote-file> swap {
  44             [ 0 swap nth parse-permissions ]
  45             [ 1 swap nth string>number >>links ]
  46             [ 2 swap nth >>owner ]
  47             [ 3 swap nth >>group ]
  48             [ 4 swap nth string>number >>size ]
  49             [ 5 swap nth >>month ]
  50             [ 6 swap nth >>day ]
  51             [ 7 swap nth >>time ]
  52             [ 8 swap nth >>name ]
  53             [ 10 swap nth >>target ]
  54         } cleave
  55     ] map ;
  56
  57 : parse-list-8 ( lines -- seq )
  58     [
  59         <remote-file> swap {
  60             [ 0 swap nth parse-permissions ]
  61             [ 1 swap nth string>number >>links ]
  62             [ 2 swap nth >>owner ]
  63             [ 3 swap nth >>size ]
  64             [ 4 swap nth >>month ]
  65             [ 5 swap nth >>day ]
  66             [ 6 swap nth >>time ]
  67             [ 7 swap nth >>name ]
  68         } cleave
  69     ] map ;
  70
  71 : parse-list-3 ( lines -- seq )
  72     [
  73         <remote-file> swap {
  74             [ 0 swap nth parse-permissions ]
  75             [ 1 swap nth string>number >>links ]
  76             [ 2 swap nth >>name ]
  77         } cleave
  78     ] map ;
  79
  80 : parse-list ( ftp-response -- ftp-response )
  81     dup strings>>
  82     [ words harvest ] map
  83     dup length {
  84         { 11 [ parse-list-11 ] }
  85         { 9 [ parse-list-11 ] }
  86         { 8 [ parse-list-8 ] }
  87         { 3 [ parse-list-3 ] }
  88         [ drop ]
  89     } case >>parsed ;