#!/usr/bin/perl
# Generate all constants from define or enum.

use strict;
use warnings;

# get $VERSION without loading XS code or parsing generated Perl
open(my $fh, '<', "Makefile")
    or die "Open 'Makefile' for reading failed\n";
my ($inc, $version);
local $_;
while(<$fh>) {
    ($inc) = /^INC\s*=\s*(.*)/ unless $inc;
    ($version) = /^VERSION\s*=\s*(.*)/ unless $version;
}
close($fh);

# type, prefix, header of generated Perl constants
my @consts = (
  # constants used in define and enum tests
  [qw(	enum	ATTRIBUTEID		common		)],
  [qw(	define	ACCESSLEVELMASK		common		)],
  [qw(	define	WRITEMASK		common		)],
  [qw(	define	VALUERANK		common		)],
  [qw(	enum	RULEHANDLING		common		)],
  [qw(	enum	ORDER			common		)],
  [qw(	enum	VARIANT			types		)],
  # We need UA_StatusCode as C type to run special typemap conversion.
  [qw(	define	STATUSCODE		statuscodes	UA_StatusCode	)],
  # needed for functionality tests
  [qw(	enum	APPLICATIONTYPE		types_generated	)],
  [qw(	enum	BROWSERESULTMASK	types_generated	)],
  [qw(	enum	MESSAGESECURITYMODE	types_generated	)],
  [qw(	enum	SECURECHANNELSTATE	common		)],
  [qw(	enum	SESSIONSTATE		common		)],
  [qw(	enum	NODEIDTYPE		types		)],
  # Type numbers depend on open62541 compile time options.  We cannot
  # put them into Contant.pm as this file is commited into the source
  # tree.  Generate them as C functions and use the value from the C
  # header file.  Then it is the number during XS compile time.
  [qw(	define	TYPES			types_generated	int		)],
  [qw(	define	NS0ID			nodeids		)],
  # needed for production
  [qw(	enum	NODECLASS		types_generated	)],
  [qw(	enum	MONITORINGMODE		types_generated	)],
  [qw(	enum	TIMESTAMPSTORETURN	types_generated	)],
);

parse_consts($version, sort { $a->[1] cmp $b->[1] } @consts);

exit(0);

########################################################################
sub parse_consts {
    my ($version, @consts) = @_;

    my $pmfile = "lib/OPCUA/Open62541/Constant.pm";
    open(my $pmf, '>', $pmfile)
	or die "Open '$pmfile' for writing failed: $!";
    print $pmf "# begin generated by $0\n\n";
    my $podfile = "lib/OPCUA/Open62541/Constant.pod";
    open(my $podf, '>', $podfile)
	or die "Open '$podfile' for writing failed: $!";
    print $podf "=for comment begin generated by $0\n\n";

    print_header($pmf, $version);
    print_pod_header($podf);
    foreach my $spec (@consts) {
	parse_prefix($pmf, $podf, @$spec);
    }
    print_permanent($pmf);
    print_footer($pmf);
    print_pod_footer($podf);

    print $pmf "# end generated by $0\n";
    close($pmf)
	or die "Close '$pmfile' after writing failed: $!";
    print $podf "=for comment end generated by $0\n";
    close($podf)
	or die "Close '$podfile' after writing failed: $!";
}

########################################################################
sub parse_prefix {
    my ($pmf, $podf, $type, $prefix, $header, $typedef) = @_;

    # header files were renamed over open62541 versions, find one of them
    my ($cf, $cfile);
    foreach my $h (split(/;/, $header)) {
	$cfile = "/usr/local/include/open62541/$h.h";
	open($cf, '<', $cfile)
	    and last;
	undef $cf;
    }
    unless ($cf) {
	# empty header field means optional
	if ($header =~ /;$/) {
		warn "warning: $prefix file '$cfile': $!\n";
		return;
	}
	die "Open '$cfile' for reading failed: $!";
    }

    my ($xsfile, $xsf);
    if ($typedef) {
	$xsfile = "Open62541-". lc($prefix). ".xsh";
	open($xsf, '>', $xsfile)
	    or die "Open '$xsfile' for writing failed: $!";
	print $xsf "# begin generated by $0\n\n";
    }

    my $ccomment = qr/\/\*.*?(?:\*\/|$)/;  # C comment /* */, may be multiline
    my $cdefine = qr/#\s*define\s+UA_${prefix}_(\S+)\s+(.+?)/;  # C #define
    my $cenum = qr/UA_${prefix}_([^\s,]+)(?:\s*=\s*([^,]+?))?\s*,?/;  # C enum

    my $regex =
	$type eq 'define' ? qr/^$cdefine\s*$ccomment?\s*$/ :
	$type eq 'enum' ? qr/^\s*$cenum\s*$ccomment?\s*$/ :
	die "Type must be define or enum: $type";

    my (@allstr, %firstnum, $prevnum);
    $prevnum = -1;  # if enum has no value, it starts with 0
    print $podf "=item :$prefix\n\n";
    print $podf "=over 8\n\n";
    while (<$cf>) {
	my ($str, $num) = /$regex/
	    or next;
	# if enum has no value, it increments the previous
	$num //= $prevnum + 1 if $type eq 'enum';
	$num =~ s/(?<=\d)l*u//gi;
	$num = eval "$num";
	if (defined $firstnum{$str}) {
	    warn "warning: $prefix duplicate '$str', ".
		"first constant '$firstnum{$str}', ignore '$num'\n";
	    die "Constant value changed from '$firstnum{$str}' to '$num'"
		if $firstnum{$str} != $num;
	    next;
	}
	$firstnum{$str} = $num;
	my $value = $typedef ? "" : " $num";
	print $pmf "$prefix $str$value\n";
	print $podf "=item ${prefix}_${str}\n\n";
	print_xsfunc($xsf, $typedef, $prefix, $str, $type eq "define")
	    if $typedef;
	push @allstr, $str;
	$prevnum = $num;
    }
    print $podf "=back\n\n";
    die "No type $type with prefix $prefix in header $header" unless @allstr;

    if ($xsfile) {
	print $xsf "# end generated by $0\n";
	close($xsf)
	    or die "Close '$xsfile' after writing failed: $!";
    }
}

########################################################################
sub print_header {
    my ($pf, $version) = @_;
    print $pf <<"EOHEADER";
# This file has been generated by $0

package OPCUA::Open62541::Constant;

use 5.015004;
use strict;
use warnings;
use Carp;

our \$VERSION = '$version';

# Even if we declare more than 10k constants, this is a fast way to do it.
my \$consts = <<'EOCONST';
EOHEADER
}

########################################################################
sub print_footer {
    my ($pf) = @_;
    print $pf <<'EOFOOTER';
EOCONST

open(my $fh, '<', \$consts) or croak "open consts: $!";

my %hash;
local $_;
while (<$fh>) {
    chomp;
    my ($prefix, $str, $num) = split;
    $hash{$prefix}{"${prefix}_${str}"} = $num;
}

close($fh) or croak "close consts: $!";

# This is how "use constant ..." creates constants.  constant.pm checks
# constant names and non-existance internally.  We know our names are OK
# and we only declare constants in our own namespace where they don't yet
# exist.  Therefore we can skip the checks and make this module load
# faster.
no strict 'refs';    ## no critic (ProhibitNoStrict)
my $symtab = \%{"OPCUA::Open62541::"};
use strict;

our (@EXPORT_OK, %EXPORT_TAGS);
foreach my $prefix (keys %hash) {
    while (my ($name, $scalar) = each %{$hash{$prefix}}) {
	next unless defined $scalar;  # has typedef, implemented in XS
	Internals::SvREADONLY($scalar, 1);
	$symtab->{$name} = \$scalar;
    }
    push @EXPORT_OK, keys %{$hash{$prefix}};
    $EXPORT_TAGS{$prefix} = [keys %{$hash{$prefix}}];
}
mro::method_changed_in("OPCUA::Open62541");

1;

EOFOOTER
}

########################################################################
# Some constants exist only in certain versions of the library.
# Always add them to export list, they are implemented in XS optionally.
sub print_permanent {
    my ($pf) = @_;
    print $pf <<'EOPERMANENT';
EOPERMANENT
}

########################################################################
sub print_pod_header {
    my ($pf) = @_;
    print $pf <<"EOPODHEADER";
=pod

=head1 NAME

OPCUA::Open62541::Constant - export constants from open62541 to Perl

=head1 SYNOPSIS

  use OPCUA::Open62541;

  use OPCUA::Open62541 ':all';

  use OPCUA::Open62541 qw(:ATTRIBUTEID ...);

  use OPCUA::Open62541 qw(ORDER_LESS ORDER_EQ ORDER_MORE ...);

=head1 DESCRIPTION

This module provides all defines and enums from open62541 as Perl
constants.
They have been automatically extracted from the C header files.
Do not use this module directly, instead specify the export tag in
OPCUA::Open62541.

=head2 EXPORT

=over 4

=item :all

Export all constants.
You want to import only the ones you need.

EOPODHEADER
}

########################################################################
sub print_pod_footer {
    my ($pf) = @_;
    print $pf <<"EOPODFOOTER";
=back

=head1 SEE ALSO

OPCUA::Open62541

=head1 AUTHORS

Alexander Bluhm,
Arne Becker

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2020 Alexander Bluhm

Copyright (c) 2020 Arne Becker

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

Thanks to genua GmbH, https://www.genua.de/ for sponsoring this work.

=cut

EOPODFOOTER
}

########################################################################
sub print_xsfunc {
    my ($xsf, $typedef, $prefix, $str, $ifdef) = @_;
    if ($ifdef) {
	$ifdef = "UA_${prefix}_${str}";
    } elsif (grep { /\-DHAVE_UA_${prefix}_${str}=1/ } $inc) {
	$ifdef = "HAVE_UA_${prefix}_${str}";
    }
    print $xsf "#ifdef ${ifdef}\n\n" if $ifdef;
    print $xsf <<"EOXSFUNC";
${typedef}
${prefix}_${str}()
    CODE:
	RETVAL = UA_${prefix}_${str};
    OUTPUT:
	RETVAL

EOXSFUNC
    print $xsf "#endif\n\n" if $ifdef;
}
