view release on metacpan or  search on metacpan

script/xml_to_pm.pl  view on Meta::CPAN

#!/usr/bin/perl -w
#
# builds the Astro::Constants modules from an xml definition file
# Boyd Duffee, Dec 2015
#
# hard coded to run from top directory and uses only data/PhysicalConstants.xml

use strict;
use autodie;
use Modern::Perl;
use XML::LibXML;

#die "Usage: $0 infile outfile" unless @ARGV == 1;

my ($tagname, );
my $dzil_methodtag = q{=method};

my $xml = XML::LibXML->load_xml(location => 'data/PhysicalConstants.xml');

my $lib = 'lib';	# where is the lib directory
mkdir "$lib/Astro/Constants" unless -d "$lib/Astro/Constants";
open my $ac_fh, '>:utf8', "$lib/Astro/Constants.pm";
open my $mks_fh, '>:utf8', "$lib/Astro/Constants/MKS.pm";
open my $cgs_fh, '>:utf8', "$lib/Astro/Constants/CGS.pm";

write_module_header($ac_fh, 'Astro::Constants');
write_module_header($mks_fh, 'Astro::Constants::MKS');
write_module_header($cgs_fh, 'Astro::Constants::CGS');

write_pod_synopsis($ac_fh);

for my $constant ( $xml->getElementsByTagName('PhysicalConstant') ) {
	my ($short_name, $long_name, $mks_value, $cgs_value, $values, $options, ) = undef;

	for my $name ( $constant->getChildrenByTagName('name') ) {
		$short_name = $name->textContent() if $name->getAttribute('type') eq 'short';
		$long_name = $name->textContent() if $name->getAttribute('type') eq 'long';
	}

	my $description = $constant->getChildrenByTagName('description')->shift()->textContent();
	for my $value ( $constant->getChildrenByTagName('value') ) {
		if ( $value->hasAttribute('system') ) {
			$values->{mks} = $value->textContent() if $value->getAttribute('system') eq 'MKS';
			$values->{cgs} = $value->textContent() if $value->getAttribute('system') eq 'CGS';
		}
		else {
			$values->{value} = $value->textContent();
			next;
		}
	}

	# recognise that there can be more than one alternateName
	my $alternate = undef;
	my @alternates = ();
	if ( $constant->getChildrenByTagName('alternateName') ) {
		for my $node ( $constant->getChildrenByTagName('alternateName') ) {
			$alternate = $node->textContent();
			next unless $alternate =~ /\S/;

			push @{$tagname->{alternates}}, $alternate;
			if ($node->hasAttribute('type') && $node->getAttribute('type') eq 'deprecated') {
				push @{$tagname->{deprecated}}, $alternate;
			}
			else {
				push @{$tagname->{long}}, $alternate;
			}
			push @alternates, $alternate;

			write_constant($mks_fh, ($values->{mks} || $values->{value}), $alternate) 
				if $values->{mks} || $values->{value};