#!/usr/bin/perl -w # GO xref abbs file use strict; use HTML::Template; use URI::Escape; use HTML::Entities; use CGI::Carp qw(fatalsToBrowser); use Data::Dumper; #my $template = HTML::Template->new(filename => 'xref.tmpl', path => [ '../', '', '../www']); my $template = HTML::Template->new(filename => 'xref.tmpl', path => [ '../html/doc']); #my $in = "../GO.xrf_abbs"; my $in = "../html/doc/GO.xrf_abbs"; my $spec = { abbreviation => {}, shorthand_name => { opt => 1, }, database => {}, description => { opt => 1 }, object => { opt => 1 }, synonym => { multi => 1, opt => 1 }, example_id => { multi => 1, opt => 1 }, # local_id_syntax => { opt => 1 }, generic_url => {}, url_syntax => { multi => 1, opt => 1 }, url_example => { multi => 1, opt => 1 }, is_obsolete => { opt => 1, }, consider => { multi => 1, opt => 1 }, replaced_by => { multi => 1, opt => 1 }, }; my $lines; # read the database file { $/ = "\n\n"; open(FH, $in) or die "Can't open file $in: $!"; @$lines = ; close FH; } if (! $lines || ! @$lines) { die "No xref data found in $in!"; } ## OK, let's parse the data my $data; foreach (@$lines) { next unless /^abbreviation:\s*\S+/m; my @temp = split("\n", $_); my $info; foreach my $a (@temp) { next if ($a !~ /[a-zA-Z]/ || $a =~ /^\!/ || $a !~ /:/); my ($b, $c) = split(/\s*:\s*/, $a, 2); next unless $c && $c =~ /\w/; $c =~ s/\s*$//g; if ($b =~ /url/) { if ($b eq 'url_syntax') { push @{$info->{$b}}, { txt => encode_entities($c) }; } else { push @{$info->{$b}}, { url => $c, txt => encode_entities($c) }; } } elsif ($b eq "example_id") { my ($db, $key) = split(":", $c, 2); if ($db =~ /\S/ && $key =~ /\S/) { push @{$info->{example_id}}, { db => $db, key => $key }; } else { warn "malformed example ID $c"; } } elsif (grep { $b eq $_ } qw(synonym replaced_by consider)) { if (exists $info->{$b}) { $info->{$b} .= ", $c"; } else { $info->{$b} = $c; } } elsif (exists $spec->{$b}) { if ($spec->{$b}{multi}) { push @{$info->{$b}}, $c; } elsif ($info->{$b}) { warn "$b $c: too many entries found"; } else { $info->{$b} = $c; } } } next unless $info && %$info; if (! exists $info->{abbreviation}) { warn "Found listing with no abbreviation:\n" . join("\n", @temp) . "\n"; next; } if (! $info->{database} || ! $info->{generic_url}) { warn "Missing critical data for " . $info->{abbreviation}; } my $id = lc( $info->{abbreviation} ); if ($data->{$id}) { warn "Duplicate listing for $id!"; next; } if ($info->{object} || $info->{example_id} || $info->{url_example} || $info->{url_syntax}) { $info->{data} = 1; } $data->{$id} = $info; } my $sorted; my $index; my $prev = ""; foreach (sort keys %$data) { my $first = substr($_, 0, 1); if ($first ne $prev) { $data->{$_}{anchor} = $first; push @$index, { id => $first, letter => uc($first) }; } $prev = $first; push @$sorted, $data->{$_}; } $template->param(refLoop => $sorted); $template->param(indexLoop => $index); # send the obligatory Content-Type print "Content-Type: text/html\n\n"; # print the template print $template->output; exit;