Merge 3.16 branch into 7.0
This commit is contained in:
@@ -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) {
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user