------------------------------------------------------------------------------
-- Built-in Shell Commands                                                  --
--                                                                          --
-- Part of SparForte                                                        --
------------------------------------------------------------------------------
--                                                                          --
--            Copyright (C) 2001-2024 Free Software Foundation              --
--                                                                          --
-- This is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  This is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with this;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- This is maintained at http://www.pegasoft.ca                             --
--                                                                          --
------------------------------------------------------------------------------

with ada.text_io,
     --ada.strings.unbounded.text_io,
     ada.strings.fixed,
     gnat.source_info,
#if POSTGRES
     APQ,
#else
#if MYSQL
     APQ,
#end if;
#end if;
     spar_os,
     pegasoft.strings,
     pegasoft.user_io,
     world.utf8,
     scanner.communications,
     jobs,
     --parser_aux,
     parser_db,
     parser_mysql;
use  ada.text_io,
     ada.strings,
     --ada.strings.unbounded.text_io,
     ada.strings.fixed,
#if POSTGRES
     APQ,
#else
#if MYSQL
     APQ,
#end if;
#end if;
     pegasoft,
     pegasoft.strings,
     jobs,
     pegasoft.user_io,
     --world,
     world.utf8,
     scanner,
     scanner.communications,
     --parser_aux,
     parser_db,
     parser_mysql;

package body builtins is

-----------------------------------------------------------------------------
--  FIND PWD
--
-- Assign the current working directory to the current_working_directory
-- variable.
-- Determine current working directory and assign it to the current_working_
-- directory variable, else assign it a null string.
-- loosely modelled on bash/builtins/cd.def
-- cmd is the command asking for the pwd, or eof_t for the interpreter on
-- startup.
-----------------------------------------------------------------------------

buffer : string( 1..4096 );

procedure findPwd( cmd : identifier := eof_t ) is
begin
  C_reset_errno;
  getcwd( buffer, buffer'length );
  if C_errno = ENOENT then
        if cmd = eof_t then
           err(
               subjectNotes => subjectInterpreter,
               reason => +"cannot read your current directory because",
               obstructorNotes => em("it was deleted"),
               remedy => pl( "use " ) & em( "cd" ) & pl(" to select another known directory " ) &
                         pl( "or use the " ) & em( "OLDPWD" ) & pl( " variable to see what your pwd was" )
           );
        else
           err(
               subject => cmd,
               reason => +"cannot read your current directory because",
               obstructorNotes => em("it was deleted"),
               remedy => pl( "use " ) & em( "cd" ) & pl(" to select another known directory " ) &
                         pl( "or use the " ) & em( "OLDPWD" ) & pl( " variable to see what your pwd was" )
           );
        end if;
  elsif C_errno = EACCES then
        if cmd = eof_t then
            err(
                subjectNotes => subjectInterpreter,
                reason => +"cannot read your current directory because",
                obstructorNotes => em("you don't have or no longer have permission")
            );
        else
            err(
                subject => cmd,
                reason => +"cannot read your current directory because",
                obstructorNotes => em("you don't have or no longer have permission")
            );
        end if;
  elsif C_errno /= 0 then
     -- other possibilities are out of range, too long, etc.
     err(
         contextNotes => pl( "At " & gnat.source_info.source_location &
            " while finding the current working directory" ),
         subjectNotes => subjectInterpreter,
         reason => +"had an internal error because syscall getcwd() returned",
         obstructorNotes => getEmOSError
     );
     current_working_directory := null_unbounded_string;
  end if;
  current_working_directory := to_unbounded_string(
     buffer( 1..index( buffer, ASCII.NUL & "" ) - 1 ) ) ;
end findPwd;


-----------------------------------------------------------------------------
--  BIND PWD
--
-- Assign the current working directory to the current_working_directory
-- variable.
-- loosely modelled on bash/builtins/cd.def
-----------------------------------------------------------------------------

procedure bindPwd( cmd : identifier ) is
-- procedure bindPwd( cmd : identifier; symlinks : boolean := false ) is
begin
  findPwd( cmd );
  if current_working_directory /= null_unbounded_string then
     -- SYMBOLIC LINKS TO BE HANDLED HERE LATER
     --findIdent( to_unbounded_string( "PWD" ), pwd );
     --findIdent( to_unbounded_string( "OLDPWD" ), oldpwd );
     --if identifiers( pwd ).kind = string_t then
     --   if identifiers( oldpwd ).kind = string_t then
     --      identifiers( oldpwd ).value := identifiers( pwd ).value;
     --   end if;
     --   identifiers( pwd ).value := current_working_directory;
     --end if;
     null;
  end if;
end bindPwd;


-----------------------------------------------------------------------------
--  OLD_PWD
--
-- Old version of the builtin pwd command used in previous versions of Bush.
-- Syntax: old_pwd
-- loosely modelled on bash/builtins/cd.def
-----------------------------------------------------------------------------

function old_pwd return unbounded_string is
-- pwd: present working directory
begin
   bindPwd( pwd_t );
   return current_working_directory;
end old_pwd;


-----------------------------------------------------------------------------
--  OLD_CD
--
-- Old version of the builtin cd command used in previous versions of Bush.
-- Syntax: old_cd s
-- loosely modelled on bash/builtins/cd.def
-----------------------------------------------------------------------------

procedure old_cd( s : unbounded_string ) is

  -- APPLY CHANGE
  --
  -- Change the directory and, if successful, update related environment
  -- variables.  Return true if change was successful.  Does not capture
  -- errno value.
  ----------------------------------------------------------------------------

  function apply_change( s : unbounded_string ) return boolean is
    pwd, oldpwd : identifier;
    result : integer;
  begin
    result := chdir( to_string( s ) & ASCII.NUL );
    if result = 0 then
       bindPwd( cd_t );
       -- it should also not take into account the nesting (should be global)
       findIdent( to_unbounded_string( "PWD" ), pwd );
       findIdent( to_unbounded_string( "OLDPWD" ), oldpwd );
       if pwd /= eof_t then
          if oldpwd /= eof_t then
             identifiers( oldpwd ).value.all := identifiers( pwd ).value.all;
          end if;
          identifiers( pwd ).value.all := current_working_directory;
       end if;
    end if;
    return result = 0;
  end apply_change;

  path : unbounded_string := s;
  newpath : unbounded_string;
  showPath : boolean := false;
  temp_id : identifier;
  obstructorStr : unbounded_string;
  remedySuggestion : messageStrings := nullMessageStrings;
  errno : integer := 0;

begin
  if length( path ) = 0 then                              -- no path?
     path := to_unbounded_string( "$HOME" );              -- then go home
  -- Normally, tilde is substituted in a shell word expansion.
  -- However, we may end up here if AdaScript parameters are used.
  elsif Element( path, 1 ) = '~' then                     -- leading tilde?
     Delete( path, 1, 1 );                                -- shortform for
     Insert( path, 1, "$HOME" );                          -- home
  elsif path = "-" then                                   -- minus path?
     path := to_unbounded_string( "$OLDPWD" );            -- short for OLDPWD
     showPath := inputMode = interactive or inputMode = breakout;
  end if;
  if head( path, 5 ) = "$HOME" then
     findIdent( to_unbounded_string( "HOME" ), temp_id );
     Delete( path, 1, 5 );
     Insert( path, 1, to_string( identifiers( temp_id ).value.all ) );
  elsif head( path, 7 ) = "$OLDPWD" then
     findIdent( to_unbounded_string( "OLDPWD" ), temp_id );
     Delete( path, 1, 7 );
     Insert( path, 1, to_string( identifiers( temp_id ).value.all ) );
  end if;

  -- CDPATH support not yet implmeneted.  Should go HERE, but
  -- is CDPATH such a good idea anyway?  Not usually!

  -- Apply the directory change.  If we're in an interactive mode, attempt
  -- solutions to common problems.  Ignore an error on these solutions
  -- and only show original error if the solutions do not help.

  -- TODO: if not assumed, an effective solution should be in the error
  -- message remedy

  if not apply_change( path ) then
     errno := c_errno;                                   -- save original error

     -- user chose a file rather than a directory

     if c_errno = ENOTDIR then                           -- not a directory?
        newpath := dirname( path );                   -- try parent directory
        if newpath /= "." then                        -- unless it's current
           if inputMode = interactive or inputMode = breakout then
              if apply_change( newpath ) then
                 errno := c_errno;                       -- should be no error
                 put_trace( "Assuming directory " & to_string( toCtrlEscaped( newpath ) ) );
              end if;
           else
              remedySuggestion := +"select the parent directory of the file";
           end if;
        end if;
     end if;

     -- user has a path with leading or trailing spaces
     -- this only checks the path as a whole, not the individual items

     if c_errno = ENOENT then                         -- no such path?
        newpath := trim( path, both );                 -- try trimming space
        if newpath /= path then                        -- unless no difference
           if inputMode = interactive or inputMode = breakout then
              if apply_change( newpath ) then
                 errno := c_errno;                       -- should be no error
                 put_trace( "Assuming leading or trailing spaces should be trimmed" );
              end if;
           else
              remedySuggestion := +"trim leading or trailing spaces";
           end if;
        end if;
     end if;

     -- user has wrong directory delimiter

     if c_errno = ENOENT then
        if index( path, "\" ) > 0 and directory_delimiter = '/' then
           newpath := replaceAll( path, to_unbounded_string( "\" ),
               to_unbounded_string( "/" ), false );
           if inputMode = interactive or inputMode = breakout then
              if apply_change( newpath ) then
                 errno := c_errno;                       -- should be no error
                 put_trace( "Assuming directory delimiter should be a forward slash" );
              end if;
           else
              remedySuggestion := +"directory delimiter is a forward slash";
           end if;
        end if;
     end if;
     if c_errno = ENOENT then
        if index( path, "/" ) > 0 and directory_delimiter = '\' then
           newpath := replaceAll( path, to_unbounded_string( "/" ),
              to_unbounded_string( "\" ), false );
           if inputMode = interactive or inputMode = breakout then
              if apply_change( newpath ) then
                 errno := c_errno;                       -- should be no error
                 put_trace( "Assuming directory delimiter should be a backslash" );
              end if;
           else
              remedySuggestion := +"directory delimiter is a backslash";
           end if;
        end if;
     end if;
  end if;

  if errno /= 0 then
     -- better messages for common cd use cases
     if errno = ENOENT then
        obstructorStr := to_unbounded_string( "the directory does not exist" );
     elsif errno = ENOTDIR then
        obstructorStr := to_unbounded_string( "it is not a directory" );
     elsif errno = EACCES or c_errno = EFAULT then
        obstructorStr := to_unbounded_string( "it is not accessible" );
     else
        obstructorStr := to_unbounded_string( "syscall chdir returned " & OSerror( c_errno ) );
     end if;
     err(
         contextNotes => pl( "in " )  & unb_pl( current_working_directory ),
         subjectNotes => em_value( path ),
         reason => +"could not be selected because",
         obstructorNotes => unb_em( obstructorStr ),
         remedy => remedySuggestion
     );
  end if;
  if showPath then
     put_line_retry( current_working_directory );
  end if;
end old_cd;


-----------------------------------------------------------------------------
--  ALTER (SQL COMMAND)
--
-- alter : SQL alter - change database configuration
-- Syntax: alter shell_word
-----------------------------------------------------------------------------

procedure alter( ap : argumentListPtr ) is
-- alter : SQL alter
  tempStr : unbounded_string;
begin
  if ap'length /= 1 then
     err(
         contextNotes => contextInSQL,
         subjectNotes => em( "alter" ),
         reason => +"expects arguments but",
         obstructorNotes => em( "there are no arguments" ),
         seeAlso => +"doc/ref_db.html"
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if not engineOpen then
         err(
             contextNotes => contextInSQL,
             subjectNotes => em( "alter" ),
             reason => +"needs a database connection but",
             obstructorNotes => em( "no connection is open" ),
             remedy => +"open a connection with the mysql or db package"
         );
     elsif currentEngine = Engine_PostgreSQL then
#if POSTGRES
        DoSQLStatement( "alter " & tempStr );
#else
        err( +"postgresql support not configured" );
#end if;
     elsif currentEngine = Engine_MySQL then
#if MYSQL
        DoMySQLSQLStatement( "alter " & tempStr );
#else
        err( +"mysql support not configured" );
#end if;
     else
        err(
            contextNotes => pl( "At " & gnat.source_info.source_location &
               " in the SQL statement" ),
            subjectNotes => subjectInterpreter,
            reason => +"had an internal error because it did not expect",
            obstructorNotes => pl( "database engine " & currentEngine'img )
        );
     end if;
  end if;
end alter;


-----------------------------------------------------------------------------
--  CLEAR (POSIX SHELL COMMAND)
--
-- clear : clear the screen / reset the terminal screen
-- Syntax: clear
-----------------------------------------------------------------------------

procedure clear( ap : argumentListPtr ) is
  term_id : identifier;
begin
  if ap'length /= 0 then
     err(
         contextNotes => contextInCommand,
         subject => clear_t,
         reason => +"expects no arguments but",
         -- the problem here is is/are for 1+ arguments if the length is used
         obstructorNotes => em( "there are arguments" ),
         seeAlso => seeShellCmds
     );
  elsif isExecutingCommand then
     findIdent( to_unbounded_string( "TERM" ), term_id );
     terminalClear( identifiers( term_id ).value.all );
  end if;
end clear;


-----------------------------------------------------------------------------
--  UMASK (POSIX SHELL COMMAND)
--
-- umask : set the umask
-- Syntax: umask
-----------------------------------------------------------------------------

procedure umask( ap : argumentListPtr ) is
  tempStr  : unbounded_string;
  newMask  : mode_t;
  oldMask  : mode_t;
  discard  : mode_t;
  remedySuggestion : unbounded_string;
begin
  expectNonRestrictedShell( "umask" );
  if ap'length > 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "umask" ),
         reason => +"expects zero or one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => +"read the summary of umask with in help command",
         seeAlso => seeShellCmds
     );
  elsif ap'length = 0 then
     if isExecutingCommand then
        -- umask never fails
        oldMask := spar_os.umask( 0 );
        discard := spar_os.umask( oldMask );
        put_line_retry( oldMask'img );
        -- TODO: we cannot guarantee that put_line will handle redirection
        -- properly.
     end if;
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     begin
        newMask := mode_t'value( to_string( tempStr ) );

        -- At the command prompt, give help for suspicious illegal values,
        -- This list is some common values and is not exhaustive.

        if newMask = 777 then
           remedySuggestion := to_unbounded_string( "you mean decimaal 0" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 0;
           end if;
        elsif newMask = 775 then
           remedySuggestion := to_unbounded_string( "you mean octal 3 / decimaal 3" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 3;
           end if;
        elsif newMask = 755 then
           remedySuggestion := to_unbounded_string( "you mean octal 22 / decimaal 18" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 18;
           end if;
        elsif newMask = 700 then
           remedySuggestion := to_unbounded_string( "you mean octal 77 / decimaal 63" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 63;
           end if;
        elsif newMask = 644 then
           remedySuggestion := to_unbounded_string( "you mean octal 133 / decimaal 91" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 91;
           end if;
        elsif newMask = 600 then
           remedySuggestion := to_unbounded_string( "you mean octal 177 / decimaal 127" );
           if inputMode = interactive or inputMode = breakout then
              put_trace( "Assuming " & to_string( remedySuggestion ) );
              newMask := 127;
           end if;
        end if;

        -- At least in Linux,the umask can only be the file
        -- permission bits (0777 = 511).

        if newMask > 511 then
           err(
               contextNotes => +"in the " & em( "umask" ) & pl( " command" ),
               subjectNotes => +"the decimal " & em( "mask value " ) &
                  em_value( tempStr ),
               reason => +"is not in the range of",
               obstructorNotes => em( "0..511" ),
               remedy => unb_pl( remedySuggestion ),
               seeAlso => seeShellCmds
           );
           -- err( +"value should be in range 0..511" );
        else
           -- umask never fails
           discard := spar_os.umask( newMask );
        end if;
     exception when constraint_error =>
           err(
               contextNotes => +"in the " & em( "umask" ) & pl( " command" ),
               subjectNotes => +"the decimal " & em( "mask value" ),
               reason => +"was expected to be numeric but is",
               obstructorNotes => em_value( tempStr ),
               seeAlso => seeShellCmds
           );
     when others =>
        err_exception_raised;
     end;
  end if;
end umask;


-----------------------------------------------------------------------------
--  DELETE (SQL COMMAND)
--
-- delete : SQL delete
-- Syntax: delete shell_word
-----------------------------------------------------------------------------

procedure delete( ap : argumentListPtr ) is
  tempStr : unbounded_string;
begin
  if ap'length /= 1 then
     err(
         contextNotes => contextInSQL,
         subjectNotes => em( "delete" ),
         reason => +"expects arguments but",
         obstructorNotes => em( "there are no arguments" ),
         seeAlso => +"doc/ref_db.html"
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if not engineOpen then
         err(
             contextNotes => contextInSQL,
             subjectNotes => em( "delete" ),
             reason => +"needs a database connection but",
             obstructorNotes => em( "no connection is open" ),
             remedy => +"open a connection with the mysql or db package"
         );
     elsif currentEngine = Engine_PostgreSQL then
#if POSTGRES
        DoSQLStatement( "delete " & tempStr );
#else
        err( +"postgres support not configured" );
#end if;
     elsif currentEngine = Engine_MySQL then
#if MYSQL
        DoMySQLSQLStatement( "delete " & tempStr );
#else
        err( +"mysql support not configured" );
#end if;
     else
        err(
            contextNotes => pl( "At " & gnat.source_info.source_location &
               " while " ) & contextInSQL,
            subjectNotes => subjectInterpreter,
            reason => +"had an internal error because it did not expect",
            obstructorNotes => pl( "database engine " & currentEngine'img )
        );
     end if;
  end if;
end delete;


-----------------------------------------------------------------------------
--  DO HISTORY (POSIX SHELL COMMAND)
--
-- history: shell history control
-- history [-c | n]
-----------------------------------------------------------------------------

procedure do_history( ap : argumentListPtr ) is
  i            : integer;
  historyMax   : natural := 0;
  historyFirst : natural := 0;
  showHistory  : boolean := false;
  tempStr      : unbounded_string;
begin
  if ap'length = 0 then
     null;
  elsif ap'length /= 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "history" ),
         reason => +"expects zero or one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => +"read the summary of history in the help command",
         seeAlso => +"doc/ref_shellcmds.html"
     );
     return;
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if tempStr = "-c" then
        clearHistory;
        return;
     end if;
     historyMax := natural( to_numeric( tempStr ) );
     if historyMax > historyArray'last then
        historyMax := historyArray'last;
     end if;
  end if;

  -- If the user has requested a maximum number of lines (historyMax),
  -- then calculate the first line (historyFirst) to be shown.  If all
  -- should be shown, turn on showHistory flag immediately.

  if historyMax /= 0 then
     if historyNext - historyMax < 1 then
        historyFirst := historyArray'last - historyMax + historyNext;
     else
        historyFirst := historyNext- historyMax;
     end if;
  end if;
  showHistory := historyFirst = 0 or historyFirst = historyNext;

  -- Determine the starting point in the history array.  The history
  -- array wraps around to the first element when it has been filled.

  if historyNext = historyArray'last then
     i := 1;
  else
     i := historyNext + 1;
  end if;

  -- Walk the history array and show the contents.  Wrap around when the
  -- end of array is reached.

  loop
    if i = historyArray'last then
       i := 1;
    end if;
    exit when i = historyNext;
    if historyFirst = i then
       showHistory := true;
    end if;
    if length( history( i ).line ) > 0 then
       if showHistory then
          put_retry( i'img );
          put_retry( ": " );
          put_retry( getDateString( history( i ).time ) );
          put_retry( " " & utf_verticalLine & " " );
          put_retry( history( i ).pwd );
          put_retry( " " & utf_verticalLine & " " );
          put_line_retry( history( i ).line );
       end if;
    end if;
    i := i + 1;
  end loop;
end do_history;


-----------------------------------------------------------------------------
--  INSERT (SQL COMMAND)
--
-- insert: SQL insert - add a row to a database table
-- Syntax: insert shell_word
-----------------------------------------------------------------------------

procedure insert( ap : argumentListPtr ) is
  tempStr : unbounded_string;
begin
  if ap'length /= 1 then
     err(
         contextNotes => contextInSQL,
         subjectNotes => em( "insert" ),
         reason => +"expects arguments but",
         obstructorNotes => em( "there are no arguments" ),
         seeAlso => +"doc/ref_db.html"
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if not engineOpen then
         err(
             contextNotes => contextInSQL,
             subjectNotes => em( "insert" ),
             reason => +"needs a database connection but",
             obstructorNotes => em( "no connection is open" ),
             remedy => +"open a connection with the mysql or db package"
         );
     elsif currentEngine = Engine_PostgreSQL then
#if POSTGRES
        DoSQLStatement( "insert " & tempStr );
#else
        err( +"postgres support not configured" );
#end if;
     elsif currentEngine = Engine_MySQL then
#if MYSQL
        DoMySQLSQLStatement( "insert " & tempStr );
#else
        err( +"mysql support not configured" );
#end if;
     else
        err(
            contextNotes => pl( "At " & gnat.source_info.source_location &
               " while " ) & contextInSQL,
            subjectNotes => subjectInterpreter,
            reason => +"had an internal error because it did not expect",
            obstructorNotes => pl( "database engine " & currentEngine'img )
        );
     end if;
  end if;
end insert;


-----------------------------------------------------------------------------
--  CD (POSIX SHELL COMMAND)
--
-- cd: change current directory
-- Syntax: cd - | shell_word
-----------------------------------------------------------------------------

procedure cd( ap : argumentListPtr ) is
  tempStr : unbounded_string;
begin
  expectNonRestrictedShell( "cd -|dirname" );
  if ap'length /= 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "cd" ),
         reason => +"expects one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => pl( "use " & '"' & "cd ~" & '"' & " to return to your home directory" ),
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     old_cd( tempStr );
  end if;
end cd;


-----------------------------------------------------------------------------
--  JOBS (POSIX SHELL COMMAND)
--
-- jobs: show a list of running background jobs
-- Syntax: jobs
-----------------------------------------------------------------------------

procedure jobs( ap : argumentListPtr ) is
-- jobs: list running jobs
begin
  if ap'length /= 0 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "jobs" ),
         reason => +"expects no arguments but",
         -- the problem here is is/are for 1+ arguments if the length is used
         obstructorNotes => em( "there are arguments" ),
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif isExecutingCommand then
     putJobList;
  end if;
end jobs;


-----------------------------------------------------------------------------
--  PWD (POSIX SHELL COMMAND)
--
-- pwd: show the present (current) working directory
-- Syntax: pwd
-----------------------------------------------------------------------------

procedure pwd( ap : argumentListPtr ) is
-- pwd: present working directory (also updated current_working_directory)
begin
  if ap'length /= 0 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "pwd" ),
         reason => +"expects no arguments but",
         -- the problem here is is/are for 1+ arguments if the length is used
         obstructorNotes => em( "there are arguments" ),
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif isExecutingCommand then
     -- Old PWD is a function call.
     put_line_retry( old_pwd );
  end if;
end pwd;

-----------------------------------------------------------------------------
--  SELECT (SQL COMMAND)
--
-- select: SQL select - display rows from database tables
-- Syntax: select shell_word
-----------------------------------------------------------------------------

procedure SQLselect( ap : argumentListPtr ) is
-- SQL select: SQL select statement
  tempStr : unbounded_string;
begin
-- put_line( "length = " & ap'length'img ); -- DEBUG
-- if ap'length > 0 then
   -- put_line( "param = " & ap( 1 ).all );
-- end if;
  if ap'length /= 1 then
     err(
         contextNotes => +"in the SQL statement",
         subjectNotes => em( "select" ),
         reason => +"expects arguments but",
         obstructorNotes => em( "there are no arguments" ),
         seeAlso => +"doc/ref_db.html"
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if not engineOpen then
         err(
             contextNotes => contextInSQL,
             subjectNotes => em( "select" ),
             reason => +"needs a database connection but",
             obstructorNotes => em( "no connection is open" ),
             remedy => +"open a connection with the mysql or db package"
         );
     elsif currentEngine = Engine_PostgreSQL then
#if POSTGRES
        DoSQLSelect( "select " & tempStr );
#else
        err( +"postgresql support not supported" );
#end if;
     elsif currentEngine = Engine_MySQL then
#if MYSQL
        DoMySQLSQLSelect( "select " & tempStr );
#else
        err( +"mysql support not supported" );
#end if;
     else
        err(
            contextNotes => pl( "At " & gnat.source_info.source_location &
               " while " ) & contextInSQL,
            subjectNotes => subjectInterpreter,
            reason => +"had an internal error because it did not expect",
            obstructorNotes => pl( "database engine " & currentEngine'img )
        );
     end if;
  end if;
end SQLselect;


-----------------------------------------------------------------------------
--  STEP (SparForte BUILTIN)
--
-- step: in breakout mode, run the next line and show a command prompt
-- Syntax: step
-----------------------------------------------------------------------------
-- See also ParseStep in parser.

procedure step( ap : argumentListPtr ) is
begin
  if ap'length /= 0 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "step" ),
         reason => +"expects no arguments but",
         -- the problem here is is/are for 1+ arguments if the length is used
         obstructorNotes => em( "there are arguments" ),
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif inputMode /= breakout then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "step" ),
         reason => +"can only be used when you",
         obstructorNotes => em( "break out of a script" ),
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif isExecutingCommand then
     done := true;
     breakoutContinue := true;
     stepFlag1 := true;
     put_trace( "stepping" );
  end if;
end step;


-----------------------------------------------------------------------------
--  DO TRACE (SparForte BUILTIN)
--
-- trace: turn source line tracing on or off, or show the current setting
-- Syntax: trace [true | false ]
-----------------------------------------------------------------------------

procedure do_trace( ap : argumentListPtr ) is
  tempStr : unbounded_string;
begin
  if ap'length = 0 then
     if isExecutingCommand then
        if trace then
           put_line_retry( "Trace is currently on" );
        else
           put_line_retry( "Trace is currently off" );
        end if;
     end if;
  elsif ap'length > 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "trace" ),
         reason => +"expects zero or one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => +"read the summary of trace in the help command",
         seeAlso => +"doc/ref_shellcmds.html"
     );
  elsif isExecutingCommand then -- or syntax_check then -- when debugging
     -- true (boolean) will be a value of 1, but true (shell word) will be
     -- "true".  This is not ideal since it should really check types.
     tempStr := to_unbounded_string( ap( 1 ).all );
     if ( tempStr = "true" & ASCII.NUL ) or ( tempStr = "1" & ASCII.NUL ) then
        -- For security, don't trace in a production environment
        -- unless running in breakout input mode.  This is because
        -- tracing can reveal confidential information in variables.
        -- (Tracing can still be invoked via the command options.)
        -- It's also not allow in testing mode because it will catch
        -- it in continuous integration before going to production.
        -- GCC Ada 7.4 gives a conversion warning but is incorrect.
        if inputMode /= breakout and boolean(maintenanceOpt or testOpt) then
           err(
             contextNotes => contextInCommand,
             subjectNotes => em( "trace" ),
             reason => +"cannot be changed in testing or maintenance phase mode unless at",
             obstructorNotes => em( "a breakout prompt" ),
             seeAlso => +"doc/ref_shellcmds.html"
           );
        else
           trace := true;
           put_line_retry( "Trace is on" );
        end if;
     elsif ( tempStr = "false" & ASCII.NUL ) or ( tempStr = "0" & ASCII.NUL ) then
        trace := false;
        put_line_retry( "Trace is off" );
     else
        err(
            contextNotes => contextInCommand,
            subjectNotes => em( "trace" ),
            reason => +"expected a boolean value not",
            obstructorNotes => em_value( delete( tempStr, length( tempStr ), length( tempStr ) ) ),
            seeAlso => seeShellCmds
        );
     end if;
  end if;
end do_trace;


-----------------------------------------------------------------------------
--  UNSET (POSIX SHELL COMMAND)
--
-- unset: remove an identifier from the symbol table
-- Syntax: unset identifier
-- Note: this uses a word, not an identifier token as in older versions of
-- SparForte.  If SparForte becomes more complex, this may need to be redesigned.
-----------------------------------------------------------------------------

procedure unset( ap : argumentListPtr ) is
  tempStr : unbounded_string;
  identToUnset : identifier;
begin
  expectNonRestrictedShell( "unset" );
  if ap'length /= 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "unset" ),
         reason => +"expects one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => +"read the summary of unset in the help command",
         seeAlso => seeShellCmds
     );
  elsif inputMode /= interactive and inputMode /= breakout then
      err(
          contextNotes => contextInCommand,
          subjectNotes => em( "unset" ),
          reason => +"must be used at an interactive or breakout prompt not",
          obstructorNotes => +"a script file",
          seeAlso => seeShellCmds
      );
  -- this does not work under ada 95 because it assumes a text string
  -- parameter.  can it be modified?
  elsif onlyAda95 then
      err(
          contextNotes => contextInCommand,
          subjectNotes => em( "unset" ),
          reason => +"does not work with",
          obstructorNotes => em( "pragma ada_95" ),
          seeAlso => seeShellCmds
      );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     findIdent( tempStr, identToUnset );
     if identToUnset = eof_t then
        -- it is possible a mistaken variable substitution could reveal data
        err(
            contextNotes => +"in " & em( "unset" ),
            subjectNotes => em_value( tempStr ),
            reason => +"is",
            obstructorNotes => em( "not declared" )
        );
     -- While unsetting these should not be allowed in a restricted shell,
     -- the whole command will not run in a restricted shell.  But we should
     -- deny unsetting these at all times so as not to permit confusion.
     elsif identifiers( identToUnset ).name = "PATH" or
           identifiers( identToUnset ).name = "HOME" or
           identifiers( identToUnset ).name = "PWD" or
           identifiers( identToUnset ).name = "OLDPWD" or
           identifiers( identToUnset ).name = "TERM" then
        err(
            contextNotes => +"in " & em( "unset" ),
            subjectNotes => em_value( identifiers( identToUnset ).name ),
            reason => +"may not be deleted",
            obstructorNotes => nullMessageStrings,
            remedy => pl( "deleting a standard variable may cause confusion or " &
                          "commands to run abnormally" ),
            seeAlso => seeShellCmds
        );
     elsif identifiers( identToUnset ).renamed_count > 0 then
        err_renaming( identToUnset );
     elsif isExecutingCommand then
        -- record? delete any fields first (notice not recursive)
        if identifiers( identToUnset ).kind = root_record_t then
           for i in keywords_top..identifiers_top - 1 loop
               if identifiers( i ).field_of = identToUnset and not identifiers( i ).deleted then
                if not deleteIdent( i ) then
                   err(
                       contextNotes => +"in " & em( "unset" ),
                       subjectNotes => em_value( identifiers( i ).name ),
                       reason => +"had an internal error because",
                       obstructorNotes => +"it cound not be deleted"
                    );
                  end if;
               end if;
           end loop;
        -- single dimensional array.  Free dynamic memory. (notice not recursive)
        -- Removed 11/03/25 - this already done by  delete ident
        --elsif identifiers( identToUnset ).list then
        --   clearArray( arrayID( to_numeric( identifiers( identToUnset ).value ) ) );
        end if;
        if not deleteIdent( identToUnset ) then
           err(
               contextNotes => +"in " & em( "unset" ),
               subject => identToUnset,
               reason => +"had an internal error because",
               obstructorNotes => +"it cound not be deleted"
            );
        end if;
     end if;
  end if;
end unset;


-----------------------------------------------------------------------------
--  ENV (POSIX SHELL COMMAND)
--
-- env: show the attributes of one/all identifier(s) from the symbol table
-- Syntax: env [identifier]
-- Note: this uses a word, not an identifier token as in older versions of
-- SparForte.  If SparForte becomes more complex, this may need to be redesigned.
-----------------------------------------------------------------------------

procedure env( ap : argumentListPtr ) is
  tempStr : unbounded_string;
  identToShow : identifier;
begin
  expectNonRestrictedShell( "env" );
  if  ap'length > 1 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "env" ),
         reason => +"expects zero or one arguments but",
         obstructorNotes => em( "there are" & ap'length'img & " arguments" ),
         remedy => +"read the summary of env in the help command",
         seeAlso => seeShellCmds
     );
  -- elsif inputMode /= interactive and inputMode /= breakout then
  --    err( +"env is only allowed in an interactive session" );
  elsif isExecutingCommand then
     if ap'length = 0 then
        put_all_identifiers;
     else
        tempStr := to_unbounded_string( ap( 1 ).all );
        if length( tempStr ) <= 1 then
            err(
               contextNotes => pl( "At " & gnat.source_info.source_location &
                  " in the shell command" ),
               subjectNotes => subjectInterpreter,
               reason => +"had an internal error because it cannot search for",
               obstructorNotes => pl( "an empty identifier" )
           );
        else
           -- remove ASCII.NUL from C string
           delete( tempStr, length( tempStr ), length( tempStr ) );
           findIdent( tempStr, identToShow );
           if identToShow = eof_t then
              -- it is possible a mistaken variable substitution could reveal data
              err(
                 contextNotes => +"in the " & em( "env" ) & pl( " command" ),
                 subjectNotes =>  pl( "identifier " ) & em_value( tempStr ),
                 reason => +"is",
                 obstructorNotes => em( "not declared" )
              );
           -- commented out: env does not run at all in a restricted shell
           -- elsif boolean(rshOpt) and then identifiers( identToShow ).name =  "PATH" then
           --    expectNonRestrictedShell( "env PATH" );
           --   -- err( pl( "env PATH is not allowed in a " ) &
           --    --  em( "restricted shell" ) );
           -- elsif boolean(rshOpt) and then identifiers( identToShow ).name = "HOME" then
           --    err( pl( "env HOME is not allowed in a " ) &
           --       em( "restricted shell" ) );
           -- elsif boolean(rshOpt) and then identifiers( identToShow ).name = "PWD" then
           --    err( pl( "env PWD is not allowed in a " ) &
           --      em( "restricted shell" ) );
           -- elsif boolean(rshOpt) and then identifiers( identToShow ).name = "OLDPWD" then
           --    err( pl( "env OLDPWD is not allowed in a " ) &
           --      em( "restricted shell" ) );
           elsif isExecutingCommand then
              Put_Identifier( identToShow );
           end if;
        end if;
     end if;
  end if;
exception
   -- DEVICE ERROR is typically a broken pipe... e.g. env | head . If it
   -- occurs, just stop outputing and exit.
   when DEVICE_ERROR => null;
end env;


-----------------------------------------------------------------------------
--  UPDATE (SQL COMMAND)
--
-- update: SQL update - update rows in a database table
-- Syntax: update shell_word
-----------------------------------------------------------------------------

procedure update( ap : argumentListPtr ) is
  tempStr : unbounded_string;
begin
  if ap'length /= 1 then
     err(
         contextNotes => contextInSQL,
         subjectNotes => em( "update" ),
         reason => +"expects arguments but",
         obstructorNotes => em( "there are no arguments" ),
         seeAlso => seeDB
     );
  elsif isExecutingCommand then
     tempStr := to_unbounded_string( ap( 1 ).all );
     delete( tempStr, length( tempStr ), length( tempStr ) );
     if not engineOpen then
         err(
             contextNotes => contextInSQL,
             subjectNotes => em( "update" ),
             reason => +"needs a database connection but",
             obstructorNotes => em( "no connection is open" ),
             remedy => +"open a connection with the mysql or db package"
         );
     elsif currentEngine = Engine_PostgreSQL then
#if POSTGRES
        DoSQLStatement( "update " & tempStr );
#else
        err( +"postgresql support not supported" );
#end if;
     elsif currentEngine = Engine_MySQL then
#if MYSQL
        DoMySQLSQLStatement( "update " & tempStr );
#else
        err( +"mysql support not supported" );
#end if;
     else
        err(
            contextNotes => pl( "At " & gnat.source_info.source_location &
               " in the SQL statement" ),
            subjectNotes => subjectInterpreter,
            reason => +"had an internal error because it did not expect",
            obstructorNotes => pl( "database engine " & currentEngine'img )
        );
     end if;
  end if;
end update;


-----------------------------------------------------------------------------
--  WAIT (POSIX SHELL COMMAND)
--
-- wait: wait for all background jobs to finish running
-- Syntax: wait
-----------------------------------------------------------------------------

procedure wait( ap : argumentListPtr ) is
begin
  if ap'length /= 0 then
     err(
         contextNotes => contextInCommand,
         subjectNotes => em( "wait" ),
         reason => +"expects no arguments but",
         -- the problem here is is/are for 1+ arguments if the length is used
         obstructorNotes => em( "there are arguments" ),
         seeAlso => seeShellCmds
     );
  elsif isExecutingCommand then
     wait4children;
  end if;
end wait;


-----------------------------------------------------------------------------
--  VM (SparForte BUILTIN)
--
-- vm: show the interal state of the virtual machine
-- (Not yet implemented)
-- Syntax: vm nr n | sr n | ir n
-----------------------------------------------------------------------------

procedure vm( regtype, regnum : unbounded_string ) is
--  r : aVMRegister;
begin
   err( +"not yet written" );
--  if to_string( regtype ) = "nr" then
--     r := aVMRegister'value( " " & to_string( regnum ) );
--     put( "numeric register " & r'img & " = " );
--     put_line( VMNR( aVMNRNumber( r ) ) );
--  elsif to_string( regtype ) = "sr" then
--     put( "string register " & r'img & " = " );
--     r := aVMRegister'value( " " & to_string( regnum ) );
--     put_line( VMSR( aVMSRNumber( r ) ) );
--  elsif to_string( regtype ) = "ir" then
--     put( "index register " & r'img & " = " );
--     r := aVMRegister'value( " " & to_string( regnum ) );
--     put_line( VMIR( aVMIRNumber( r ) )'img );
--     Put_Identifier( VMIR( aVMIRNumber( r ) ) );
--  else
--     put_line( "usage: vm nr|sr|ir, n" );
--  end if;
end vm;

end builtins;

