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

Our goal is to make Oracle products, services, and supporting documentation accessible, with good usability, to the disabled community. To that end, our documentation includes features that make information available to users of assistive technology. This documentation is available in HTML format, and contains markup to facilitate access by the disabled community. Standards will continue to evolve over time, and Oracle is actively engaged with other market-leading technology vendors to address technical obstacles so that our documentation can be accessible to all of our customers. For additional information, visit the Oracle Accessibility Program Web site at

Accessibility of Code Examples in Documentation JAWS, a Windows screen reader, may not always correctly read the code examples in this document. The conventions for writing code require that closing braces should appear on an otherwise empty line; however, JAWS may not always read a line of text that consists solely of a bracket or brace.

Accessibility of Links to External Web Sites in Documentation This documentation may contain links to Web sites of other companies or organizations that Oracle does not own or control. Oracle neither evaluates nor makes any representations regarding the accessibility of these Web sites.

\n"; # Define acronyms my $HCVE = "HCVE"; my $RDA = "RDA"; my $SDCL = "". "SDCL"; my $SDSL = "". "SDSL"; # Define the global private variables # Report the module version number sub Version { $VERSION; } =head2 S<$h = RDA::Object::Pod-Enew($cfg)> The object constructor. It takes the reference to RDA software configuration as an argument. C is represented by a blessed hash reference. The following special keys are used: =over 12 =item S< B<'oid' > > Object identifier =item S< B<'_blk'> > Block indicator (_pod2text) =item S< B<'_cfg'> > Reference to the RDA software configuration =item S< B<'_off'> > Text offset (_pod2text) =item S< B<'_pre'> > Previous Tag text (_pod2text) =item S< B<'_reg'> > Applicable regions =item S< B<'_tag'> > Tag text (_pod2text) =item S< B<'_ver'> > RDA software version =item S< B<'_wdt'> > Page width parameter =back Internal keys are prefixed by an underscore. =cut sub new { my ($cls, $cfg) = @_; my ($slf); # Create the render object $slf = bless { oid => 'POD', _cfg => $cfg, _reg => {text => 1}, _ver => $cfg->get_version, _wdt => $cfg->get_columns, }, ref($cls) || $cls; # Identify applicable regions if (exists($ENV{'RDA_MAN'})) { foreach my $key (split(/,/, $ENV{'RDA_MAN'})) { $slf->{'_reg'}->{$key} = 1 if $key; } } # Return the object reference $slf; } =head2 S<$h-Epod2text($ofh,$file)> This method extracts the Plain Old Documentation (POD) blocks from the specified file and converts them into formatted ASCII. =cut sub pod2text { my ($slf, $ofh, $fil) = @_; my ($cut, $dft, $flg, $hdr, $ifh, $max, $reg, @off); local $/ = ""; # Treat multiple empty lines as a single empty line $cut = 1; $dft = 4; $flg = 0; $hdr = ' '; $slf->{'_blk'} = 0; $slf->{'_off'} = $dft; # Extract the documentation and format it if (ref($fil)) { $ifh = $fil; } else { $ifh = IO::File->new; $ifh->open("<$fil") or die "RDA-00402: Cannot open the manual file '$fil':\n $!\n" } while (<$ifh>) { # Extract the documentation if ($cut) { next unless m/^=/; $cut = 0; } if ($reg) { next unless m/^=end\s+$reg[\n\r\s]*$/; $reg = undef; } # Resolve attributes $max = 10; s#E<(\w+)>#\&$1;#g; while ($max-- && m/[A-Z]]+)\|[^>]+>#$1#g; s#C<(.*?)>#"$1"#sg; s#I<(.*?)>#*$1*#sg; s#X<.*?>##sg; s#[A-Z]<(.*?)>#$1#sg; } s#\&#&#g; s#\<#<#g; s#\>#>#g; s#\|#|#g; s#\/#/#g; s#\&(0[0-7]{1,3}|0x[0-9A-Fa-f]{1,4});#chr(oct($1))#g; s#\&(\d+);#chr($1)#g; s/[\s\r\n]+$//; # Treat the pod directives if (s/^=(\S*)\s?//) { my $cmd = $1; if ($cmd eq 'cut') { $cut = 1; } elsif ($cmd eq 'pod') { $cut = 0; } elsif ($cmd eq 'head1') { _prt_buf($slf, $ofh, $_, 0); } elsif ($cmd eq 'head2' || $cmd eq 'head3') { _prt_buf($slf, $ofh, $hdr.$_, 0); } elsif ($cmd eq 'over') { $slf->{'_pre'} = $slf->{'_tag'} if exists($slf->{'_tag'}); unshift(@off, $slf->{'_off'}); $slf->{'_off'} += ($_ + 0) || $dft; $flg = 1; } elsif ($cmd eq 'back') { _prt_blk($slf, $ofh, '', 1) if exists($slf->{'_tag'}); $slf->{'_off'} = shift(@off) || $dft; $flg = 0; } elsif ($cmd eq 'item') { my ($lgt, $off, $tag); _prt_blk($slf, $ofh, '', 0) if exists($slf->{'_tag'}); $off = $slf->{'_off'}; $tag = exists($slf->{'_pre'}) ? delete($slf->{'_pre'}) : ' ' x ($off[0] || $dft); s/\n/ /g; $tag .= $_.' '; for ($lgt = length($tag) ; $lgt < $off ; ++$lgt) { $tag .= ' '; } $slf->{'_blk'} = 0 unless $flg; $slf->{'_tag'} = $tag; $flg = 0; } elsif ($cmd eq 'begin') { if (!exists($slf->{'_reg'}->{$_})) { $reg = $_; } elsif ($_ eq 'credits') { _prt_buf($slf, $ofh, 'CREDITS', 0); } } } elsif (m/^\s+/) { my ($pre); _prt_blk($slf, $ofh, '', 0) if exists($slf->{'_tag'}); $pre = ' ' x $slf->{'_off'}; s/\n/\n$pre/g; _prt_buf($slf, $ofh, "$pre$_", 1); } else { _prt_blk($slf, $ofh, $_, 1); } } close($ifh); } sub _prt_blk { my ($slf, $ofh, $str, $nxt) = @_; my ($buf, $lgt, $off); $off = $slf->{'_off'}; if (exists($slf->{'_tag'})) { $lgt = length($buf = delete($slf->{'_tag'})); if ($lgt > $off) { $buf .= $str; ($buf, $str) = ($buf =~ m/^(\s*\S+\s)(.*)/); $lgt = length($buf); } } elsif (exists($slf->{'_pre'})) { $lgt = length($buf = delete($slf->{'_pre'})); } else { $buf = ' ' x ($lgt = $off); } foreach my $wrd (split(/\s/, $str)) { $lgt += length($wrd); if ($lgt > $slf->{'_wdt'}) { _prt_buf($slf, $ofh, $buf, 0); $buf = ' ' x $off; $lgt = $off + length($wrd); } $buf .= $wrd; $buf .= ' '; ++$lgt; } if ($lgt) { _prt_buf($slf, $ofh, $buf, $nxt); } else { $slf->{'_blk'} = $nxt; } } sub _prt_buf { my ($slf, $ofh, $buf, $nxt) = @_; $buf =~ s/\s+$//; $buf .= "\n"; $buf = "\n$buf" if $slf->{'_blk'}; $slf->{'_blk'} = $nxt; syswrite($ofh, $buf, length($buf)); } sub _prt_str { my ($ofh, $str) = @_; syswrite($ofh, $str, length($str)); } =head2 S<$h-Epod2html($ofh,$name,$file[,$fct])> This method extracts the POD blocks from the specified file and converts them into HTML. You can specify a function to convert the links as an extra argument. =cut sub pod2html { my ($slf, $ofh, $nam, $fil, $fct) = @_; my ($cut, $flg, $ifh, $max, $off, $reg, $str, $tag, @tbl); local $/ = ""; # Treat multiple empty lines as a single empty line $cut = $off = 2; $fct = \&_fmt_link unless defined($fct); $flg = 0; $tag = [0, '

', "

\n", '

', "

\n"]; # Extract the documentation and format it if (ref($fil)) { $ifh = $fil; } else { $ifh = IO::File->new; $ifh->open("<$fil") or die "RDA-00402: Cannot open the manual file '$fil':\n $!\n" } while (<$ifh>) { # Extract the documentation if ($cut) { next unless m/^=/; $cut = 0; } if ($reg) { next unless m/^=end\s+$reg[\n\r\s]*$/; $reg = undef; } # Resolve attributes $max = 10; s#\&#\&#g; s#E<(\w+)>#\&$1;#g; s#^(\s*)((<|require |use |(rda|sdp)\.\w+ ).*)$# "$1\001code\002"._fmt_space($2)."\001/code\002"#sge; # s#B<(\s*)>#$1#sg; s#^(=item(\s+o)?\s+S<\s*B<\s*)($LNK|[^<>]*?)\s*>\s*>\s*(\S.*)#$1$3>>\003$4#s || s#^(=item(\s+o)?\s+B<\s*)($LNK|[^<>]*?)\s*>\s*(\S.*)#$1$3>\003$4#s; while ($max-- && /[A-Z]]+)\|([^>]+)>#&{$fct}($1,$2)#sge; s#B<(.*?)>#"\001strong\002\001tt\002"._fmt_space($1, 1). "\001/tt\002\001/strong\002"#sge; s#[CFL]<(.*?)>#"\001code\002"._fmt_space($1)."\001/code\002"#sge; s#I<(.*?)>#\001em\002$1\001/em\002#sg; s#S<(.*?)>#_fmt_space($1)#sge; s#X<.*?>##sg; s#[A-Z]<(.*?)>#$1#sg; } s//>/g; s/\001//g; s/[\s\r\n]+$//; # Treat the pod directives if (s/^=(\S*)\s?//) { my $cmd = $1; if ($cmd eq 'cut') { $cut = 1; } elsif ($cmd eq 'pod') { $cut = 0; } elsif ($cmd eq 'head1') { if (m/(COPYRIGHT|TRADEMARK) NOTICE/) { $cut = 1; } elsif (m/^NAME$/) { $str = _fmt_name($nam); _prt_str($ofh, "

$nam

\n"); } else { _prt_str($ofh, "

$_

\n"); } } elsif ($cmd eq 'head2') { _prt_str($ofh, "

$_

\n"); } elsif ($cmd eq 'head3') { _prt_str($ofh, "

$_

\n"); } elsif ($cmd eq 'over') { unshift(@tbl, $tag); _prt_str($ofh, "\n\n

\n"); $tag = [1, " \n", '', "
", "	", '']; $flg = 1; $off = 5; } elsif ($cmd eq 'back') { if ($tag = shift(@tbl)) { _prt_str($ofh, "

\n"); } else { $tag = [0, '

', "

\n", '

', "

\n"]; } $flg = $tag->[0]; $off = 3; } elsif ($cmd eq 'item') { s/^(\s*)[o\*](\s|\z)/$1·\003/; s/\003/$tag->[4]/g; _prt_str($ofh, $tag->[$off].$_.$tag->[4]); $off = 3; $flg = 1; } elsif ($cmd eq 'begin') { if (!exists($slf->{'_reg'}->{$_})) { $reg = $_; } elsif ($_ eq 'credits') { _prt_str($ofh, "

CREDITS

\n"); } } } elsif (m/^\s+/) { ($flg, $str) = ($flg < 0) ? ($flg, $tag->[1]) : (-$flg, ''); s#\n#
#g; _prt_str($ofh, $str.""._fmt_space($_)."\n"); } else { ($flg, $str) = ($flg > 0) ? (-$flg, '') : ($flg, $tag->[1]); _prt_str($ofh, $str.$_.$tag->[2]); } } while ($tag = shift(@tbl)) { _prt_str($ofh, "\n"); } $ifh->close; } =head2 S<$h-Erender($ofh,$def)> This method converts the specified documentation in the POD format into HTML. The definition hash can contain the following keys: =over 11 =item B< 'det' > List of files to render =item B< 'fct' > Function to format links =item B< 'nam' > Page name =item B< 'rel' > List of related links =item B< 'tab' > List of main links =item B< 'ttl' > Page title =back A link item is represented by a scalar, used as text, or by an array reference containing the text and URL. =cut sub render { my ($slf, $ofh, $def) = @_; my ($buf, $col, $fct, $nam, $src, $tbl, $ttl, $val, @arg); # Initialization $fct = $def->{'fct'} || \&_fmt_link; $nam = _fmt_name($def->{'nam'} || ''); $ttl = $def->{'ttl'} || 'RDA Documentation'; # Start the page unless ($def->{'dsp'}) { $buf = $BEG."$ttl\n".$TOP."

$RDA ".$slf->{'_ver'} ." - $ttl

\n"; syswrite($ofh, $buf, length($buf)); } # Add the tab section if (ref($tbl = $def->{'tab'}) eq 'ARRAY' && ($col = scalar @$tbl)) { $buf = "

\n" ."\n"; $val = int(100 / $col); foreach my $det (@$tbl) { if (!ref($det)) { $buf .= "\n"; } elsif ($det->[2] eq $nam) { $buf .= "\n"; } else { $buf .= "\n"; } } $buf .= "

$RDA Main Links
" ._fmt_abbr($det)."	" ._fmt_abbr($det->[0])."	" ._fmt_abbr($det->[0])."

\n"; syswrite($ofh, $buf, length($buf)); } # Add the related link section if (ref($tbl = $def->{'rel'}) eq 'ARRAY') { $buf = "

COPYRIGHT NOTICE

TRADEMARK NOTICE

LEGAL NOTICES AND TERMS OF USE

DOCUMENTATION ACCESSIBILITY

$nam

$_

$_

$_

CREDITS

$RDA ".$slf->{'_ver'} ." - $ttl

Related Links