DBD-SQLite-SQLcipher/util/constants.pl

#!/usr/bin/perl

use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin";
use SQLiteUtil;

my %renamed_tags = (
  virtual_table_indexing_information => 'virtual_table_constraint_operator_codes',
  checkpoint_operation_parameters => 'checkpoint_mode_values',
);

my %shorter_tags = (
  flags_for_file_open_operations => 'file_open',
  fundamental_datatypes => 'datatypes',
  compile_time_library_version_numbers => 'version',
);

my @dbd_sqlite_constants = (
    'DBD_SQLITE_STRING_MODE_PV',
    'DBD_SQLITE_STRING_MODE_BYTES',
    'DBD_SQLITE_STRING_MODE_UNICODE_NAIVE',
    'DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK',
    'DBD_SQLITE_STRING_MODE_UNICODE_STRICT',
);

my %constants = extract_constants();
write_inc(%constants);
write_pm(%constants);

sub write_inc {
  my %constants = @_;

  my $inc = "$FindBin::Bin/../constants.inc";
  open my $fh, '>', $inc or die "$inc: $!";
print $fh <<"END";
# This file is generated by a script.
# Do not edit manually.

MODULE = DBD::SQLite    PACKAGE = DBD::SQLite::Constants

PROTOTYPES: ENABLE

BOOT:
END

    for my $constsub (@dbd_sqlite_constants) {
        print {$fh} qq<    newCONSTSUB( gv_stashpv("DBD::SQLite::Constants", FALSE), "$constsub", newSVuv($constsub) );\n>
    }
    print $fh "\n";

  for my $tag (sort grep !/^_/, keys %constants) {
    _write_tag($fh, $tag, $constants{$tag});
  }

print $fh <<"END";
# For backward compatibility

MODULE = DBD::SQLite    PACKAGE = DBD::SQLite

PROTOTYPES: ENABLE

END

  for my $tag (sort grep /^_/, keys %constants) {
    _write_tag($fh, $tag, $constants{$tag});
  }
}

sub _write_tag {
  my ($fh, $tag, $list) = @_;

  my ($version) = $tag =~ /_(\d{7})$/;
  if ($version) {
    print $fh <<"END";
#if SQLITE_VERSION_NUMBER >= $version

END
  }

  print $fh <<"END";
IV
_const_$tag()
    ALIAS:
END

  for my $name (@$list) {
    my $prefix = $tag =~ /^_/ ? "" : "SQLITE_";
    print $fh <<"END";
        $prefix$name = SQLITE_$name
END
  }

  print $fh <<"END";
    CODE:
        RETVAL = ix;
    OUTPUT:
        RETVAL

END

  if ($version) {
    print $fh <<"END";
#else

IV
_const_${tag}_zero()
    ALIAS:
END

    my $ix = 1;
    for my $name (@{$constants{$tag}}) {
      my $prefix = $tag =~ /^_/ ? "" : "SQLITE_";
      print $fh <<"END";
        $prefix$name = $ix
END
        $ix++;
    }

    print $fh <<"END";
    CODE:
        RETVAL = 0;
    OUTPUT:
        RETVAL

#endif

END
  }
}

sub write_pm {
  my %constants = @_;

  for my $tag (sort keys %constants) {
    if ($tag =~ /^_/) {
      delete $constants{$tag};
      next;
    }
    if (my ($org) = $tag =~ /^(.+?)_\d+$/) {
      push @{$constants{$org}}, @{delete $constants{$tag}};
    }
  }

  my $pm = "$FindBin::Bin/../lib/DBD/SQLite/Constants.pm";
  open my $fh, '>', $pm or die "$pm: $!";
  print $fh "package "."DBD::SQLite::Constants;\n";
  print $fh <<"END";

# This module is generated by a script.
# Do not edit manually.

use strict;
use warnings;
use base 'Exporter';
use DBD::SQLite;
our \@EXPORT_OK = (
END

  for my $const (@dbd_sqlite_constants) {
    print {$fh} "    '$const',\n";
  }

  for my $tag (sort keys %constants) {
    print $fh <<"END";
    # $tag
    qw/
@{[join "\n", map {"      SQLITE_$_"} sort @{$constants{$tag}}]}
    /,

END
  }

  print $fh <<"END";
);

our \%EXPORT_TAGS = (
END

  for (keys %renamed_tags) {
    if (exists $constants{$renamed_tags{$_}}) {
      $constants{$_} ||= $constants{$renamed_tags{$_}};
    }
    elsif (exists $constants{$_}) {
      $constants{$renamed_tags{$_}} ||= $constants{$_};
    }
  }

  my %seen;
  $constants{all} = [sort grep {!$seen{$_}++} map {@$_} values %constants];
  push @{$constants{all}}, @dbd_sqlite_constants;
  $constants{dbd_sqlite_string_mode} = [grep /^DBD_SQLITE_STRING_MODE_/, @dbd_sqlite_constants];

  my $sp = ' ' x 6;
  for my $tag (sort keys %constants) {
    print $fh <<"END";
    $tag => [qw/
@{[join "\n", map { /^DBD_SQLITE_/ ? "$sp$_" : "${sp}SQLITE_$_"} sort @{$constants{$tag}}]}
    /],

END
  }

  print $fh <<"END";
);
END

  for my $tag (sort keys %shorter_tags) {
    print $fh <<"END";
\$EXPORT_TAGS{$shorter_tags{$tag}} = \$EXPORT_TAGS{$tag};
END
  }

  print $fh <<"END";

1;

\__END__

\=encoding utf-8

\=head1 NAME

DBD::SQLite::Constants - common SQLite constants

\=head1 SYNOPSIS

  DBD::SQLite::Constants qw/:result_codes/;

\=head1 DESCRIPTION

You can import necessary SQLite constants from this module. Available tags are @{[join ', ', map {$shorter_tags{$_} ? "C<$shorter_tags{$_}> (C<$_>)" : "C<$_>"} sort keys %constants]}. See L<http://sqlite.org/c3ref/constlist.html> for the complete list of constants.

This module does not export anything by default.

\=head1 CONSTANTS

END

  for my $tag (sort keys %constants) {
    next if $tag eq 'all';
    print $fh <<"END";
\=head2 @{[$shorter_tags{$tag} ? "$shorter_tags{$tag} ($tag)" : $tag]}

\=over 4

END
    for my $const (@{$constants{$tag}}) {
      if ($const =~ /^DBD_SQLITE_/) {
        print $fh <<"END";
\=item $const

END
      } else {
        print $fh <<"END";
\=item SQLITE_$const

END
      }
    }
    print $fh <<"END";
\=back

END
  }
}