mksrc

#!/usr/bin/env perl

use utf8;

use v5.30.0;

use strict;
use warnings;

use open ':std', ':utf8', ':encoding(UTF-8)';
# no feature qw(indirect);
use feature qw(signatures);
no warnings qw(experimental::signatures);


use Getopt::Long;
use Pod::Usage;

my $help = 0;

GetOptions(
  help => \$help
) or die pod2usage(-verbose => 1);

pod2usage(-verbose => 2) if $help;
pod2usage(-verbose => 1) unless @ARGV;

my @files = @ARGV;

sub escape {
    my ($in) = @_;
    $in =~ s/'/''/g;
    return $in;
}

foreach my $file (@files){
    open(my $fh, "<", $file);

    my $state = "nothing";
    my $src = "";
    my $fn = "";
    my $start = 0;
    my $end = 0;

    my $prev_state;

    say "BEGIN TRANSACTION;";

    while (my $line = <$fh>){
        if( $state eq "nothing" && $line =~ /^(?:constant\s+)?function\s+(\w+)/){
            $start = $.;
            $state = "function";
            $fn = $1;
            $src = $line;
        }elsif($state eq "function" && $line =~ /^endfunction/){
            $end = $.;
            chomp $line;
            $state = "nothing";
            $src .= $line;

            $src = escape($src);
            $fn = escape($fn);
            say <<SQL;
                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'source-code',
                    '$src'
                );

                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'start-line',
                    $start
                );

                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'end-line',
                    $end
                );

                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'type',
                    'function'
                );
SQL
        }elsif( ( $state eq "nothing" || $state eq "globals") && $line =~ m[^/\*\*] ){
	    $prev_state = $state;
	    $state = "docstring";
	}elsif( $state eq "docstring" && $prev_state && $line =~ m[^\*/] ){
	    $state = $prev_state;
	    $prev_state = undef;
        }elsif( $state eq "nothing" && $line =~ /^(?:constant\s+)?native\s+(\w+)/ ){
            chomp $line;
            $src = $line;
            $src = escape($src);
            $fn = escape($1);
            say <<SQL;
                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'source-code',
                    '$src'
                );

                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'start-line',
                    $.
                );

                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'end-line',
                    $.
                );


                insert into annotations (fnname, anname, value) values (
                    '$fn',
                    'type',
                    'native'
                );
SQL
        }elsif ( $state eq "function"){
            $src .= $line;
        }elsif ( $state eq "nothing" && $line =~ m/^\s*globals/){
            $state = "globals";
        }elsif( $state eq "globals" && $line =~ m/^\s*endglobals/){
            $state = "nothing";
        }elsif ( $state eq "globals" ){
	    chomp $line;
            my $name;
            given($line){
                $name = $1 when /^\s*constant\s+\w+\s+(\w+)\s*=.+$/;
                $name = $1 when /^\s*\w+\s+array\s+(\w+)/;
                $name = $1 when /^\s*\w+\s+(\w+)/;
            }
            if($name){
                $name = escape($name);
                $line = escape($line);
                say <<SQL;
                    insert into annotations (fnname, anname, value) values (
                        '$name',
                        'source-code',
                        '$line'
                    );

                    insert into annotations (fnname, anname, value) values (
                        '$name',
                        'start-line',
                        $.
                    );

                    insert into annotations (fnname, anname, value) values (
                        '$name',
                        'end-line',
                        $.
                    );

                    insert into annotations (fnname, anname, value) values (
                        '$name',
                        'type',
                        'global'
                    );
SQL

            }
        }elsif( $state eq "nothing" && $line =~m /^type\s+(\w+)\s+extends\s+.+/){
	    chomp $line;
            my $type = escape($1);
            my $line = escape($line);
            say <<SQL;
                insert into annotations (fnname, anname, value) values (
                    '$type',
                    'source-code',
                    '$line'
                );

                insert into annotations (fnname, anname, value) values (
                    '$type',
                    'start-line',
                    $.
                );

                insert into annotations (fnname, anname, value) values (
                    '$type',
                    'end-line',
                    $.
                );

                insert into annotations (fnname, anname, value) values (
                    '$type',
                    'type',
                    'type'
                );
SQL
	}


    }

    say "END TRANSACTION;";
}

__END__

=head1 NAME

mksrc - Write jass source to SQL

=head1 SYNOPSIS

mksrc [options] [FILES]

 Options:
  --help  Prints this help message

=head1 DESCRIPTION

B<This program> takes any number of jass files and writes an SQL program to
stdout. That SQL program will add a bunch of annotations to the annotations
table, like the literal source code of each toplevel defintion, the start- and
end line numbers and the kind of the definition (funciton, native, global, etc.).