1#!/usr/bin/perl -w 2 3use strict; 4use XML::Parser; 5 6###### global ############################ 7 8my $xml; # master message file 9my %msg = (); # messages 10my %desc = (); # description 11my @inc = (); # include files 12my $msgfile = "hecmw_msg_table.c"; 13my $msgnofile = "hecmw_msgno.h"; 14my $msgnofile_fortran = "hecmw_msgno_f.f90"; 15 16my $msg_table = 0; 17my $include = 0; 18my $table = 0; 19my $define = 0; 20my $message = 0; 21my $description = 0; 22my $chars = ""; 23my $desc_chars = ""; 24my $prefix = ""; 25my $name = ""; 26my $msgno_base = 0; 27my $parser; 28my $including = 0; 29 30###### main ###################### 31 32if($#ARGV+1 != 1) { 33 print STDERR "Usage: msg_setup.pl xmlfile\n"; 34 exit 1; 35} 36($xml) = @ARGV; 37$parser = &init; 38$parser->parsefile($xml); 39if(@inc) { 40 $including = 1; 41} 42foreach (@inc) { 43 $parser->parsefile($_); 44} 45&create; 46 47 48###### init ###################### 49 50sub init { 51 my $p = new XML::Parser(Handlers => { Start => \&start_element, 52 End => \&end_element, 53 Char => \&characters, 54 }); 55 56 return $p; 57} 58 59 60sub start_element { 61 my ($expat, $element, %attr) = @_; 62 if($element eq 'msg-table') { 63 $msg_table = 1; 64 if(!$including) { 65 $msgno_base = $attr{"msgno_base"}; 66 die "Validation Error: atribute 'msgno_base' required in msg-table\n" if(!$msgno_base); 67 } 68 } elsif($element eq 'include') { 69 die "Validation Error\n" if(!$msg_table); 70 $include = 1; 71 if($attr{"src"} && $including) { 72 die "Validation Error: now allow 'src' in include file\n"; 73 } 74 push(@inc, $attr{"src"}); 75 } elsif($element eq 'table') { 76 die "Validation Error\n" if(!$msg_table); 77 $table = 1; 78 $prefix = $attr{"prefix"}; 79 } elsif($element eq 'define') { 80 die "Validation Error\n" if(!$msg_table || !$table); 81 $define = 1; 82 $name = $attr{"name"}; 83 } elsif($element eq 'message') { 84 die "Validation Error\n" if(!$msg_table || !$table || !$define); 85 $message = 1; 86 $chars = ""; 87 } elsif($element eq 'description') { 88 die "Validation Error\n" if(!$msg_table || !$table || !$define || $message); 89 $description = 1; 90 $desc_chars = ""; 91 } else { 92 die "Unknown element $element\n"; 93 } 94} 95 96sub end_element { 97 my ($expat, $element) = @_; 98 if($element eq 'msg-table') { 99 $msg_table = 0; 100 } elsif($element eq 'include') { 101 $include = 0; 102 } elsif($element eq 'table') { 103 $table = 0; 104 } elsif($element eq 'define') { 105 $define = 0; 106 my $msgno; 107 if($prefix) { 108 $msgno = $prefix . "-" . $name; 109 } else { 110 $msgno = $name; 111 } 112 if($msg{$msgno}) { 113 die "Redefinition of '$msgno' in message table\n"; 114 } 115 $msg{$msgno} = $chars; 116 } elsif($element eq 'message') { 117 $message = 0; 118 } elsif($element eq 'description') { 119 $description = 0; 120 my $msgno; 121 if($prefix) { 122 $msgno = $prefix . "-" . $name; 123 } else { 124 $msgno = $name; 125 } 126 if($desc{$msgno}) { 127 die "Redefinition of '$msgno' in message table\n"; 128 } 129 } else { 130 die "Unknown element $element\n"; 131 } 132} 133 134sub characters { 135 my ($expat, $data) = @_; 136 if($message) { 137 $chars .= $data; 138 } elsif($description) { 139 $desc_chars .= $data; 140 } 141} 142 143 144###### replace ############################ 145 146sub create { 147 my $no = $msgno_base+1; 148 my $key; 149 my $value; 150 my $descmsg; 151 152 if(!open MSGFILE, ">$msgfile") { 153 print STDERR "ERROR: Fail to open $msgfile\n"; 154 exit $!; 155 } 156 if(!open MSGNOFILE, ">$msgnofile") { 157 print STDERR "ERROR: Fail to open $msgnofile\n"; 158 exit $! 159 } 160 if(!open MSGNOFILEF, ">$msgnofile_fortran") { 161 print STDERR "ERROR: Fail to open $msgnofile_fortran\n"; 162 exit $! 163 } 164 165print MSGFILE <<END_OF_MSGFILE_HEADER; 166 167#include <stdio.h> 168#include "hecmw_msg.h" 169 170struct hecmw_msgent hecmw_msg_table[] = { 171END_OF_MSGFILE_HEADER 172 173print MSGNOFILE <<END_OF_MSGNOFILE_HEADER; 174 175#ifndef HECMW_MSGNO_INCLUDED 176#define HECMW_MSGNO_INCLUDED 177 178#define HECMW_MSGNO_BASE $msgno_base 179 180END_OF_MSGNOFILE_HEADER 181 182print MSGNOFILEF <<END_OF_MSGNOFILEF_HEADER; 183module hecmw_msgno 184 use hecmw_util 185 186END_OF_MSGNOFILEF_HEADER 187 188 foreach $key (sort keys %msg) { 189 $value = $msg{$key}; 190 $descmsg = $desc{$key}; 191 $_ = $key; 192 s/-/_/g; 193 print MSGFILE "\t{$_,\"$key\",\"$value\"},\n"; 194 print MSGNOFILE "/** $descmsg */\n" if $descmsg; 195 print MSGNOFILE "#define $_ $no\n"; 196 print MSGNOFILEF " integer(kind=kint),parameter :: $_ = $no\n"; 197 $no++; 198 } 199 200print MSGFILE <<END_OF_MSGFILE_FOOTER; 201 {-1,NULL,NULL} 202}; 203END_OF_MSGFILE_FOOTER 204 205print MSGNOFILE <<END_OF_MSGNOFILE_FOOTER; 206 207#endif 208END_OF_MSGNOFILE_FOOTER 209 210print MSGNOFILEF <<END_OF_MSGNOFILEF_FOOTER; 211 212end module hecmw_msgno 213END_OF_MSGNOFILEF_FOOTER 214 215 close MSGFILE; 216 close MSGNOFILE; 217 close MSGNOFILEF; 218} 219 220