#!/usr/local/bin/perl ############################################################################## # makedicthtml.pl - Perl script to generate HTML version of CIF dictionary # ############################################################################## # Usage: makedicthtml.pl -[version] [dictfile] # # where -[version] is DDL version (-1 or -2, -1 is default and can # # be omitted), and [dictfile] is a CIF dictionary file # # The results are written to a directory html/[version]/[xxx_yyy.dic]/ # # where [xxx_yyy.dic] is the name of the dictionary file advertised within # # the file as _dictionary_name (DDL1) or _dict.title (DDL2). Running titles # # for well known public dictionaries are stored in the %dictionaries hash, # # which may be augmented as desired. # ############################################################################## # Author: Brian McMahon bm@iucr.org # # copyright (c) International Union of Crystallography 2005 # ############################################################################## use STAR::Parser; use STAR::DataBlock; use STAR::Dictionary; use Getopt::Std; use lib qw(/pkg/wdc/perl /pkg/sgml/utilities/perl/lib/site_perl/5.005); use strict; use vars qw($opt_d $opt_D $opt_l $opt_s $opt_1 $opt_2 $opt_f); use vars qw($version $options $dict $dictionary $dblock $verbose $ddl); use vars qw($dictname $dictversion $dicthistory); use vars qw($ROOTDIR $workdir ); use vars qw($symctr); # counts no. elements per line (_diffrn_source.target) use vars qw(%dictionaries $dicttitle); # names of dictionaries %dictionaries = ( "cif_core.dic"=>"Core dictionary (coreCIF)", "cif_ms.dic"=>"Modulated and composite structures dictionary (msCIF)", "cif_pd.dic"=>"Powder dictionary (pdCIF)", "cif_rho.dic"=>"Electron density dictionary (rhoCIF)", "cif_mm.dic"=>"Macromolecular dictionary (mmCIF)", "mmcif_std.dic"=>"Macromolecular dictionary (mmCIF)", "mmcif_pdbx.dic"=>"Protein Data Bank exchange dictionary (pdbx)", "cif_img.dic"=>"Image dictionary (imgCIF)", "cif_sym.dic"=>"Symmetry dictionary (symCIF)", "ddl_core.dic"=>"DDL dictionary", "ddl_core"=>"DDL dictionary", "mif_core.dic"=>"Molecular Information File dictionary (MIF)", ); $version = "version 0.01"; $ROOTDIR = "./cifdic_html"; # Parent directory for html files $dictname = ''; $symctr = 0; # Version of DDL (can be 1 or 2) $ddl = 1; $verbose = 1; getopt(''); $options .= 'd' if ( $opt_d ); # debug $options .= 'l' if ( $opt_l ); # logfile $ddl = 1 if ( $opt_1 ); # DDL version $ddl = 2 if ( $opt_2 ); # DDL version # $dict = 1 if ( $opt_D ); #Dictionary $dict = 1; # by default (this is a dictionary-based application) my $file = $ARGV[0]; # DDL1 and DDL2 dictionaries are structured differently. For DDL1, every # definition (whether category or individual item) has its own datablock; # for DDL2 a single datablock includes all the definitions as a series of # saveblocks. The next call partitions the input file into data blocks (for # caution we assume there might be multiple datablocks corresponding to # different dictionaries in a DDL2 file). We name the resulting arrays # differently to keep this distinction in mind my @dblocks ; # DDL1 my @dicts ; # DDL2 if ($ddl == 1 ) { # DDL1 @dblocks = STAR::Parser->parse(-file=>$file, -dict=>$dict, -options=>$options); exit unless ( $#dblocks >= 0 ); # cut and run if nothing there } else { @dicts = STAR::Parser->parse(-file=>$file, -dict=>$dict, -options=>$options); exit unless ( $#dicts >= 0 ); # cut and run if nothing there } if ($ddl == 1 ) { # DDL1 # In DDL1 categories aren't explicit; instead, certain pseudo-definitions # imply a category description. We begin by working through the file # (collecting the dictionary name as we go) and storing all the item # names that by convention define a category my @categories = (); print STDERR "Handling DDL1 dictionary!\n"; my @categorynames = (); my @extracategorynames = (); my @blocknames = (); foreach $dblock (@dblocks) { # For each data block (usually many) # Get the dictionary name and version $dictname = ($dblock->get_item_data(-item=>"_dictionary_name"))[0] || $dictname ; $dictversion = ($dblock->get_item_data(-item=>"_dictionary_version"))[0] || $dictversion ; $dicthistory = ($dblock->get_item_data(-item=>"_dictionary_history"))[0] || $dicthistory ; $dicttitle = $dictionaries{$dictname} || 'Generic CIF Dictionary'; # Collect the data blocks that describe categories my $name = ($dblock->get_item_data(-item=>"_name"))[0]; my $assignedcategory = ($dblock->get_item_data(-item=>"_category"))[0]; $assignedcategory = "_" . $assignedcategory; # compare with categorynames if ($verbose) { print STDERR $name . "\n"; } # DEBUG # First we store categories defined in data blocks like data_atom_site_[] if ( $name =~ /\[[a-zA-Z0-9]*\]$/ ) { push (@categories, $dblock ); push (@categorynames, $name); } else { # but we also need to collect categories that are referenced but not # defined in this dictionary: we'll hoover them up from the _category # attributes, but need to make sure that we don't override any of the # definitions we've already collected (since we'll later need to # identify those for printing out) push (@extracategorynames, $assignedcategory) unless ( grep /^$assignedcategory$/, @extracategorynames # already seen or grep /^$assignedcategory$/, @categorynames # already seen or grep /^${assignedcategory}_\[.*\]$/, @categorynames # seen or $assignedcategory =~ /^category_overview$/ # category overview or $assignedcategory =~ /^_ *$/ ); # null (leading _ was added) } push (@blocknames, $name); $workdir = $ROOTDIR . "/" . $ddl . "/" . $dictname ; unless (-d $workdir) { mkdir ($workdir, 0775) || die "Couldn't make " . $workdir . "\n"; } } # end of foreach loop per included data block my $indexfile = $workdir . "/index.html"; open INDEX, ">$indexfile"; # Create the index file # print header HTML for file print INDEX ' '; print INDEX "(IUCr) ${dicttitle} definitions "; print INDEX standard_header(); if ($dictversion) { print INDEX "

$dicttitle version ${dictversion} definitions

"; } else { print INDEX "

$dicttitle definitions

"; } print INDEX " Definitions are arranged alphabetically by category and within category. \n";(); print INDEX standard_footer(); close INDEX; } # end of handler for DDL1 dictionaries elsif ($ddl == 2 ) { # DDL2 foreach $dictionary (@dicts) { # For each dictionary (usually one) # Get the dictionary name and version $dictname = ($dictionary->get_item_data(-item=>"_dictionary.title"))[0]; $dictversion = ($dictionary->get_item_data(-item=>"_dictionary.version"))[0]; $dicttitle = $dictionaries{$dictname} || 'Generic CIF Dictionary'; $workdir = $ROOTDIR . "/" . $ddl . "/" . $dictname ; unless (-d $workdir) { mkdir ($workdir, 0775) || die "Couldn't make " . $workdir . "\n"; } my $indexfile = $workdir . "/index.html"; open INDEX, ">$indexfile"; # Create the index file # print header HTML for file print INDEX ' '; print INDEX "(IUCr) ${dicttitle} definitions "; print INDEX standard_header(); if ($dictversion) { print INDEX "

$dicttitle version ${dictversion} definitions

"; } else { print INDEX "

$dicttitle definitions

"; } print INDEX " Definitions are arranged alphabetically by category and within category. \n";(); print INDEX standard_footer(); close INDEX; } # end of foreach loop per included dictionary } # end of handler for DDL2 dictionaries else { die "Do not know what version of DDL is in use!"; } exit; ######################################################################## # Output HTML formatting for a category block ######################################################################## ######################## DDL1 ########################################## sub format_category1 { my $categoryname = ($dblock->get_item_data(-item=>"_name"))[0]; my $label = $categoryname; $categoryname =~ s/^_+//; $categoryname =~ s/_\[[A-Za-z0-9]*\]$//; my $file = $workdir . "/" . "C" . $categoryname . ".html"; open (ENTRY, "> " . $file); # print header HTML for file print ENTRY ' '; print ENTRY "(IUCr) CIF Definition data${label} "; print ENTRY standard_header(); if ($dictversion) { print ENTRY "

Index

$dicttitle version ${dictversion}
"; } else { print ENTRY "

Index

$dicttitle
"; } print ENTRY "

Category " . uc($categoryname) . "

"; # Name foreach my $item ( # specifies ordering of output items "_name", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { if ( $#attributes == 0) { print ENTRY "\nName:
\n"; } else { print ENTRY "\nNames:
\n"; } foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } # Definition foreach my $item ( # specifies ordering of output items "_definition", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { #======================================================================== my $blockname = $dblock->title; $blockname =~ s/\//=over=/g; my @definitions = $dblock->get_item_data(-item=>$item); if ( $#definitions > 0) { print "WARNING! Multiple definitions returned for $blockname\n"; print " - ignoring all but first\n"; } my $definition = $definitions[0]; print ENTRY format_attribute($definition, $item); #======================================================================== } } } # Examples my @details = $dblock->get_item_data(-item=>"_example_detail"); my @example = $dblock->get_item_data(-item=>"_example"); if (@details) { die "Examples and accompanying details do not match!" unless ( $#example == $#details); } if (@example) { # only do the next bit if there are any! if ( $#example == 0) { print ENTRY "\nExample:

\n"; } else { print ENTRY "\nExamples:

\n"; } for (my $index = 0; $index <= $#example ; $index++) { print ENTRY "
"; if ($details[$index]) { print ENTRY format_attribute($details[$index],"_category_examples.detail") ; } print ENTRY format_attribute($example[$index], "_category_examples.case") ; print ENTRY "

\n"; } } # Type and category foreach my $item ( # specifies ordering of output items "_type", "_category", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { #======================================================================== my $blockname = $dblock->title; $blockname =~ s/\//=over=/g; my @definitions = $dblock->get_item_data(-item=>$item); if ( $#definitions > 0) { print "WARNING! Multiple definitions returned for $blockname\n"; print " - ignoring all but first\n"; } my $definition = $definitions[0]; print ENTRY format_attribute($definition, $item); #======================================================================== } } } # print footer HTML for file print ENTRY standard_footer(); close (ENTRY); return; } sub format_item1 { # my $saveblock = shift; my $multiple = shift || ''; my $itemname = ($dblock->get_item_data(-item=>"_name"))[0]; my $catname = ($dblock->get_item_data(-item=>"_category"))[0]; my $blockname = $dblock->title; my $label = $blockname; $label =~ s/^([^_])/_$1/; # prepend an underscore if missing $blockname =~ s/\//=over=/g; my $file = $workdir . "/" . "I" . $blockname . ".html"; open (ENTRY, "> " . $file); # print header HTML for file print ENTRY ' '; print ENTRY "(IUCr) CIF Definition data_${label} "; print ENTRY standard_header(); if ($dictversion) { print ENTRY "

Index

$dicttitle version ${dictversion}
"; } else { print ENTRY "

Index

$dicttitle
"; } print ENTRY "

" . $label . "

"; # Name foreach my $item ( # specifies ordering of output items "_name", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { if ( $#attributes == 0) { print ENTRY "\nName:
\n"; } else { print ENTRY "\nNames:
\n"; } foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); # Collect categories for use by other utilities my $categorylistfile = "/agatehome/bm/cifdic_perl/categorylist"; open (FILE, ">> " . $categorylistfile); print FILE "\"" . $attribute . "\"=>\"" . $catname . "\",\n"; close FILE; } } } #----------------------------------------------------------------------- # We search for related items twice, here and after the definition. At this # point we are interested only in '_related_function replace' so that we # can significantly change the presentation of the subsequent definition # Related items my @relname = $dblock->get_item_data(-item=>"_related_item"); my @relcode = $dblock->get_item_data(-item=>"_related_function"); die "Related names and codes do not match!" unless ( $#relname == $#relcode); if (@relname && (grep /^replace$/, @relcode) ) { # only if there are any! print ENTRY deprecated(); for (my $index = 0; $index <= $#relname; $index++) { next unless ($relcode[$index] =~ /^replace$/); print ENTRY format_attribute($relname[$index], "deprecated") ; } print ENTRY "

\n"; } # Definition foreach my $item ( # specifies ordering of output items "_definition", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { #======================================================================== my $blockname = $dblock->title; $blockname =~ s/\//=over=/g; my @definitions = $dblock->get_item_data(-item=>$item); if ( $#definitions > 0) { print "WARNING! Multiple definitions returned for $blockname\n"; print " - ignoring all but first\n"; } my $definition = $definitions[0]; print ENTRY format_attribute($definition, $item); #======================================================================== } } } # Examples my @details = $dblock->get_item_data(-item=>"_example_detail"); my @example = $dblock->get_item_data(-item=>"_example"); if (@details) { die "Examples and accompanying details do not match!" unless ( $#example == $#details); } if (@example) { # only do the next bit if there are any! if ( $#example == 0) { print ENTRY "\nExample:

\n"; } else { print ENTRY "\nExamples:

\n"; } for (my $index = 0; $index <= $#example ; $index++) { print ENTRY "
"; print ENTRY format_attribute($example[$index], "_example") ; #if ($details[$index]) { print ENTRY ""; print ENTRY format_attribute($details[$index],"_example_detail") ; #} print ENTRY "
\n"; } } #----------------------------------------------------------------------- # List membership, reference etc foreach my $item ( # specifies ordering of output items "_list", "_list_mandatory", "_list_level", "_list_reference", "_list_link_parent", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { my $counter = 0; # special wording for multiple cases foreach my $attribute (@attributes) { if ($item =~ /^_list_reference$/) { if ($counter > 0) { print ENTRY "   "; } else { print ENTRY " containing "; } $counter++; } print ENTRY format_attribute($attribute, $item); } } } #----------------------------------------------------------------------- # List link children my @children = $dblock->get_item_data(-item=>"_list_link_child"); if (@children) { # only do the next bit if there are any! print ENTRY "\n
May match subsidiary data name(s)
\n" ; for (my $index = 0; $index <= $#children; $index++) { my $child = $children[$index]; print ENTRY format_attribute($child, "_list_link_child"); } } #----------------------------------------------------------------------- # Numerical ranges my @ranges = $dblock->get_item_data(-item=>"_enumeration_range"); if (@ranges) { # only do the next bit if there is a range! for (my $index = 0; $index <= $#ranges; $index++) { my $range = $ranges[$index]; $range =~ s/^:$/-infinity -> infinity/g; $range =~ s/:$/ -> infinity/g; $range =~ s/^:/-infinity -> /g; $range =~ s/:/ -> /g; print ENTRY "\n
The permitted range is " . $range ; if ($index > 2) { print "% WARNING! More than three range values\n"; } } } #----------------------------------------------------------------------- # Second pass at related items - we keep those that aren't "replace" # Related items my @relname = $dblock->get_item_data(-item=>"_related_item"); my @relcode = $dblock->get_item_data(-item=>"_related_function"); die "Related names and codes do not match!" unless ( $#relname == $#relcode); if (@relname) { # only do the next bit if there are any! if ($#relname == 0 ) { print ENTRY "\n

Related item: "; } else { print ENTRY "\n

Related items : "; } for (my $index = 0; $index <= $#relname; $index++) { next if ($relcode[$index] =~ /^replace$/); print ENTRY format_attribute($relname[$index], "_related_item") ; print ENTRY format_attribute($relcode[$index],"_related_function") ; } } #----------------------------------------------------------------------- # Enumeration my @enumval = $dblock->get_item_data(-item=>"_enumeration"); my @enumdtl = $dblock->get_item_data(-item=>"_enumeration_detail"); if (@enumdtl) { die "Examples and accompanying details do not match!" unless ( $#enumval == $#enumdtl); } if (@enumval) { # only do the next bit if there are any! print ENTRY "\n
The data value must be one of the following:

\n"; if ($blockname =~ /^(diffrn_source_target|atom_local_axes_ax[12])$/ ) { print ENTRY ""; for (my $index = 0; $index <= $#enumval ; $index++) { my $symbol = $enumval[$index]; if ($symbol =~ /^[A-Z]$/ ) { $symbol .= ' ' ; } print ENTRY "\n"; $symctr++; if ($symctr > 14) { print ENTRY "\n"; $symctr = 0; } } print ENTRY "
" . format_attribute($symbol, "_enumeration" ) . "
\n"; } else { for (my $index = 0; $index <= $#enumval ; $index++) { print ENTRY "
"; print ENTRY format_attribute($enumval[$index], "_enumeration" ) ; print ENTRY ""; print ENTRY format_attribute($enumdtl[$index],"_enumeration_detail") ; print ENTRY "
\n"; } } } #----------------------------------------------------------------------- # Enumeration default foreach my $item ( "_enumeration_default", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } # Category foreach my $item ( # specifies ordering of output items "_type", "_category", ) { my @attributes = $dblock->get_item_data(-item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } # print footer HTML for file print ENTRY standard_footer(); close (ENTRY); return; } ######################################################################## # Rather basic subroutine just to handle the DDL1 revision history ######################################################################## sub print_revision_history { my $file = $workdir . "/" . "Dhistory.html"; open (ENTRY, "> " . $file); # print header HTML for file print ENTRY ' '; print ENTRY "(IUCr) CIF dictionary $dictname revision history "; print ENTRY standard_header(); if ($dictversion) { print ENTRY "

Index

$dicttitle version ${dictversion}
"; } else { print ENTRY "

Index

$dicttitle
"; } my $label = "Revision history"; print ENTRY "

" . $label . "

"; print ENTRY "\n
" . findlinks(htmlsafe($dicthistory)) . "
\n"; # print footer HTML for file print ENTRY standard_footer(); close (ENTRY); return; } ######################## DDL2 ########################################## sub format_category2 { my $saveblock = shift; my $categoryname = ($dictionary->get_item_data(-save=>$saveblock, -item=>"_category.id"))[0]; my $file = $workdir . "/" . "C" . $categoryname . ".html"; open (ENTRY, "> " . $file); # print header HTML for file print ENTRY ' '; print ENTRY "(IUCr) CIF Definition save_${categoryname} "; print ENTRY standard_header(); if ($dictversion) { print ENTRY "

Index

$dicttitle version ${dictversion}
"; } else { print ENTRY "

Index

$dicttitle
"; } print ENTRY "

Category " . uc($categoryname) . "

"; print ENTRY "\nName:
\n"; print ENTRY format_attribute($categoryname, "_category.id"); foreach my $item ( # specifies ordering of output items "_category.description", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } #----------------------------------------------------------------------- # Examples my @details = $dictionary->get_item_data(-save=>$saveblock, -item=>"_category_examples.detail"); my @example = $dictionary->get_item_data(-save=>$saveblock, -item=>"_category_examples.case"); if (@details) { die "Examples and accompanying details do not match!" unless ( $#example == $#details); } if (@example) { # only do the next bit if there are any! if ( $#example == 0) { print ENTRY "\nExample:

\n"; } else { print ENTRY "\nExamples:

\n"; } for (my $index = 0; $index <= $#example ; $index++) { print ENTRY "
"; if ($details[$index]) { my $eg = format_attribute($details[$index],"_category_examples.detail"); if ($saveblock =~ /^STRUCT_SHEET$/i) { $eg =~ s/(Example [0-9] - [a-zA-Z -]*)/$1.
/;
	  $eg =~ s/<\/i> *$/<\/pre><\/i>/;
	}
	print ENTRY $eg;
	# format_attribute($details[$index],"_category_examples.detail") ;
      }
      print ENTRY
	format_attribute($example[$index], "_category_examples.case") ;
      print ENTRY "

\n"; } } foreach my $item ( # specifies ordering of output items "_category_group.id", "_category_key.name", "_category.mandatory_code", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { if ( $#attributes == 0) { if ( $item =~ /^_category_group.id$/) { print ENTRY "\nCategory group:
\n"; } if ( $item =~ /^_category_key.name$/) { print ENTRY "\nCategory key:
\n"; } } else { if ( $item =~ /^_category_group.id$/) { print ENTRY "\nCategory groups:
\n"; } if ( $item =~ /^_category_key.name$/) { print ENTRY "\nCategory keys:
\n"; } } foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } # print footer HTML for file print ENTRY standard_footer(); close (ENTRY); return; } sub format_item2 { my $saveblock = shift; my $multiple = shift || ''; my $file ; ($file = $saveblock) =~ s/^_// ; $file =~ s/\//=over=/g; $file = $workdir . "/" . "I" . $file . ".html"; open (ENTRY, "> " . $file); # print header HTML for file print ENTRY ' '; print ENTRY "(IUCr) CIF Definition save_${saveblock} "; print ENTRY standard_header(); if ($dictversion) { print ENTRY "

Index

$dicttitle version ${dictversion}
"; } else { print ENTRY "

Index

$dicttitle
"; } print ENTRY "

" . $saveblock . "

"; my $itemname = ($dictionary->get_item_data(-save=>$saveblock, -item=>"_item.name"))[0]; # Text definition block #----------------------------------------------------------------------- if ($multiple) { # multiple item names occur in an id listing foreach my $item ( # specifies ordering of output items "_item.name", "_item_description.description", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { print ENTRY format_attribute($attributes[0], $item); } } } else { foreach my $item ( # specifies ordering of output items "_item.name", "_item_description.description", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } } #----------------------------------------------------------------------- # Examples my @example = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_examples.case"); my @details = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_examples.detail"); if (@details) { die "Examples and accompanying details do not match!" unless ( $#example == $#details); } if (@example) { # only do the next bit if there are any! if ($#example == 0 ) { print ENTRY "\nExample:

\n"; } else { print ENTRY "\nExamples:

\n"; } for (my $index = 0; $index <= $#example ; $index++) { print ENTRY "
"; print ENTRY # format_attribute(cifquote($example[$index]), "_item_examples.case" ) ; format_attribute($example[$index], "_example" ) ; ## if ($details[$index]) { print ENTRY ""; # print ENTRY format_attribute($details[$index],"_item_examples.detail") ; print ENTRY format_attribute($details[$index],"_example_detail") ; ## } print ENTRY "
\n"; } } #----------------------------------------------------------------------- # Further item attributes if ($multiple) { # multiple item names occur in an id listing foreach my $item ( # specifies ordering of output items "_item_type.code", "_item_type_conditions.code", "_item.mandatory_code", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { print ENTRY format_attribute($attributes[0], $item); } } } else { foreach my $item ( # specifies ordering of output items "_item_type.code", "_item_type_conditions.code", "_item.mandatory_code", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } } #----------------------------------------------------------------------- # Aliases my @aliasname = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_aliases.alias_name"); my @aliasdict = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_aliases.dictionary"); my @aliasvers = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_aliases.version"); warn "Alias names and dictionary references do not match ($saveblock)!" unless ( $#aliasname == $#aliasdict); if (@aliasname) { # only do the next bit if there are any! if ( $#aliasname == 0) { print ENTRY "\nAlias:\n"; } else { print ENTRY "\nAliases:

\n"; } for (my $index = 0; $index <= $#aliasname; $index++) { # print ENTRY # format_attribute($aliasname[$index], "_item_aliases.alias_name") ; if ($aliasdict[$index]) { print ENTRY "\n
" . linkalias(htmlsafe($aliasname[$index]), $aliasdict[$index]) . "\n"; print ENTRY "(" . format_attribute($aliasdict[$index],"_item_aliases.dictionary") ; if ($aliasvers[$index]) { print ENTRY format_attribute($aliasvers[$index],"_item_aliases.version") ; } print ENTRY ")\n"; } else { print ENTRY format_attribute($aliasname[$index], "_item_aliases.alias_name") ; } } } #----------------------------------------------------------------------- # Parent/child links if ($multiple ) { # skip otherwise my @childname = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_linked.child_name"); if (@childname) { # only do the next bit if there are any! for (my $index = 0; $index <= $#childname; $index++) { print ENTRY format_attribute($childname[$index], "_item_linked.child_name") ; } } } #----------------------------------------------------------------------- # Numerical ranges my @rangemin = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_range.minimum"); my @rangemax = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_range.maximum"); die "Maximum and minimum ranges have different sizes!" unless ( $#rangemin == $#rangemax); if (@rangemin) { # only do the next bit if there is a range! # the starting max, min values are based on the usual arrangement in # mmCIF of giving these in descending order; but it shouldn't matter # to the sorting algorithm my $low = $rangemin[$#rangemin]; my $high = $rangemax[0]; my $floor = 0; my $ceil = 0; for (my $index = 0; $index <= $#rangemin; $index++) { my $min = $rangemin[$index]; my $max = $rangemax[$index]; # Logic: test first for min = '.' If it is and max = '.' then you # have an open interval from minus to plus infinity if ($min eq '.' ) { $low = '-infinity'; $floor = 0; if ($max eq '.' ){ $high = 'infinity'; $ceil = 0; } else { # ... but if max is a numeric value test whether it's the largest # seen so far, and assign it as highest if need be if ($max > $high) { $high = $max } } } else { # On the other hand, if min is a numeric value, then test whether # it's the lowest if ($min <= $low) { $low = $min; if ( $min == $max ) { $floor = 1; } } else { if ($max >= $high) { $high = $max; if ( $min == $max ) { $ceil = 1; } } } if ($max eq '.' ){ $high = 'infinity'; $ceil = 0; } } if ($index > 2) { print "% WARNING! More than three range values\n"; } } print ENTRY "\n
The permitted range is " ; if ($floor) { print ENTRY "["; } else { print ENTRY "("; } print ENTRY $low . ", " . $high; if ($ceil) { print ENTRY "]"; } else { print ENTRY ")"; } print ENTRY "
\n"; } #----------------------------------------------------------------------- # Related items my @relname = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_related.related_name"); my @relcode = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_related.function_code"); die "Related names and codes do not match!" unless ( $#relname == $#relcode); if (@relname) { # only do the next bit if there are any! if ($#relname == 0 ) { print ENTRY "\n

Related item: "; } else { print ENTRY "\n

Related items: "; } for (my $index = 0; $index <= $#relname; $index++) { print ENTRY format_attribute($relname[$index], "_related_item") ; # format_attribute($relname[$index], "_item_related.related_name") ; print ENTRY format_attribute($relcode[$index],"_related_function") ; # format_attribute($relcode[$index],"_item_related.function_code") ; } } #----------------------------------------------------------------------- # Enumeration my @enumval = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_enumeration.value"); my @enumdtl = $dictionary->get_item_data(-save=>$saveblock, -item=>"_item_enumeration.detail"); if (@enumdtl) { die "Examples and accompanying details do not match!" unless ( $#enumval == $#enumdtl); } if (@enumval) { # only do the next bit if there are any! print ENTRY "\n
The data value must be one of the following:

\n"; if ($saveblock =~ /^_diffrn.source\.target$/ ) { $symctr = 0; for (my $index = 0; $index <= $#enumval ; $index++) { my $symbol = $enumval[$index]; if ($symbol =~ /^[A-Z]$/ ) { $symbol .= ' '; } print ENTRY "" . format_attribute($symbol, "_enumeration" ) . "\n"; $symctr++; if ($symctr > 14) { print ENTRY "\n"; $symctr = 0; } } } elsif ($saveblock =~ /^_space_group\.name_Schoenflies$/ ) { print ENTRY ""; $symctr = 0; for (my $index = 0; $index <= $#enumval ; $index++) { my $symbol = sprintf("%-6s", $enumval[$index]); print ENTRY "\n"; $symctr++; if ($symctr > 6) { print ENTRY "\n"; $symctr = 0; } } print ENTRY "
" . format_attribute($symbol, "_enumeration" ) . "
\n"; } elsif ($saveblock =~ /^_space_group_Wyckoff\.letter$/ ) { print ENTRY ""; $symctr = 0; for (my $index = 0; $index <= $#enumval ; $index++) { my $symbol = $enumval[$index]; if ($symbol =~ /^[A-Z]$/ ) { $symbol .= ' '; } print ENTRY "\n"; $symctr++; if ($symctr > 14) { print ENTRY "\n"; $symctr = 0; } } print ENTRY "
" . format_attribute($symbol, "_enumeration" ) . "
\n"; # } elsif ($saveblock =~ /^_space_group\.name_H-M_ref$/ ) { # print "\\begin{tabular}{llll}\n"; # $symctr = 0; # for (my $index = 0; $index <= $#enumval ; $index++) { # my $text = ''; # my $symbol = $enumval[$index]; # print "{\\obeyspaces\\fontsize{9}{10pt}\\selectfont\\texttt{" # . $symbol . ' ' . "}} & %\n"; # # if ($enumdtl[$index]) { # # parse the argument to detect the Schoenflies symbol and format # my $d = $enumdtl[$index]; # my $a; # my $b; # ($a = $d) =~ s/^( *[0-9]* *)(.*)$/$1/; # ($b = $d) =~ s/^( *[0-9]* *)(.*)$/$2/; # my $c = $a . " " . Schoenflies($b); # print "{\\fontsize{9}{10pt}\\selectfont{" . $c . "}}"; # $symctr++; # if ($symctr > 1) { # print " \\\\ %\n"; # $symctr = 0; # } else { print " & %\n"; } # } # } # print "\\end{tabular}\n"; # } elsif ($saveblock =~ /^_space_group\.reference_setting$/ ) { # print "\\begin{tabular}{ll}\n"; # $symctr = 0; # for (my $index = 0; $index <= $#enumval ; $index++) { # my $text = ''; # my $symbol = $enumval[$index]; # print "{\\obeyspaces\\fontsize{9}{10pt}\\selectfont\\texttt{" # . $symbol . ' ' . "}} & %\n"; # # if ($enumdtl[$index]) { # # parse the argument to detect the Schoenflies symbol and format # my $d = $enumdtl[$index]; # my $a; # my $b; # ($a = $d) =~ s/^( *[A-Za-z0-9\.]* *)(.*)$/$1/; # ($b = $d) =~ s/^( *[A-Za-z0-9\.]* *)(.*)$/$2/; # my $c = Schoenflies($a) . "\\quad " . HM($b); # print "{\\fontsize{9}{10pt}\\selectfont{" . $c . "}}"; # # $symctr++; # # if ($symctr > 1) { # print " \\\\ %\n"; # # $symctr = 0; # # } else { print " & %\n"; } # } # } # print "\\end{tabular}\n"; } else { if ($saveblock =~ /^_space_group\.name_H-M_ref$/ ) { print ENTRY '
Enumeration Number and Schoenflies symbol
'; } for (my $index = 0; $index <= $#enumval ; $index++) { print ENTRY "
"; print ENTRY format_attribute(cifquote($enumval[$index]), "_enumeration" ) ; print ENTRY ""; print ENTRY format_attribute($enumdtl[$index],"_enumeration_detail") ; print ENTRY "
\n"; } } } #----------------------------------------------------------------------- # Enumeration default foreach my $item ( "_item_default.value", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); } } } #----------------------------------------------------------------------- foreach my $item ( # specifies ordering of output items "_item.category_id", ) { my @attributes = $dictionary->get_item_data(-save=>$saveblock, -item=>$item); if ($multiple) { # multiple categories occur in an id listing # print "[DEBUG]: Multiple category entries for $saveblock\n"; print ENTRY format_attribute($attributes[0], $item); } else { if ( $#attributes >= 0) { foreach my $attribute (@attributes) { print ENTRY format_attribute($attribute, $item); # # Collect categories for use by other utilities # my $categorylistfile = "/agatehome/bm/cifdic_perl/categorylist"; # open (FILE, ">> " . $categorylistfile); # print FILE "\"" . $itemname . "\"=>\"" . $attribute . "\",\n"; # close FILE; } } } } # print footer HTML for file print ENTRY standard_footer(); close (ENTRY); return; } ######################## DDL-independent ############################### ######################################################################## # Format individual attribute text (modifications depend on the # type of item) ######################################################################## sub format_attribute { my $attribute = shift; my $item = shift; my $text = ''; if ($item =~ /^_name$/) { $text = "'" . htmlsafe($attribute) . "' "; } elsif ($item =~ /^_category\.id$/) { $text = "'" . htmlsafe($attribute) . "' "; } elsif ($item =~ /^_category\.description$/) { $attribute =~ s/^ / /; $text = "\n

Description:

\n"
      . findlinks(htmlsafe($attribute)) . "\n
"; # . leftpad(findlinks(htmlsafe($attribute)), 6) . "\n

"; } elsif ($item =~ /^_category\.mandatory_code$/) { $text = "\n

Mandatory category: " . htmlsafe($attribute) . "

\n"; } elsif ($item =~ /^_category_group\.id$/) { $text = "\n    " . htmlsafe($attribute) . "
\n"; } elsif ($item =~ /^_category_key\.name$/) { $text = "\n    " . htmlsafe($attribute) . "
\n"; } elsif ($item =~ /^(_definition|_item_description\.description)$/) { $attribute =~ s/^ / /; $text = "\n

Definition:

\n"
      . findlinks(htmlsafe($attribute)) . "\n
"; # . leftpad(findlinks(htmlsafe($attribute)), 6) . "\n

"; } elsif ($item =~ /^_category_examples\.case$/) { $text = "
\n " . htmlsafe($attribute)
      . "\n

"; } elsif ($item =~ /^_category_examples\.detail$/) { $text = "\n " . htmlsafe($attribute) . "\n"; } elsif ($item =~ /^_item_aliases\.dictionary$/) { $text = htmlsafe($attribute) ; } elsif ($item =~ /^_item_aliases\.alias_name$/) { $text = "\n
" . htmlsafe($attribute) . "\n"; } elsif ($item =~ /^_item_aliases\.version$/) { $text = "\nversion " . htmlsafe($attribute) ; } elsif ($item =~ /^_item_linked\.child_name$/) { $text = linkitem(htmlsafe($attribute)) . "
\n" ; } elsif ($item =~ /^_item\.category_id$/) { $text = "\n

Category: " . linkcategory(htmlsafe($attribute)) . "

\n"; } elsif ($item =~ /^_item\.mandatory_code$/) { $text = "\n

Mandatory item: " . htmlsafe($attribute) . "

\n"; } elsif ($item =~ /^_item\.name$/) { $text = "Name:
'" . htmlsafe($attribute) . "' "; } elsif ($item =~ /^_item_type\.code/) { $text = "\n

Type: " . htmlsafe($attribute) . "

\n"; } elsif ($item =~ /^_item_type_conditions\.code$/) { $text = "\n

Type conditions: " . htmlsafe($attribute) . "

\n"; } elsif ($item =~ /^_category$/) { $text = "\n

Category: " . linkcategory(htmlsafe($attribute)) . "

\n"; } elsif ($item =~ /^_enumeration$/) { $text = "\n
" . htmlsafe($attribute) . "\n"; } elsif ($item =~ /^_enumeration_detail$/) { $text = " " . htmlsafe($attribute) . "\n"; } elsif ($item =~ /^(_enumeration_default|_item_default\.value)$/) { $text = "\n
Enumeration default: " . htmlsafe($attribute); } elsif ($item =~ /^_example$/) { if ($attribute =~ /\n/ ) { $text = "
" . cifquote(htmlsafe($attribute))
	. "
\n"; } else { $text = "" . cifquote(htmlsafe($attribute)) . "\n"; } } elsif ($item =~ /^_example_detail$/) { $text = "" . htmlsafe($attribute) . "\n"; } elsif ($item =~ /^_list$/) { if ($attribute =~ /^yes$/) { $text = "\n

Appears in list "; } if ($attribute =~ /^both$/) { $text = "\n

May appear in list "; } if ($attribute =~ /^no$/) { $text = "\n

Does not appear in list "; } } elsif ($item =~ /^_list_level$/) { if ($attribute =~ /^yes$/) { $text = "as essential element of loop structure "; } } elsif ($item =~ /^_list_link_child$/) { $text = linkitem(htmlsafe($attribute)) . "
\n" ; } elsif ($item =~ /^_list_link_parent$/) { $text = "

Must match data name" . linkitem(htmlsafe($attribute)) . "

\n" ; } elsif ($item =~ /^_list_mandatory$/) { if ($attribute =~ /^yes$/) { $text = "as essential element of loop structure "; } } elsif ($item =~ /^_list_reference$/) { $text = linkitem(htmlsafe($attribute)); } elsif ($item =~ /^_related_function$/) { $text = " (" . linkitem(htmlsafe($attribute)) . ")
\n"; } elsif ($item =~ /^_related_item$/) { $text = linkitem(htmlsafe($attribute)); } elsif ($item =~ /^_type$/) { $text = "\n

Type: " . htmlsafe($attribute) . "

\n"; } elsif ($item =~ /^deprecated$/) { $text = "'" . linkitem(htmlsafe($attribute)) . "' "; } # Default - no specific transformation else { $text = htmlsafe($attribute); } return $text; } # hyperlink to definition of related item sub linkitem { my $item = shift; my $popup = shift || ''; my $string = $item; my $link; my $target; # the input string may well have been htmlised - reverse this chomp ($string); $string =~ s/\<//g; $string =~ s/\&/\&/g; # We're searching for a file to hyperlink to. We'll start by looking in # the current directory (for definitions in the current dictionary). If # that doesn't work, we'll look at other dictionaries also # Since it's an item, it will be named something like Icell_volume.html ($target = $item) =~ s/^_/I/; $target =~ s/$/.html/; $target =~ s/\//=over=/g; opendir (DIR, $workdir); while (defined(my $file = readdir(DIR))) { next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $target; $link = $target; } closedir(DIR); # If that didn't work, we'll try again, but chop off the last component # of the name because we're looking for a set of common definitions my $newtarget; ($newtarget = $target) =~ s/_([^_])*\.html/_.html/; opendir (DIR, $workdir); while (defined(my $file = readdir(DIR))) { next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $newtarget; $link = $newtarget; } closedir(DIR); # If we've had no luck, we'll check other dictionaries of the same DDL unless ($link) { opendir (DIR, $workdir . "/.."); while (defined(my $subdir = readdir(DIR))) { next if ($link) ; # Bail out if we've now found it! next if ($subdir =~ /^\.\.?$/); # skip '.' and '..' # next unless (-d $workdir . "/../" . $subdir); # skip unless directory opendir (SUBDIR, $workdir . "/../" . $subdir); while (defined(my $file = readdir(SUBDIR))) { next if ($link) ; # Bail out if we've now found it! next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $target; $link = "../" . $subdir . "/" . $target; if ($verbose) {print " Found link in other dictionary at $link\n";} } closedir(SUBDIR); } closedir(DIR); } # If still no luck, we'll try the trick of chopping off the last part again unless ($link) { opendir (DIR, $workdir . "/.."); while (defined(my $subdir = readdir(DIR))) { next if ($link) ; # Bail out if we've now found it! next if ($subdir =~ /^\.\.?$/); # skip '.' and '..' # next unless (-d $workdir . "/../" . $subdir); # skip unless directory opendir (SUBDIR, $workdir . "/../" . $subdir); while (defined(my $file = readdir(SUBDIR))) { next if ($link) ; # Bail out if we've now found it! next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $newtarget; $link = "../" . $subdir . "/" . $newtarget; if ($verbose) {print " Found link in other dictionary at $link\n";} } closedir(SUBDIR); } closedir(DIR); } if ($link) { if ($popup) { return "" . $item . ""; } else { return "" . $item . ""; } } else { return $item; } } # hyperlink to definition of alias - like linkitem, but can traverse DDLs sub linkalias { my $item = shift; my $dict = shift; my $popup = 'yes'; my $string = $item; my $link; my $target; # the input string may well have been htmlised - reverse this chomp ($string); $string =~ s/\<//g; $string =~ s/\&/\&/g; # We're searching for a file to hyperlink to. We'll start by searching # for a directory with the right dictionary name foreach my $ddl (2, 1) { my $ddldir = $workdir . "/../../" . $ddl; opendir (DDL, $ddldir); while (defined(my $dir = readdir(DDL))) { next if ($dir =~ /^\.\.?$/); # skip '.' and '..' next unless $dir eq $dict; # Since it's an item, it will be named something like Icell_volume.html ($target = $item) =~ s/^_/I/; $target =~ s/$/.html/; $target =~ s/\//=over=/g; opendir (DIR, $workdir . "/../../" . $ddl . "/" . $dir) ; while (defined(my $file = readdir(DIR))) { next if $link; next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $target; $link = "../../". $ddl . "/" . $dir . "/" . $target; } closedir(DIR); next if ($link); # If that didn't work, we'll try again, but chop off the last component # of the name because we're looking for a set of common definitions my $newtarget; ($newtarget = $target) =~ s/_([^_])*\.html/_.html/; opendir (DIR, $workdir . "/../../" . $ddl . "/" . $dir) ; while (defined(my $file = readdir(DIR))) { next if $link; next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless $file eq $newtarget; $link = "../../" . $ddl . "/" . $dir . "/" . $newtarget; } closedir(DIR); closedir(DDL); } } if ($link) { if ($verbose) {print STDERR " Found alias as $link\n";} return "" . $item . ""; } else { return $item; } # if ($link) { # if ($popup) { # return "" #. $item . ""; # } else { # return "" . $item . ""; # } # } else { # return $item; # } } # hyperlink to definition of category sub linkcategory { my $item = shift; my $string = $item; my $link; my $target; # the input string may well have been htmlised - reverse this chomp ($string); $string =~ s/\<//g; $string =~ s/\&/\&/g; # We're searching for a file to hyperlink to. We'll start by looking in # the current directory (for definitions in the current dictionary). If # that doesn't work, we'll look at other dictionaries also # Since it's a category, it will be named something like Ccell.html ($target = $item) =~ s/^/C/; $target =~ s/$/.html/; opendir (DIR, $workdir); while (defined(my $file = readdir(DIR))) { next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless lc($file) eq lc($target); $link = $file; } closedir(DIR); # If we've had no luck, we'll check other dictionaries of the same DDL unless ($link) { opendir (DIR, $workdir . "/.."); while (defined(my $subdir = readdir(DIR))) { next if ($link) ; # Bail out if we've now found it! next if ($subdir =~ /^\.\.?$/); # skip '.' and '..' # next unless (-d $workdir . "/../" . $subdir); # skip unless directory opendir (SUBDIR, $workdir . "/../" . $subdir); while (defined(my $file = readdir(SUBDIR))) { next if ($link) ; # Bail out if we've now found it! next if ($file =~ /^\.\.?$/); # skip '.' and '..' next unless lc($file) eq lc($target); $link = "../" . $subdir . "/" . $file; if ($verbose) {print " Found link in other dictionary at $link\n";} } closedir(SUBDIR); } closedir(DIR); } if ($link) { return "" . $item . ""; } else { return $item; } } # Find links in a string sub findlinks { my $string = shift; $string =~ s/\b(_[^ \t]*[\.,;:'")]?)\b/linkitem($1)/mge; $string =~ s/\b([A-Za-z][A-Za-z]*_[^ \t]*[\.,;:'"]?)\b/linkcategory($1)/mge; return $string; } # Boilerplate HTML fragments sub standard_header { my $text = '

INTERNATIONAL TABLES

for CRYSTALLOGRAPHY

Volume G

Definition and Exchange of Crystallographic Data
Contents Resources Specifications Dictionaries Software
'; return $text; } sub standard_footer { my $text = '

Copyright © 2005 International Union of Crystallography

'; return $text; } sub deprecated { my $text = '

This definition has been superseded and is retained here only for archival purposes. Use instead '; return $text; } # Some HTML transformations sub htmlsafe { my $string = shift; $string =~ s/\&/\&/g; $string =~ s/