The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/local/bin/perl
# 
# Copyright (c) 1998 Michael Koehne <kraehe@copyleft.de>
# 
# XML::Edifact is free software. You can redistribute and/or
# modify this copy under terms of GNU General Public License.

=head1 NAME

create_codes - read uncl to create code data

=head1 SYNOPSIS

./bin/create_codes.pl

=head1 DESCRIPTION

Read UNCL to create codes.txt and codes.dat for further processing

=cut

open (OUTFILE, ">".File::Spec->catdir("html","LIB","xml-edifact-03","codes.txt") ) || die "can not open codes.txt for writing";

open (INFILE, "un_edifact_d96b/uncl-1.96b") || die "can not open uncl-1.96b for reading";
printf STDERR "reading uncl-1.96b\n";
while (<INFILE>) { read_code("uncl"); };
close(INFILE);
print STDERR "\n";

open (INFILE, "un_edifact_d96b/uncl-2.96b") || die "can not open uncl-2.96b for reading";
printf STDERR "reading uncl-2.96b\n";
while (<INFILE>) { read_code("uncl"); };
close(INFILE);
print STDERR "\n";

#$verbose=1;
open (INFILE, "un_edifact_d96b/unsl.96b") || die "can not open unsl.96b for reading";
printf STDERR "reading unsl.96b\n";
while (<INFILE>) { read_code("unsl"); };
close(INFILE);
print STDERR "\n";

close(OUTFILE);

sub read_code {
    my ($codelist) = @_;
    chop;	# strip record separator
    if (!($. % 64)) {
	printf STDERR '.' unless $verbose;
    }

    $ok = 0;

    if ($_ =~ '^[+*#|X -] [0-9][0-9][0-9][0-9]  ') {
	$cod = substr($_, 2, 4);
	$des = substr($_, 8);
	$s = '^ *', $des =~ s/$s//;
	$s = " *\$", $des =~ s/$s//;
	$fld = '';
	$ok = 1;
    }
    elsif (($_ =~ '^[+*#|X -][+*#|X -] [0-9A-Z ][0-9A-Z ][0-9A-Z ][0-9A-Z ][0-9A-Z ][0-9A-Z] ')
        || ($_ =~ '^[+*#|X -][+*#|X -] [0-9A-Z][0-9A-Z ][0-9A-Z ][0-9A-Z ][0-9A-Z ][0-9A-Z ] '))

      {
	$fld = substr($_, 3, 6);
	$s = ' ', $fld =~ s/$s//g;
	$des = substr($_, 10);
	$s = '^ *', $des =~ s/$s//;
	$s = " *\$", $des =~ s/$s//;
	$ok = 2;
    }

    if ($ok) {
	printf OUTFILE "%s\t%s\t%s\t%s\n", $cod, $fld, $codelist, $des;

	$XML::Edifact::CODET{$cod."\t".$fld}=$codelist."\t".$des;

        if ($ok == 1) {
            my ($elemt,$coded) = split / /, $XML::Edifact::ELEMT{$cod};
            $elemt=XML::Edifact::recode_mark($des)	unless $elemt;
	    $XML::Edifact::ELEMT{$cod}="$elemt coded"	unless $coded;
	    print $cod,"\t",$XML::Edifact::ELEMT{$cod},"\n" if $verbose;
        }
    }
}

1;