Merge 3.16 branch into 7.0

This commit is contained in:
Andrew Johnson
2018-12-12 15:17:02 -06:00
47 changed files with 4248 additions and 1461 deletions
+7 -2
View File
@@ -97,7 +97,7 @@ sub ParseDBD {
my $rtyp = $dbd->recordtype($record_type);
if (!defined $rtyp) {
$rtyp = DBD::Recordtype->new($record_type);
warn "Device using undefined record type '$record_type', place-holder created\n";
warn "Device using unknown record type '$record_type', declaration created\n";
$dbd->add($rtyp);
}
$rtyp->add_device(DBD::Device->new($link_type, $dset, $choice));
@@ -218,7 +218,12 @@ sub parse_breaktable {
sub parse_recordtype {
my ($dbd, $record_type) = @_;
pushContext("recordtype($record_type)");
my $rtyp = DBD::Recordtype->new($record_type);
# Re-use a matching declaration record type if one exists
my $rtyp = $dbd->recordtype($record_type);
if (!defined($rtyp) || $rtyp->fields) {
# Earlier record type is not a declaration, don't re-use it
$rtyp = DBD::Recordtype->new($record_type);
}
while(1) {
parseCommon($rtyp);
if (m/\G field \s* \( \s* $RXstr \s* , \s* $RXstr \s* \) \s* \{/xgc) {
+12 -1
View File
@@ -130,7 +130,18 @@ sub attribute {
}
sub equals {
dieContext("Record field objects are not comparable");
my ($l, $r) = @_;
return 1 if $l eq $r;
return 0 if
$l->{NAME} ne $r->{NAME} ||
$l->{DBF_TYPE} ne $r->{DBF_TYPE};
my ($la, $ra) = ($l->{ATTR_INDEX}, $r->{ATTR_INDEX});
my @keys = sort keys %$la;
return 0 if join(',', @keys) ne join(',', sort keys %$ra);
foreach my $k (@keys) {
return 0 if $la->{$k} ne $ra->{$k};
}
return 1;
}
sub check_valid {
+13 -3
View File
@@ -104,9 +104,19 @@ sub pod {
sub equals {
my ($new, $known) = @_;
return 0 if ! $known->fields;
return 1 if ! $new->fields;
dieContext("Duplicate definition of record type '$known->{NAME}'");
return 1 if $new eq $known;
return 0 if $new->{NAME} ne $known->{NAME};
return 1 if ! $new->fields; # Later declarations always match
# NB: Definition after declaration is handled in parse_recordtype()
my @nf = @{$new->{FIELD_LIST}};
my @kf = @{$known->{FIELD_LIST}};
return 0 if scalar @nf != scalar @kf;
while (@nf) {
my $nf = shift @nf;
my $kf = shift @kf;
return 0 if ! $nf->equals($kf);
}
return 1;
}
sub toDeclaration {
+31 -18
View File
@@ -127,6 +127,33 @@ if ($opt_D) { # Output dependencies only
open my $out, '>', $opt_o or
die "Can't create $opt_o: $!\n";
my $podHtml;
my $idify;
if ($::XHTML) {
$podHtml = Pod::Simple::XHTML->new();
$podHtml->html_doctype(<< '__END_DOCTYPE');
<?xml version='1.0' encoding='iso-8859-1'?>
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN'
'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
__END_DOCTYPE
$podHtml->html_header_tags($podHtml->html_header_tags .
"\n<link rel='stylesheet' href='style.css' type='text/css'>");
$idify = sub {
my $title = shift;
return $podHtml->idify($title, 1);
}
} else { # Fall back to HTML
$podHtml = Pod::Simple::HTML->new();
$podHtml->html_css('style.css');
$idify = sub {
my $title = shift;
return Pod::Simple::HTML::esc($podHtml->section_escape($title));
}
}
# Parse the Pod text from the root DBD object
my $pod = join "\n", '=for html <div class="pod">', '',
map {
@@ -156,22 +183,6 @@ my $pod = join "\n", '=for html <div class="pod">', '',
} $dbd->pod,
'=for html </div>', '';
my $podHtml;
if ($::XHTML) {
$podHtml = Pod::Simple::XHTML->new();
$podHtml->html_doctype(<< '__END_DOCTYPE');
<?xml version='1.0' encoding='iso-8859-1'?>
<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Transitional//EN'
'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'>
__END_DOCTYPE
$podHtml->html_header_tags($podHtml->html_header_tags .
"\n<link rel='stylesheet' href='style.css' type='text/css'>");
} else { # Fall back to HTML
$podHtml = Pod::Simple::HTML->new();
$podHtml->html_css('style.css');
}
$podHtml->force_title(encode_entities($title));
$podHtml->perldoc_url_prefix('');
$podHtml->perldoc_url_postfix('.html');
@@ -249,7 +260,7 @@ sub fieldTableRow {
if ($type eq 'MENU') {
my $mn = $fld->attribute('menu');
my $menu = $dbd->menu($mn);
my $url = $menu ? "#Menu_$mn" : "${mn}.html";
my $url = $menu ? '#' . &$idify("Menu $mn") : "${mn}.html";
$html .= " (<a href='$url'>$mn</a>)";
}
$html .= '</td><td class="cell">';
@@ -377,6 +388,8 @@ can be found in the aai and aSub record types.
If you look at the L<aoRecord.dbd.pod> file you'll see that the POD there starts
by documenting a record-specific menu definition. The "menu" keyword generates a
table that lists all the choices found in the named menu.
table that lists all the choices found in the named menu. Any MENU fields in the
field tables that refer to a locally-defined menu will generate a link to a
document section which must be titled "Menu [menuName]".
=cut