------------------------------------------------------------------------------
-- Strings Package Parser                                                   --
--                                                                          --
-- 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 text_io;

with interfaces.c,
    scanner.communications,
    pegasoft.strings,
    parser_params;
use interfaces.c,
    scanner,
    scanner.communications,
    pegasoft.strings,
    parser_params;

package body parser_strings_pcre is

#if PCRE
type regex_errmsgs is array(0..255) of interfaces.C.char;

procedure C_pcre( regex : string; str : string; errmsg : in out regex_errmsgs;
  errmax : interfaces.C.size_t; result : in out interfaces.C.int );
pragma import( C, C_pcre, "C_pcre" );
#end if;

procedure ParseStringsPerlMatch( result : out unbounded_string; kind : out identifier ) is
  -- Syntax: perl_match( s, e )
  -- Source: N/A
  expr_val  : unbounded_string;
  expr_type : identifier;
  pat_val   : unbounded_string;
  pat_type  : identifier;
  --b         : boolean;
begin
  kind := boolean_t;
  result := null_unbounded_string;
  if onlyAda95 then
     err( em( "pragma ada_95" ) & pl( " doesn't allow perl_match" ) );
  end if;
  expect( perl_match_t );
  ParseFirstStringParameter( perl_match_t, pat_val, pat_type );
  ParseLastStringParameter( perl_match_t, expr_val, expr_type );
  if isExecutingCommand then
     #if PCRE
     declare
       regex_errmsg : regex_errmsgs;
       res_int   : interfaces.C.int := 0;
       errmsg : unbounded_string;
     begin
       -- combines the compile and execute steps for regular expressions
       C_pcre( to_string(pat_val) & ASCII.NUL, to_string(expr_val) & ASCII.NUL, regex_errmsg, regex_errmsg'length, res_int );
       if Interfaces.C.To_Ada(regex_errmsg(0)) /= ASCII.NUL then
          for i in 0..regex_errmsg'last loop
              exit when interfaces.C.To_Ada( regex_errmsg(i) ) = ASCII.NUL;
              errmsg := errmsg & interfaces.C.To_Ada( regex_errmsg(i) );
          end loop;
          err( unb_pl( toescaped( errmsg ) ) );
       elsif integer(res_int) = 1 then
          result := to_unbounded_string( "1" );
          if trace then
             put_trace( "'" & toSecureData( to_string( toEscaped( pat_val ) ) ) &
                        "' pattern matches string '" &
                        toSecureData( to_string( toEscaped( expr_val ) ) ) &
                        "'" );
          end if;
       else
          result := to_unbounded_string( "0" );
          if trace then
             put_trace( "'" & toSecureData( to_string( toEscaped( pat_val ) ) ) &
                        "' pattern does not match string '" &
                        toSecureData( to_string( toEscaped( expr_val ) ) ) &
                        "'" );
          end if;
       end if;
     exception when others =>
       err_exception_raised;
     end;
     #else
     err( +"pcre support not configured" );
     #end if;
  end if;
end ParseStringsPerlMatch;

end parser_strings_pcre;

