/pliant/language/stream/filebase2.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  scope "/pliant/language/stream/" "/pliant/language/" "/pliant/admin/" 
 17  module "ring.pli" 
 18  module "/pliant/language/type/set/index.pli" 
 19   
 20  constant dropit "[0]" 
 21   
 22  function file_list path options flg fs -> fileinfo 
 23    arg Str path options ; arg Int flg ; oarg_rw FileSystem fs ; arg Array:FileInfo fileinfo 
 24    var List files ; var Pointer:Arrow c 
 25    var Int flags := flg .or. (shunt (flg .and. recursive)<>and (flg .and. linkrecursive)=0 extended 0) .or. (shunt (flg .and. nolinks)<>0 extended 0) 
 26    var Int supported_flags := fs list path options flags files 
 27    if (flags .and. recursive+linkrecursive)<>and (supported_flags .and. recursive+linkrecursive)=0 
 28      :> files first 
 29      while c<>null 
 30        check (addressof entry_type:c)=addressof:FileInfo 
 31        var Pointer:FileInfo :> map FileInfo 
 32        if f:is_directory and f:status=success and ( (flags .and. linkrecursive)<>or not f:is_link ) 
 33          fs list f:name options (flags .and. .not. (cast recursive Int)) files 
 34        :> files next c 
 35    var Int nfiles := 0 
 36    var Int ndirs := 0 
 37    :> files first 
 38    while c<>null 
 39      check (addressof entry_type:c)=addressof:FileInfo 
 40      var Pointer:FileInfo :> map FileInfo 
 41      if (flg .and. relative)<>0 
 42        if (f:name path:len)=path 
 43          name := f:name path:len f:name:len 
 44        else 
 45          name := dropit 
 46      if (flg .and. nolinks)<>and f:is_link 
 47        name := dropit 
 48      if (flg .and. level_flags)<standard 
 49        size := undefined 
 50        datetime := undefined 
 51      if (flg .and. level_flags)<extended 
 52        options := "" 
 53      if f:name=dropit 
 54        void   
 55      eif f:is_directory 
 56        ndirs += 1 
 57      else 
 58        nfiles += 1 
 59      :> files next c 
 60    fileinfo size := nfiles + (shunt (flags .and. directories)<>ndirs 0) 
 61    var Int := 0 
 62    if (flags .and. sorted)<>0 
 63      var (Index Str Arrow) index 
 64      :> files first 
 65      while c<>null 
 66        index insert (map FileInfo):name c 
 67        :> files next c 
 68      files := var List empty_list 
 69      var Pointer:Arrow :> index first 
 70      while exists:c 
 71        files append c 
 72        :> index next c 
 73    :> files first 
 74    while c<>null 
 75      check (addressof entry_type:c)=addressof:FileInfo 
 76      var Pointer:FileInfo :> map FileInfo 
 77      if f:name=dropit 
 78        void 
 79      eif f:is_directory 
 80        if (flags .and. directories)<>0 
 81          # f status := defined 
 82          size := undefined 
 83          if (flags .and. level_flags)<standard 
 84            datetime := undefined 
 85          if (flags .and. level_flags)<extended 
 86            options := "" 
 87          fileinfo := f ; += 1 
 88      else 
 89        # f status := defined 
 90        if (flags .and. level_flags)<standard 
 91          size := undefined 
 92          datetime := undefined 
 93        if (flags .and. level_flags)<extended 
 94          options := "" 
 95        fileinfo := f ; += 1 
 96      :> files next c 
 97    check i=fileinfo:size 
 98  (the_function file_list Str Str Int FileSystem -> Array:FileInfo) extra_module :> the_module "/pliant/language/stream/listmode.pli" 
 99   
 100  function file_list path flags -> fileinfo 
 101    arg Str path ; arg Int flags ; arg Array:FileInfo fileinfo 
 102    fileinfo := file_list path "" flags pliant_default_file_system 
 103  (the_function file_list Str Int -> Array:FileInfo) extra_module :> the_module "/pliant/language/stream/listmode.pli" 
 104   
 105   
 106  function file_query filename options flags -> info 
 107    arg Str filename options ; arg Int flags ; arg FileInfo info 
 108    info name := filename 
 109    info size := undefined 
 110    info datetime := undefined 
 111    info options := "" 
 112    info status := pliant_default_file_system query filename options flags info 
 113    if (flags .and. level_flags)<standard 
 114      info size := undefined 
 115      info datetime := undefined 
 116    if (flags .and. level_flags)<extended 
 117      info options := "" 
 118  (the_function file_query Str Str Int -> FileInfo) extra_module :> the_module "/pliant/language/stream/listmode.pli" 
 119   
 120  function file_query filename flags -> info 
 121    arg Str filename ; arg Int flags ; arg FileInfo info 
 122    info := file_query filename "" flags 
 123  (the_function file_query Str Int -> FileInfo) extra_module :> the_module "/pliant/language/stream/listmode.pli" 
 124   
 125   
 126  export file_list file_query