annotate

#!/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;
use DBI;

use DBD::SQLite::Constants ':dbd_sqlite_string_mode';

my $dbPath = "jass.db";
my $help = 0;

GetOptions(
  "db=s" => \$dbPath,
  help => \$help
) or die pod2usage(-verbose => 1);

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

my @files = @ARGV;

my $dbh = DBI->connect("DBI:SQLite:$dbPath");
$dbh->{sqlite_string_mode} = DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK;

my @auto_generated_annotations = ("source-file", "return-type", "common-ai",
  "source-code", "start-line", "end-line", "type" );
my $auto_generated_annotations = join ", ", map { "'$_'" } @auto_generated_annotations;

sub fetch_annotations {
  my $name = shift;
  my $ret = "";
  
  my $stm = $dbh->prepare("
    select anname, value
    from annotations 
    where fnname = ? and anname not in ('comment', $auto_generated_annotations)
    order by _rowid_
  ");
  $stm->execute($name);
  while ( my $row = $stm->fetchrow_hashref() ) {
    $ret .= join "", "@", $row->{anname}, " ", $row->{value};
    $ret .= "\n";
  }

  return $ret;
  
}

sub fetch_comment {
  my $name = shift;
  my $stm = $dbh->prepare("
    select value
    from annotations
    where fnname = ? and anname = 'comment'
  ");
  $stm->execute($name);

  if(my @row = $stm->fetchrow_array() ){
    return $row[0];
  }

  return "";
  
}

sub fetch_params {
  my $name = shift;
  my $ret = "";

  my $stm = $dbh->prepare("
    select doc.param, doc.value
    from (
      select value, param
      from params_extra
      where anname = 'param_order'
        and fnname = ?
    ) as ord

    left outer join (
      select param, value
      from parameters
      where fnname = ?
    ) as doc on doc.param = ord.param

    order by ord.value
  ");
  $stm->execute($name, $name);

  while( my $row = $stm->fetchrow_hashref() ){
    next if !$row->{param} or !$row->{value};
    $ret .= join " ", '@param', $row->{param}, $row->{value};
    $ret .= "\n";
  }

  return $ret;
  
}

sub has_docstring {
  my $name = shift;
  my $stm = $dbh->prepare("
    select 1
    from annotations
    where fnname == ?
      and anname not in ($auto_generated_annotations)
    limit 1
  ");
  $stm->execute( $name );
  my @row = $stm->fetchrow_array();
  return scalar @row;
}

sub recreate_docstring {
  return "" unless has_docstring ($1);
  return join "\n",
    "",
    "/**",
    fetch_comment ($1),
    fetch_annotations ($1),
    "*/\n";
}

sub recreate_docstring_function {
  return "" unless has_docstring $1;
  return join "\n",
    "",
    "/**",
    fetch_comment ($1),
    fetch_params ($1),
    fetch_annotations ($1),
    "*/\n";
}



for my $file (@files) {
  say STDERR "Annotating $file";
  open my $fh, "<", $file or die "Failed to open '$file'";
  open my $out, ">", "$file-out" or die "Failed to open '$file-out'";

  # TODO: create a "jass-parser" package since this is just copied from mksrc
  my @state = ("nothing");
  my $src = "";
  my $fn = "";
  my $start = 0;
  my $end = 0;

  while (my $line = <$fh>) {
    if( $state[0] eq "nothing" && $line =~ /^(?:constant\s+)?function\s+(\w+)/){
      unshift @state, "function";
      print $out recreate_docstring_function $1;
    }elsif($state[0] eq "function" && $line =~ /^endfunction/){
      shift @state;
    }elsif( $state[0] eq "nothing" && $line =~ /^(?:constant\s+)?native\s+(\w+)/ ){
      print $out recreate_docstring_function $1;
    }elsif ( $state[0] eq "function"){
      # do nothing
    }elsif ( $state[0] eq "nothing" && $line =~ m/^\s*globals/){
      unshift @state, "globals";
    }elsif( $line =~ m/^\/\*\*/ ){
      unshift @state, "docstring";
      # dont print
      next;
    }elsif( $state[0] eq "docstring" && $line =~ m(^\*/) ){
      shift @state;
      # dont print
      next;
    }elsif( $state[0] eq "docstring" ){
      # dont print
      next;
    }elsif( $state[0] eq "globals" && $line =~ m/^\s*endglobals/){
      shift @state;
    }elsif ( $state[0] eq "globals" ){
    	my $name;
      if( $line =~ /^\s*constant\s+\w+\s+(\w+)\s*=.+$/ ){
        $name = $1;
      }elsif( $line =~ /^\s*\w+\s+array\s+(\w+)/ ){
        $name = $1;
      }elsif( $line =~ /^\s*\w+\s+(\w+)/ ){
        $name = $1;
      }
      print $out recreate_docstring $name if $name;
    }elsif( $state[0] eq "nothing" && $line =~ m/^type\s+(\w+)\s+extends\s+.+/){
      print $out recreate_docstring $1;
    }
    print $out $line;
  }
}


__END__

=head1 NAME

annotate - Annotates a clean jass-file with annotations from jass.db

=head1 SYNOPSIS

annotate [options] [FILES]

 Options:
  --db    Path to jass.db. Default: jass.db
  --help  Prints this help message

=head1 DESCRIPTION

B<This program> can be used to annotate a fresh jass file with annotations
allready present in a jass.db-Sqlite file. The workflow in case of a new
common.j or Blizzard.j would be to build the jass.db with the old version
and then running `annotate new-common.j new-Blizzard.j`. This would create
two files called `new-common.j-out` and `new-Blizzard.j-out`.

Another use-case for this is to clean an annotated file. If the database has
not matching annotations the input file will be stripped of all docstrings.