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 %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

END

  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 (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';
our \@EXPORT_OK = (
END

  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];

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

END
  }

  print $fh <<"END";
);

1;

\__END__

\=encoding utf-8

\=head1 NAME

DBD::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 {"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 $tag

\=over 4

END
    for my $const (@{$constants{$tag}}) {
      print $fh <<"END";
\=item SQLITE_$const

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

END
  }
}