File: dbf\filenames.adb

    1 --::::::::::
    2 --filename.adb
    3 --::::::::::
    4 -- Developed by (C) Wasiliy W. Molostoff 1994, 1995.
    5 --                  Moscow, Russia,
    6 --                  Voice:   7 (095) 398-23-38
    7 --                  e-mail:  edv@edv.msk.ru
    8 -- This is free software; you can  freely  redistribute  it  and/or
    9 -- modify  it  without any restrictions.  Please report any errors.
   10 -- All corrections will be made as soon as possible.
   11 with text_io;
   12 package body filenames is
   13 
   14   type septype is (volume, pathlist, typemark, version, namechar);
   15 
   16   function sep (c: character) return septype is
   17   begin
   18      case c is
   19         when '.'       => return typemark;
   20         when '\' | '/' |
   21              '[' | ']' => return pathlist;
   22         when ':'       => return volume;
   23         when ';'       => return version;
   24         when others    => return namechar;
   25      end case;
   26   end;
   27 
   28   ------------------------------------------------------------------------
   29 
   30   function volumename (name: in string) return string is
   31   begin
   32      for n in name'range
   33      loop
   34          case sep(name (n)) is
   35              when volume   => return name (name'first..n);
   36              when namechar => null;
   37              when others   => exit;
   38          end case;
   39      end loop;
   40      return "";
   41   end;
   42 
   43   ------------------------------------------------------------------------
   44 
   45   function pathname   (name: in string) return string is
   46      p_beg: positive := name'first + volumename (name)'length;
   47      p_end: natural  := 0;
   48   begin
   49      for n in  p_beg..name'last
   50      loop
   51          case sep(name (n)) is
   52              when pathlist  => p_end := n;
   53              when others    => null;
   54          end case;
   55      end loop;
   56 
   57      if p_beg <= p_end
   58      then
   59          return name (p_beg..p_end);
   60      end if;
   61      return "";
   62   end;
   63 
   64   ------------------------------------------------------------------------
   65 
   66   function filename   (name: in string) return string is
   67    f_end: natural := name'last;
   68    f_beg: natural := name'first;
   69   begin
   70      for n in reverse name'range
   71      loop
   72          case sep(name (n)) is
   73              when typemark |
   74                   version  => f_end := n - 1;
   75              when namechar => null;
   76              when others   => f_beg := n + 1;
   77                               exit;
   78          end case;
   79      end loop;
   80      return name (f_beg..f_end);
   81   end;
   82 
   83   ------------------------------------------------------------------------
   84 
   85   function typename   (name: in string) return string is
   86    t_end: natural  := name'last;
   87   begin
   88      for n in reverse name'range
   89      loop
   90          case sep(name (n)) is
   91              when typemark => return name (n..t_end);
   92              when version  => t_end := n - 1;
   93              when namechar => null;
   94              when others   => exit;
   95          end case;
   96      end loop;
   97      return "";
   98   end;
   99 
  100   ------------------------------------------------------------------------
  101 
  102   function fullname   (name: in string) return string is
  103     use text_io;
  104     file: file_type;
  105 
  106     function checked (s: in string) return string is
  107       tmp: string (name'range);
  108     begin
  109       for n in tmp'range
  110       loop
  111           case s(n) is
  112             when '\'    => tmp (n) := '/';
  113             when others => tmp (n) := s(n);
  114           end case;
  115       end loop;
  116       return tmp;
  117     end;
  118 
  119     function name_then_close  (n: string) return string is
  120     begin
  121          close (file); return (n);
  122     end;
  123 
  124   begin
  125     if name'length > 0
  126     then
  127          begin
  128               open (file, name => checked (name), mode => in_file);
  129               return name_then_close (text_io.name (file));
  130          exception
  131               when others => null;
  132          end;
  133 
  134     end if;
  135     return name;
  136   end;
  137 
  138   function existent   (name: in string) return boolean is
  139       use text_io;
  140       file: file_type;
  141 
  142   begin
  143     if name'length > 0
  144     then begin
  145           open (file, name => name, mode => in_file);
  146           close (file); return true;
  147       exception
  148           when others => null;
  149       end;
  150 
  151       begin
  152           open (file, name => name, mode => out_file);
  153           close (file); return true;
  154       exception
  155           when others => null;
  156       end;
  157     end if;
  158     return false;
  159   end;
  160 
  161 end;
  162