# Convert.pm: Class Used for Managing Conversion Plug-ins

package RDA::Driver::Convert;

# $Id: Convert.pm,v 1.14 2015/07/31 12:56:34 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Driver/Convert.pm,v 1.14 2015/07/31 12:56:34 RDA Exp $
#
# Change History
# 20150731  MSC  Add new text emphasis.

=head1 NAME

RDA::Driver::Convert - Class Used for Managing Conversion Plug-ins

=head1 SYNOPSIS

 require RDA::Driver::Convert;

=head1 DESCRIPTION

This package is designed to manage the XML conversion plug-ins.

The plug-ins must declare a global variable C<@PLUGIN>, which lists available
conversion methods. Each array element is a hash reference containing at least
the following keys:

=over 12

=item S<    B<'nam' > > Definition name

=item S<    B<'rnk' > > Definition rank

=item S<    B<'sel' > > Reference to the selection function

=item S<    B<'typ' > > Conversion type

=back

The definitions can contain additional keys that are specific to the selection
function. The conversion control object calls successively all applicable
selection functions with its reference, the definition hash reference, and the
block name as arguments. The selection function returns the conversion with the
highest rank that is applicable to the current block.

The selection functions have typically access to the module name and version,
the report name, and the operating system.

Supported conversion types are as following:

=over 9

=item B<    'B' > Block conversion

=item B<    'S' > Stat conversion

=item B<    'T' > Table conversion

=back

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(add_string get_string);
  use RDA::Driver::Sgml;
  use RDA::Object::Content qw($RE_MOD);
  use RDA::Object::Rda;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @EXPORT_OK @ISA);
$VERSION   = sprintf('%d.%02d', q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/);
@EXPORT_OK = qw(clr_var cnv_attr cnv_value rpl_enc rpl_none rpl_var
                merge_block sel_block sel_function);
@ISA       = qw(Exporter);

# Define the global private constants
my $CMD = q{%COL\d+%|%END(?:COL|JSM|KMS|LIST|SEQ|TBL|SEQ)%|}
         .q{%JSM%|%KMS[^%]*%|%LIST%|%TBL%|%SEQ%};
my $LGT = 128;

# Define the global private variables
my %tb_cnv = (
  C => \&_cnv_col,
  F => \&_cnv_text,
  J => \&_cnv_jsm,
  K => \&_cnv_kms,
  L => \&_cnv_list,
  S => \&_cnv_seq,
  T => \&_cnv_tbl,
  );
my %tb_mos = (
  ARU   => ['MosAru',    # Text:MosAru
            'https://updates&#46;oracle&#46;com/Orion/PatchDetails/'.
            'process_form?aru=%s&amp;patch_password=&amp;no_header=0'],
  BUG   => ['MosBug',    # Text:MosBug
            'https://support&#46;oracle&#46;com/rs?type=bug&amp;id=%s'],
  DOC   => ['MosDoc',  # Text:MosDoc
          'https://support&#46;oracle&#46;com/rs?type=doc&amp;id=%s'],
  PATCH => ['MosPatch',  # Text:MosPatch
            'https://support&#46;oracle&#46;com/rs?type=patch&amp;id=%s'],
  );

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

=head2 S<$h = RDA::Driver::Convert-E<gt>new($agt,$cfg,$col)>

The object constructor. It takes the agent, RDA software configuration, and
collector object references as arguments.

An C<RDA::Driver::Convert> is represented by a blessed hash reference. The
following special keys are used:

=over 12

=item S<    B<'agt' > > Reference to the agent object

=item S<    B<'cfg' > > Reference to the RDA software configuration

=item S<    B<'cnv' > > Active converters

=item S<    B<'col' > > Reference to the collector object

=item S<    B<'ctx' > > Current context

=item S<    B<'eob' > > End of block indicator

=item S<    B<'ifh' > > Current input file handle

=item S<    B<'mod' > > Name of the current module

=item S<    B<'osn' > > Operating system used for report production

=item S<    B<'rpt' > > Name of the current report

=item S<    B<'typ' > > Active types

=item S<    B<'ver' > > Version of the current module

=item S<    B<'_def'> > Module conversion definitions

=item S<    B<'_dir'> > Conversion directory

=item S<    B<'_lvl'> > Conversion trace level

=item S<    B<'_old'> > Module conversion table

=item S<    B<'_tbl'> > Table storage area

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt, $cfg, $col) = @_;

  # Create the macro object and return its reference
  return bless {
    agt  => $agt,
    cfg  => $cfg,
    cnv  => {},
    col  => $col,
    ctx  => {},
    eob  => 1,
    osn  => q{},
    typ  => {},
    _def => {},
    _dir => $agt->get_env('RDA_CONVERT') ||
            $cfg->get_dir('D_RDA_INC', 'Convert'),
    _lvl => $col->get_trace('CONVERT'),
    }, ref($cls) || $cls;
}

=head2 S<$h-E<gt>add_mos($abr, $txt, $typ, $url)>

This method adds or modifies a C<MOS> Wiki directive. You cannot modify
internal entries.

=cut

sub add_mos
{ my ($slf, $txt, $typ, $url) = @_;
  my ($abr);

  return 1 if exists($tb_mos{$typ}) && !$tb_mos{$typ}->[2];
  $abr = 'Mos_'.lc($typ);
  $tb_mos{$typ} = [$abr, $url, 1] if defined(add_string($abr, $txt));
  return 0;
}

=head2 S<$h-E<gt>convert($ofh,$ifh,$blk[,$typ])>

This method determines the conversion method by executing all applicable
selection functions of the current module. It uses the conversion method with
the highest rank to converts a block. It returns a true value on successful
completion. Otherwise, it returns a false value.

=cut

sub convert
{ my ($slf, $ofh, $ifh, $blk, $typ) = @_;
  my ($fct);

  # Determine which conversion to do
  $typ = (defined($typ) && exists($slf->{'typ'}->{$typ}))
    ? $slf->{'typ'}->{$typ}
    : 'B';
  return 0 unless ($fct = $slf->search($typ, $blk));

  # Execute the conversion
  $slf->trace(2, get_string('Convert', $blk));
  $slf->{'eob'} = 0;
  $slf->{'ifh'} = $ifh;
  eval {&$fct($slf, $ofh, $blk)};
  $slf->{'agt'}->add_error($@, get_string('ERR_CONVERT', $blk)) if $@;
  1 while defined($slf->get_line);

  # Indicate the completion status
  return 1;
}

=head2 S<$h-E<gt>delete_object>

This method deletes the conversion control object.

=cut

sub delete_object
{ undef %{$_[0]};
  undef $_[0];
  return;
}

=head2 S<$h-E<gt>get_cells($lin)>

This method gets all cells contained in a table row. It trims leading and
trailing and spaces.

=cut

sub get_cells
{ my ($slf, $lin) = @_;
  my ($txt, @tbl);

  while ($lin =~ s/([^\|]*)\|//)
  { $txt = $1;
    $txt =~ s/^\s+//;
    $txt =~ s/\s+$//;
    push(@tbl, $txt);
  }
  return @tbl;
}

=head2 S<$h-E<gt>get_context([$key[,$dft]])>

This method returns the value of a context property or the default value when
the property is not defined.

It returns a reference to the context hash when no attribute is specified.

=cut

sub get_context
{ my ($slf, $key, $dft) = @_;

  return !defined($key)                ? $slf->{'ctx'} :
         exists($slf->{'ctx'}->{$key}) ? $slf->{'ctx'}->{$key} :
                                         $dft;
}

=head2 S<$h-E<gt>get_line>

This method gets a block line. It trims trailing carriage return, line feed,
and spaces. It returns an undefined value when it reaches the block end.

=cut

sub get_line
{ my ($slf) = @_;
  my ($lin);

  unless ($slf->{'eob'})
  { if (defined($lin = $slf->{'ifh'}->getline))
    { $lin =~ s{[\n\r\s]+$}{};
      return $lin unless $lin eq '</verbatim>';
    }
    $slf->{'eob'} = 1;
  }
  return;
}

=head2 S<$h-E<gt>get_module>

This method returns the name of the current module. It returns an undefined
value when no signature is present in the report.

=cut

sub get_module
{ return shift->{'mod'};
}

=head2 S<$h-E<gt>get_os>

This method returns the operation system used for report production. It returns
an undefined value when no signature is present in the report.

=cut

sub get_os
{ return shift->{'osn'};
}

=head2 S<$h-E<gt>get_report>

This method returns the name of the current report. It returns an undefined
value when no signature is present in the report.

=cut

sub get_report
{ return shift->{'rpt'};
}

=head2 S<$h-E<gt>get_version>

This method returns the version of the current module. It returns an undefined
value when no signature is present in the report.

=cut

sub get_version
{ return shift->{'ver'};
}

=head2 S<$h-E<gt>init($ctx,$ifh)>

This method initializes the conversion control. On the first occurrence, it
loads all plug-ins related to the context module. They are regrouped in the
F<Convert/E<lt>moduleE<gt>> subdirectory of the C<D_RDA_INC> directory group.

The conversion mechanism is enabled only for reports having a signature.

=cut

sub init
{ my ($slf, $ctx, $ifh) = @_;
  my ($def, $mod);

  if (exists($ctx->{'module'}))
  { $mod = $ctx->{'module'};
    $slf->trace(1, get_string('Init', $mod, $ctx->{'report'}));

    $def = _init($slf, $mod);
    $slf->{'cnv'} = $def->{'cnv'};
    $slf->{'mod'} = $mod;
    $slf->{'osn'} = $ctx->{'os'};
    $slf->{'rpt'} = $ctx->{'report'};
    $slf->{'typ'} = $def->{'typ'};
    $slf->{'ver'} = $ctx->{'version'};
  }
  else
  { $slf->{'cnv'} = {};
    $slf->{'osn'} = q{};
    $slf->{'typ'} = {};
    delete($slf->{'mod'});
    delete($slf->{'rpt'});
    delete($slf->{'ver'});
  }
  $slf->{'ctx'} = $ctx;
  $slf->{'ifh'} = $ifh;
  return;
}

sub _conv_module
{ my ($slf, $mod, $abr) = @_;
  my ($ifh, $tbl);

  # Load the conversion table on first use
  unless (exists($slf->{'_old'}))
  { $slf->{'_old'} = $tbl = {S204LOG => 'DB.LOG'};
    $ifh = IO::File->new;
    if ($ifh->open('<'.$slf->{'cfg'}->get_file('D_RDA_DAT', 'convert.txt')))
    { while (<$ifh>)
      { $tbl->{$1} = $2 if m/^cnv:(\S+)=(\S+)/;
      }
      $ifh->close;
    }
  }

  # Convert the module
  return exists($slf->{'_old'}->{$mod}) ? $slf->{'_old'}->{$mod} : $abr;
}

sub _init
{ my ($slf, $mod, $flg) = @_;
  my ($cls, $def, $src, @mod, %cnv);

  # Normalize the module name
  if ($mod =~ $RE_MOD)
  { $mod = uc($2.q{.}.$4);
  }
  elsif (uc($mod) =~ m/^(S\d{3}([A-Z][A-Z\d]{1,3}))$/)
  { $mod = _conv_module($slf, $1, $2);
  }

  # Reuse a previous definition
  return $slf->{'_def'}->{$mod} if exists($slf->{'_def'}->{$mod});

  # Create a default definition
  if ($flg)
  { $def = {typ => {}};
  }
  else
  { $src = _init($slf, 'Common', 1);
    %cnv = map {$_ => [@{$src->{'cnv'}->{$_}}]} keys(%{$src->{'cnv'}});
    $def = {typ => {%{$src->{'typ'}}}};
  }

  # Load the plug-ins
  @mod = split(/[:\.]/, $mod);
  if (opendir(DIR, RDA::Object::Rda->cat_dir($slf->{'_dir'}, @mod)))
  { foreach my $nam (readdir(DIR))
    { next unless $nam =~ m/^(\w+)\.pm$/i;

      # Load the plug-in definition
      $cls = join(q{::}, 'Convert', @mod, $1);
      $slf->trace(1, get_string('Load', $cls));
      eval "require $cls";
      if ($@)
      { $slf->{'agt'}->add_error($@, get_string('ERR_LOAD', $cls));
        next;
      }
      $src = {eval "\%$cls\::PLUGIN"};  ## no critic (Eval)
      if ($@)
      { $slf->{'agt'}->add_error($@, get_string('ERR_DEFINE', $cls));
        next;
      }

      # Merge the definitions
      if (exists($src->{'cnv'}))
      { foreach my $itm (@{$src->{'cnv'}})
        { push(@{$cnv{$itm->{'typ'}}}, $itm)
            if exists($itm->{'typ'}) && exists($itm->{'rnk'});
        }
      }
      if (exists($src->{'typ'}))
      { foreach my $itm (keys(%{$src->{'typ'}}))
        { $def->{'typ'}->{$itm} = $src->{'typ'}->{$itm};
        }
      }
    }
    closedir(DIR);
  }

  # Sort the converters
  ## no critic (Reverse)
  $def->{'cnv'} =
    {map {$_ => [sort {$b->{'rnk'} <=> $a->{'rnk'}} @{$cnv{$_}}]} keys(%cnv)};

  # Return the definition
  return $slf->{'_def'}->{$mod} = $def;
}

=head2 S<$h-E<gt>search($typ,$blk[,$dft])>

This method determines the conversion method by executing all applicable
selection functions of the current module. It selects and returns the
conversion with the highest rank. Otherwise, it returns the default value.

=cut

sub search
{ my ($slf, $typ, $blk, $dft) = @_;
  my ($ret);

  if (exists($slf->{'cnv'}->{$typ}))
  { $slf->trace(2, get_string('Search', "$typ:$blk"));
    foreach my $def (@{$slf->{'cnv'}->{$typ}})
    { next if exists($def->{'osn'}) && $def->{'osn'} ne $slf->{'osn'};
      $slf->trace(3, get_string('Check', $def->{'nam'}));
      $ret = eval {&{$def->{'sel'}}($slf, $def, $blk)};
      $slf->{'agt'}->add_error($@, get_string('ERR_SEARCH', $blk)) if $@;
      next unless defined($ret);
      $slf->trace(3, get_string('Found', $def->{'rnk'}));
      return $ret;
    }
  }
  return $dft;
}

=head2 S<$h-E<gt>set_trace([$level])>

This method sets the conversion trace level and returns the previous level.

=cut

sub set_trace
{ my ($slf, $lvl) = @_;
  my ($old);

  $old = $slf->{'_lvl'};
  $slf->{'_lvl'} = $lvl if defined($lvl);
  return $old;
}

=head2 S<$h-E<gt>trace($level,$arg...)>

This method adds lines to the trace when it satisfies the minimal trace level.

=cut

sub trace
{ my ($slf, $lvl, @arg) = @_;

  $slf->{'agt'}->trace(@arg)
    unless $slf->{'_lvl'} < $lvl;  ## no critic (Unless)
  return;
}

=head1 COMMON CONVERSION METHODS

=head2 S<$h-E<gt>clr_var($slf,$str)>

This method removes variables and other enhancements from the provided string.

=cut

sub clr_var
{ my ($slf, $str) = @_;

  $str =~ s{&nbsp;}{ }g;
  $str =~ s{\%(?:ACRONYM|R):(\w+)\%}{$1}g;
  $str =~ s{\%(BR|COL\d+|END(COL|LIST|SEQ|TBL)|HDR|LIST|NEXT|SEQ|TBL)\%}{ }g;
  $str =~ s{\%(BLUE|DATA|ENDCOLOR|ID(:\w+)*|RED)\%}{}g;
  $str =~ s{\%MOS_([A-Z]+):([\.\w]+)\%}{_rpl_mos($1, $2)}eg;
  $str =~ s{\%MRC\.\w+\%}{}g;
  $str =~ s{\%NA\%}{Not applicable}g;
  $str =~ s{\%NONE\%}{None}g;
  $str =~ s{\%NULL\%}{Null value}g;
  $str =~ s{\%NV\%}{No value}g;
  $str =~ s{\%VERSION\%}{$slf->{'cfg'}->get_version}eg;
  $str =~ s{\*\*(.*?)\*\*}{$1}g;
  $str =~ s{\'\'(.*?)\'\'}{$1}g;
  $str =~ s{\`\`(.*?)\`\`}{$1}g;
  $str =~ s{\^\^(.*?)\^\^}{$1}g;
  $str =~ s{\{\{[^\|\}]+?\}\}}{}g;
  $str =~ s{\{\{.+?\|(.*?)\}\}}{[$2]}g;
  $str =~ s{\[\[([^\[\]]+)\]\[([^\[\]]+)\]\[(.+?)\]\]}{$3}g;
  $str =~ s{\[\[([^\[\]]+)\]\[(.+?)\]\]}{$2}g;
  $str =~ s{\s+}{ }g;
  return RDA::Driver::Sgml::convert($str);
}

=head2 S<$h-E<gt>cnv_attr($slf,$str)>

This method converts a string to a valid attribute name.

=cut

sub cnv_attr
{ my ($slf, $str) = @_;

  $str =~ s/[<>'"]/_/g;
  $str = lc(clr_var($slf, $str));
  $str =~ s/&\#(\d+|x[0-9a-f]+);?/_/g;
  $str =~ s/\W+/_/gs;
  $str =~ s/_+/_/g;
  $str =~ s/_$//;
  return substr(($str =~ m/^_/)  ? qq{attr$str} :
                ($str =~ m/^\d/) ? qq{attr_$str} :
                                   $str, 0, $LGT);
}

=head2 S<RDA::Convert::cnv_value($str)>

This method converts a string to an attribute value.

=cut

sub cnv_value
{ my ($str) = @_;

  $str =~ s{(\&+)([^#]|\z)}{('&#38;' x length($1)).$2}eg;
  $str =~ s{\"}{&#34;}g;
  $str =~ s{\'}{&#39;}g;
  $str =~ s{\<}{&#60;}g;
  $str =~ s{\>}{&#62;}g;
  return $str;
}

=head2 S<$h-E<gt>rpl_enc($slf,$str)>

This method encodes some characters in the specified strings.

=cut

sub rpl_enc
{ my ($slf, $str) = @_;

  $str =~ s/[\000-\010\013-\014\016-\037]//g;
  $str =~ s/</&#60;/g;
  $str =~ s/>/&#62;/g;
  $str =~ s/\%R:(\w+)\%/[$1]/g;
  return RDA::Driver::Sgml::convert($str);
}

=head2 S<$h-E<gt>rpl_none($slf,$str)>

This method returns the provided string with less replacements.

=cut

sub rpl_none
{ my ($slf, $str) = @_;

  $str =~ s/[\000-\010\013-\014\016-\037]//g;
  $str =~ s/\%R:(\w+)\%/[$1]/g;
  return RDA::Driver::Sgml::convert($str);
}

=head2 S<$h-E<gt>rpl_var($slf,$str)>

This method replaces variables in the provided string.

=cut

sub rpl_var
{ my ($slf, $str) = @_;
  my (@tbl);

  # Resolve simple variables and references
  $str =~ s{[\000-\010\013-\014\016-\037]}{}g;
  $str =~ s{&nbsp;}{ }g;
  $str =~ s{\%ACRONYM:(\w+)\%}{$1}g;
  $str =~ s{\%R:(\w+)\%}{[$1]}g;
  $str =~ s{\%(BLUE|DATA|ENDCOLOR|HDR|RED)\%}{}g;
  $str =~ s{\%MOS_([A-Z]+):([\.\w]+)\%}{_rpl_mos($1, $2, 1)}eg;
  $str =~ s{\%MRC:(\w+)\%}{_rpl_mrc($slf, $1)}eg;
  $str =~ s{\%NA\%}{Not applicable}g;
  $str =~ s{\%NONE\%}{None}g;
  $str =~ s{\%NULL\%}{Null value}g;
  $str =~ s{\%NV\%}{No value}g;
  $str =~ s{\%VERSION\%}{$slf->{'cfg'}->get_version}eg;
  $str =~ s{\*\*(.*?)\*\*}{$1}g;
  $str =~ s{\'\'(.*?)\'\'}{$1}g;
  $str =~ s{\`\`(.*?)\`\`}{$1}g;
  $str =~ s{\^\^(.*?)\^\^}{$1}g;
  $str =~ s{\[\[\#Top\]\[Back to top\]\]}{}g;

  # Parse the string and convert the resulting tree
  @tbl = split(/($CMD)/, $str);
  return _cnv_tree(_prs_tree(\@tbl, {typ => 'F', det => []}));
}

=head1 COMMON SELECTION METHODS

=head2 S<$h-E<gt>sel_block($def,$blk)>

This method determines if the current block needs some conversion based on
definition block table and possible operating system constraint, as
described respectively by the C<blk> and C<osn> definition keys.

Reports are internally converted to lower case.

=cut

sub sel_block
{ my ($slf, $def, $blk) = @_;
  my ($key);

  $key = lc($slf->{'rpt'});
  if (exists($def->{'blk'}->{$key}) && ref($def->{'blk'}->{$key}))
  { foreach my $rec (@{$def->{'blk'}->{$key}})
    { return $rec->[1] if $blk =~ $rec->[0];
    }
  }
  return;
}

=head2 S<$h-E<gt>sel_function($def)>

This method selects the function associated to the C<fct> definition key for
converting the current block.

=cut

sub sel_function
{ my ($slf, $def) = @_;

  return exists($def->{'fct'}) ? $def->{'fct'} : undef;
}

=head1 COMMON TRANSFORMATION METHODS

=head2 S<RDA::Convert::merge_block($ctl,$ofh)>

This method merges the block in the XML output.

=cut

sub merge_block
{ my ($ctl, $ofh) = @_;
  my ($lin);

  while (defined($lin = $ctl->get_line))
  { $lin =~ s/<\?xml.*?\?>//;
    print {$ofh} "$lin\n" if length($lin);
  }
  return;
}

# --- Conversion routines -----------------------------------------------------

# Convert a column
sub _cnv_col
{ my ($str, $ctl) = @_;
  my ($tag);

  $str =~ s/\%NEXT\%/\%BR\%/g;
  $tag = ($str =~ s{\%ID(:(\w+))?(:\w+)*\%}{}g && $2)
    ? qq{<sdp_item id='$2'>}
    : q{<sdp_item>};
  return ($str =~ m/^\s*$/)
    ? $str
    : q{<sdp_columns num='}.$ctl->{'num'}.qq{'>\n$tag}
      .join(qq{</sdp_item>\n$tag},
            map {_rpl_ref($_)} split(/\%BR\%/, $str, -1))
      .qq{</sdp_item>\n</sdp_columns>};
}

# Convert a Java Stack Match form
sub _cnv_jsm
{ return q{};
}

# Convert a knowledge management search
sub _cnv_kms
{ my ($str, $ctl) = @_;
  my ($src, $txt, @tbl);

  return q{} unless (@tbl = grep {length($_)} split(/%NEXT%/, $str));
  $src = $txt = ($ctl->{'src'} =~ m/^(\w+(,\w+)*)$/) ? $1 : 'ALLSOURCES';
  $txt =~ s{,}{", "}g;
  $txt = get_string('MosSearch', join(q{", "}, @tbl), $txt);
  $str = join(q{%20}, map {_cnv_term($_)} @tbl);
  return q{<sdp_a href='https://support&#46;oracle&#46;com/rs?type=search}
    .qq{&amp;sources=$src&amp;term=$str' target='_blank'>$txt</sdp_a>};
}

sub _cnv_term
{ my ($str) = @_;

  $str =~ s{([^\041-\176])}{sprintf('%%%02x', ord($1))}eg;
  return q{%2522}.$str.q{%2522};
}

# Convert a list
sub _cnv_list
{ my ($str) = @_;
  my ($tag);

  $tag = ($str =~ s{\%ID(:(\w+))?(:\w+)*\%}{}g && $2)
    ? qq{<sdp_item id='$2'>}
    : q{<sdp_item>};
  return ($str =~ m/^\s*$/)
    ? $str
    : qq{<sdp_list>\n$tag}
      .join(qq{</sdp_item>\n$tag},
            map {_rpl_ref($_)} split(/\%NEXT\%/, $str, -1))
      .qq{</sdp_item>\n</sdp_list>};
}

# Convert a sequence
sub _cnv_seq
{ my ($str) = @_;
  my ($tag);

  $tag = ($str =~ s{\%ID(:(\w+))?(:\w+)*\%}{}g && $2)
    ? qq{<sdp_item id='$2'>}
    : q{<sdp_item>};
  return ($str =~ m/^\s*$/)
    ? $str
    : qq{<sdp_seq>\n$tag}
      .join(qq{</sdp_item>\n$tag},
            map {_rpl_ref($_)} split(/\%NEXT\%/, $str, -1))
      .qq{</sdp_item>\n</sdp_seq>};
}

# Convert a tree
sub _cnv_tree
{ my ($ctl) = @_;

  foreach my $itm (@{$ctl->{'det'}})
  { $itm->{'txt'} = _cnv_tree($itm) unless $itm->{'typ'} eq 'F';
  }
  return &{$tb_cnv{$ctl->{'typ'}}}(
    join(q{}, map {$_->{'txt'}} @{$ctl->{'det'}}), $ctl);
}

# Convert a table
sub _cnv_tbl
{ my ($str, $ctl) = @_;
  my ($buf, $cnt, $key, @hdr, @row);

  @hdr = split(/:/, $1) if $str =~ s/\%ID((:\w+)*)\%//;
  return q{} unless $str =~ m/\S/ && (@row = split(/\%BR\%/, $str, -1));
  $buf = q{<sdp_table>};
  foreach my $row (@row)
  { $buf .= qq{<sdp_cells>\n};
    $cnt = 0;
    foreach my $det (split(/\%NEXT\%/, $row, -1))
    { $buf .= (($key = $hdr[++$cnt]) ? qq{<sdp_cell id='$key'>} : q{<sdp_cell>})
        ._rpl_ref($det).qq{</sdp_cell>\n};
    }
    $buf .= q{</sdp_cells>};
  }
  return $buf.q{</sdp_table>};
}

# Convert a text
sub _cnv_text
{ return _rpl_ref(@_);
}

# Parse a string
sub _prs_tree
{ my ($tbl, $ctl) = @_;
  my ($itm);

  while (defined($itm = shift(@{$tbl})))
  { next if $itm eq q{};
    return $ctl if exists($ctl->{'end'}) && $itm eq $ctl->{'end'};
    if ($itm =~ m/^\%COL(\d+)\%$/)
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'C', det => [], end => q{%ENDCOL%}, num => $1}));
    }
    elsif ($itm eq '%JSM%')
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'J', det => [], end => '%ENDJSM%'}));
    }
    elsif ($itm =~ m{^\%KMS(\:(.*))?\%$})
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'K', det => [], end => '%ENDKMS%', src => $2 || 'ALLSOURCES'}));
    }
    elsif ($itm eq '%LIST%')
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'L', det => [], end => q{%ENDLIST%}}));
    }
    elsif ($itm eq '%SEQ%')
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'S', det => [], end => q{%ENDSEQ%}}));
    }
    elsif ($itm eq '%TBL%')
    { push(@{$ctl->{'det'}}, _prs_tree($tbl,
        {typ => 'T', det => [], end => q{%ENDTBL%}}));
    }
    elsif ($itm !~ m/^\%END(?:COL|LIST|SEQ|TBL)\%$/)
    { push(@{$ctl->{'det'}}, {typ => 'F', txt => $itm});
    }
  }
  return $ctl;
}

# Replace My Oracle Support variables
sub _rpl_mos
{ my ($var, $val, $flg) = @_;

  return exists($tb_mos{$var})
    ? get_string($tb_mos{$var}->[0], $flg
        ? q{[[}.sprintf($tb_mos{$var}->[1], $val).q{][_blank][}.$val.q{]]}
        : $val)
    : get_string('Mos', $val);
}

# Replace multi-run collection variables
sub _rpl_mrc
{ my ($slf, $mod) = @_;
  my ($col, $sub);

  $col = $slf->{'col'};
  return ($col->get_first(qq{$mod\_MRC}, 0)
    && defined($sub = $col->get_sub('M')))
    ? $sub.q{/}
    : q{};
}

# Replace references
sub _rpl_ref
{ my ($str) = @_;
  my ($blk);

  $blk = '([^\[\]]+)';
  $str =~ s{\{\{([^\|\}]+?)\}\}}{<sdp_img src='$1'/>}g;
  $str =~ s{\{\{(.+?)\|(.*?)\}\}}{<sdp_img src='$1' alt='$2'/>}g;
  $str =~ s{\[\[\#$blk\]\[$blk\]\[(.+?)\]\]}{$3}g;
  $str =~ s{\[\[\#$blk\]\[(.+?)\]\]}{$2}g;
  $str =~ s{\[\[$blk\]\[$blk\]\[(.+?)\]\]}
           {<sdp_a href='$1' target='$2'>$3</sdp_a>}g;
  $str =~ s{\[\[$blk\]\[(.+?)\]\]}{<sdp_a href='$1'>$2</sdp_a>}g;
  $str =~ s{\%BR\%}{ }g;
  $str =~ s{\%ID(:\w+)*\%}{}g;
  $str =~ s{[ \f\t]+}{ }g;
  $str =~ s{^\s}{}g;
  $str =~ s{\s$}{}g;
  return RDA::Driver::Sgml::convert($str);
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Sgml|RDA::Driver::Sgml>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Request::CONVERT|RDA::Request::CONVERT>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 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