+sub make_ucd_table_pod_entries {
+ my $table = shift;
+
+ # Generate the entries for the UCD section of the pod for $table. This
+ # also calculates if names are ambiguous, so has to be called even if the
+ # pod is not being output
+
+ my $short_name = $table->name;
+ my $standard_short_name = standardize($short_name);
+ my $full_name = $table->full_name;
+ my $standard_full_name = standardize($full_name);
+
+ my $full_info = ""; # Text of info column for full-name entries
+ my $other_info = ""; # Text of info column for short-name entries
+ my $short_info = ""; # Text of info column for other entries
+ my $meaning = ""; # Synonym of this table
+
+ my $property = ($table->isa('Property'))
+ ? $table
+ : $table->parent->property;
+
+ my $perl_extension = $table->perl_extension;
+
+ # Get the more official name for for perl extensions that aren't
+ # stand-alone properties
+ if ($perl_extension && $property != $table) {
+ if ($property == $perl ||$property->type == $BINARY) {
+ $meaning = $table->complete_name;
+ }
+ else {
+ $meaning = $property->full_name . "=$full_name";
+ }
+ }
+
+ # There are three types of info column. One for the short name, one for
+ # the full name, and one for everything else. They mostly are the same,
+ # so initialize in the same loop.
+ foreach my $info_ref (\$full_info, \$short_info, \$other_info) {
+ if ($perl_extension && $property != $table) {
+
+ # Add the synonymous name for the non-full name entries; and to
+ # the full-name entry if it adds extra information
+ if ($info_ref == \$other_info
+ || ($info_ref == \$short_info
+ && $standard_short_name ne $standard_full_name)
+ || standardize($meaning) ne $standard_full_name
+ ) {
+ $$info_ref .= "$meaning.";
+ }
+ }
+ elsif ($info_ref != \$full_info) {
+
+ # Otherwise, the non-full name columns include the full name
+ $$info_ref .= $full_name;
+ }
+
+ # And the full-name entry includes the short name, if different
+ if ($info_ref == \$full_info
+ && $standard_short_name ne $standard_full_name)
+ {
+ $full_info =~ s/\.\Z//;
+ $full_info .= " " if $full_info;
+ $full_info .= "(Short: $short_name)";
+ }
+
+ if ($table->perl_extension) {
+ $$info_ref =~ s/\.\Z//;
+ $$info_ref .= ". " if $$info_ref;
+ $$info_ref .= "(Perl extension)";
+ }
+ }
+
+ # Add any extra annotations to the full name entry
+ foreach my $more_info ($table->description,
+ $table->note,
+ $table->status_info)
+ {
+ next unless $more_info;
+ $full_info =~ s/\.\Z//;
+ $full_info .= ". " if $full_info;
+ $full_info .= $more_info;
+ }
+
+ # These keep track if have created full and short name pod entries for the
+ # property
+ my $done_full = 0;
+ my $done_short = 0;
+
+ # Every possible name is kept track of, even those that aren't going to be
+ # output. This way we can be sure to find the ambiguities.
+ foreach my $alias ($table->aliases) {
+ my $name = $alias->name;
+ my $standard = standardize($name);
+ my $info;
+ my $output_this = $alias->ucd;
+
+ # If the full and short names are the same, we want to output the full
+ # one's entry, so it has priority.
+ if ($standard eq $standard_full_name) {
+ next if $done_full;
+ $done_full = 1;
+ $info = $full_info;
+ }
+ elsif ($standard eq $standard_short_name) {
+ next if $done_short;
+ $done_short = 1;
+ next if $standard_short_name eq $standard_full_name;
+ $info = $short_info;
+ }
+ else {
+ $info = $other_info;
+ }
+
+ # Here, we have set up the two columns for this entry. But if an
+ # entry already exists for this name, we have to decide which one
+ # we're going to later output.
+ if (exists $ucd_pod{$standard}) {
+
+ # If the two entries refer to the same property, it's not going to
+ # be ambiguous. (Likely it's because the names when standardized
+ # are the same.) But that means if they are different properties,
+ # there is ambiguity.
+ if ($ucd_pod{$standard}->{'property'} != $property) {
+
+ # Here, we have an ambiguity. This code assumes that one is
+ # scheduled to be output and one not and that one is a perl
+ # extension (which is not to be output) and the other isn't.
+ # If those assumptions are wrong, things have to be rethought.
+ if ($ucd_pod{$standard}{'output_this'} == $output_this
+ || $ucd_pod{$standard}{'perl_extension'} == $perl_extension
+ || $output_this == $perl_extension)
+ {
+ Carp::my_carp("Bad news. $property and $ucd_pod{$standard}->{'property'} have unexpected output status and perl-extension combinations. Proceeding anyway.");
+ }
+
+ # We modifiy the info column of the one being output to
+ # indicate the ambiguity. Set $which to point to that one's
+ # info.
+ my $which;
+ if ($ucd_pod{$standard}{'output_this'}) {
+ $which = \$ucd_pod{$standard}->{'info'};
+ }
+ else {
+ $which = \$info;
+ $meaning = $ucd_pod{$standard}{'meaning'};
+ }
+
+ chomp $$which;
+ $$which =~ s/\.\Z//;
+ $$which .= "; NOT '$standard' meaning '$meaning'";
+
+ $ambiguous_names{$standard} = 1;
+ }
+
+ # Use the non-perl-extension variant
+ next unless $ucd_pod{$standard}{'perl_extension'};
+ }
+
+ # Store enough information about this entry that we can later look for
+ # ambiguities, and output it properly.
+ $ucd_pod{$standard} = { 'name' => $name,
+ 'info' => $info,
+ 'meaning' => $meaning,
+ 'output_this' => $output_this,
+ 'perl_extension' => $perl_extension,
+ 'property' => $property,
+ 'status' => $alias->status,
+ };
+ } # End of looping through all this table's aliases
+
+ return;
+}
+