# Quoted.pm: Class Used to Manage Lexical Units for Quoted Strings

package RDA::Token::Quoted;

# $Id: Quoted.pm,v 1.3 2015/05/05 13:05:50 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Token/Quoted.pm,v 1.3 2015/05/05 13:05:50 RDA Exp $
#
# Change History
# 20150505  MSC  Improve the documentation.

=head1 NAME

RDA::Token::Quoted - Class Used to Manage Lexical Units for Quoted Strings

=head1 SYNOPSIS

 require RDA::Token::Quoted;

=head1 DESCRIPTION

The objects of the C<RDA::Token::Quoted> class are used to manage lexical units
for recognizing quoted strings. It is a subclass of
L<RDA::Object::Token|RDA::Object::Token>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Object;
  use RDA::Token::Complex;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @DUMP @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
@DUMP    = (
  hsh => {'RDA::Token::Action'  => 1,
          'RDA::Token::Complex' => 1,
          'RDA::Token::Quoted'  => 1,
          'RDA::Token::Simple'  => 1,
         },
  );
@ISA     = qw(RDA::Token::Complex RDA::Object Exporter);
%SDCL    = (
  inc => [qw(RDA::Object::Token RDA::Object)]
  );

# Define the global private constants

# Define the global private variables

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$h = RDA::Token::Quoted-E<gt>new(attrname =E<gt> $value,...)>

The object constructor. This method enables you to specify initial attributes
at object creation time.

C<RDA::Token::Quoted> is represented by a blessed hash reference. The following
special keys are used:

=over 12

=item S<    B<'lvl' > > Trace level

=item S<    B<'oid' > > Symbolic name

=item S<    B<'_act'> > Associated sub

=item S<    B<'_cnd'> > Associated conditions

=item S<    B<'_det'> > Token decoration

=item S<    B<'_exp'> > For an action token

=item S<    B<'_lex'> > Lexical analyzer instance

=item S<    B<'_pat'> > Regular expression (can be an array reference)

=item S<    B<'_sta'> > Object status

=item S<    B<'_tpl'> > Associated template

=item S<    B<'_txt'> > Recognized text

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, @arg) = @_;

  die get_string('NO_DEFINITION') if @arg < 2;
  return $cls->SUPER::new($cls->_parse(@arg));
}

sub _parse
{ my ($slf, @arg) = @_;
  my ($act, $beg, $end, $esc, $key, $nam, $val);

  $esc = q{};
  while (($key, $val) = splice(@arg, 0, 2))
  { next unless defined($key);
    if ($key =~ /-?[Nn]ame/)
    { $nam = $val;
    }
    elsif ($key =~ /^-?[Qq]uote$/)
    { $beg = $val unless defined($beg);
      $end = $val unless defined($end);
    }
    elsif ($key =~ /^-?[Ss]tart$/)
    { $beg = $val;
      $end = $val unless defined($end);
    }
    elsif ($key =~ /^-?[Ee]nd$/)
    { $end = $val;
      $beg = $val unless defined($beg);
    }
    elsif ($key =~ /^-?[Ee]scape$/)
    { $esc = $val;
    }
    elsif ($key =~ /^-?[Aa]ction$/)
    { $act = $val;
    }
    else
    { last;
    }
  }
  die get_string('NO_START') unless defined($beg);
  die get_string('NO_END')   unless defined($end);
  return ($nam, _build_re($beg, $end, $esc), $act);
}

# Examples:
# [qw(" [^"]+(?:""[^"]*)* ")]
# [qw(" [^\\"]+(?:\\.[^\\"]*)* ")]
sub _build_re
{ my ($beg, $end, $esc) = @_;
  my ($mid);

  $beg = quotemeta $beg;
  $end = quotemeta $end;
  if ($esc ne q{})
  { $esc = quotemeta $esc;
    $mid = qq![^$end$esc]*(?:$esc.!.qq![^$end$esc]*)*!;
  }
  else
  { $mid = qq![^$end]*(?:$end$end!.qq![^$end]*)*!;
  }
  return [$beg, $mid, $end];
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Token|RDA::Object::Token>,
L<RDA::Text|RDA::Text>,
L<RDA::Token::Complex|RDA::Token::Complex>

=head1 COPYRIGHT NOTICE

Copyright (c) 1996, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut