mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
added a script to extract SQLite constants from sqlite3.h and generate necessary XSUBs
This commit is contained in:
Kenichi Ishigaki
parent
e1fe8520d9
commit
54eb2bcf5b
2 changed files with 502 additions and 0 deletions
308
util/SQLiteUtil.pm
Normal file
308
util/SQLiteUtil.pm
Normal file
|
|
@ -0,0 +1,308 @@
|
|||
package SQLiteUtil;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use base 'Exporter';
|
||||
use HTTP::Tiny;
|
||||
use File::Copy;
|
||||
|
||||
our @EXPORT = qw/
|
||||
extract_constants versions srcdir mirror copy_files
|
||||
/;
|
||||
|
||||
our $ROOT = "$FindBin::Bin/..";
|
||||
our $SRCDIR = "$ROOT/tmp/src";
|
||||
|
||||
my %since = (
|
||||
IOERR_LOCK => '3006002',
|
||||
CONFIG_PCACHE => '3006006',
|
||||
CONFIG_GETPCACHE => '3006006',
|
||||
IOERR_CLOSE => '3006007',
|
||||
IOERR_DIR_CLOSE => '3006007',
|
||||
GET_LOCKPROXYFILE => '3006007',
|
||||
SET_LOCKPROXYFILE => '3006007',
|
||||
LAST_ERRNO => '3006007',
|
||||
SAVEPOINT => '3006008',
|
||||
LOCKED_SHAREDCACHE => '3006012',
|
||||
MUTEX_STATIC_OPEN => '3006012',
|
||||
OPEN_SHAREDCACHE => '3006018',
|
||||
OPEN_PRIVATECACHE => '3006018',
|
||||
LIMIT_TRIGGER_DEPTH => '3006018',
|
||||
CONFIG_LOG => '3006023',
|
||||
OPEN_AUTOPROXY => '3006023',
|
||||
IOCAP_UNDELETABLE_WHEN_OPEN => '3007000',
|
||||
IOERR_SHMOPEN => '3007000',
|
||||
IOERR_SHMSIZE => '3007000',
|
||||
IOERR_SHMLOCK => '3007000',
|
||||
BUSY_RECOVERY => '3007000',
|
||||
CANTOPEN_NOTEMPDIR => '3007000',
|
||||
OPEN_WAL => '3007000',
|
||||
FCNTL_SIZE_HINT => '3007000',
|
||||
DBSTATUS_CACHE_USED => '3007000',
|
||||
DBSTATUS_MAX => '3007000',
|
||||
STMTSTATUS_AUTOINDEX => '3007000',
|
||||
FCNTL_CHUNK_SIZE => '3007001',
|
||||
STATUS_MALLOC_COUNT => '3007001',
|
||||
DBSTATUS_SCHEMA_USED => '3007001',
|
||||
DBSTATUS_STMT_USED => '3007001',
|
||||
FCNTL_FILE_POINTER => '3007004',
|
||||
MUTEX_STATIC_PMEM => '3007005',
|
||||
FCNTL_SYNC_OMITTED => '3007005',
|
||||
DBSTATUS_LOOKASIDE_HIT => '3007005',
|
||||
DBSTATUS_LOOKASIDE_MISS_SIZE => '3007005',
|
||||
DBSTATUS_LOOKASIDE_MISS_FULL => '3007005',
|
||||
DBCONFIG_ENABLE_FKEY => '3007006',
|
||||
DBCONFIG_ENABLE_TRIGGER => '3007006',
|
||||
CONFIG_URI => '3007007',
|
||||
IOERR_SHMMAP => '3007007',
|
||||
IOERR_SEEK => '3007007',
|
||||
CORRUPT_VTAB => '3007007',
|
||||
READONLY_RECOVERY => '3007007',
|
||||
READONLY_CANTLOCK => '3007007',
|
||||
OPEN_URI => '3007007',
|
||||
FCNTL_WIN32_AV_RETRY => '3007008',
|
||||
FCNTL_PERSIST_WAL => '3007008',
|
||||
FCNTL_OVERWRITE => '3007009',
|
||||
DBSTATUS_CACHE_HIT => '3007009',
|
||||
DBSTATUS_CACHE_MISS => '3007009',
|
||||
CONFIG_PCACHE2 => '3007010',
|
||||
CONFIG_GETPCACHE2 => '3007010',
|
||||
IOCAP_POWERSAFE_OVERWRITE => '3007010',
|
||||
FCNTL_VFSNAME => '3007010',
|
||||
FCNTL_POWERSAFE_OVERWRITE => '3007010',
|
||||
ABORT_ROLLBACK => '3007011',
|
||||
FCNTL_PRAGMA => '3007011',
|
||||
CANTOPEN_ISDIR => '3007012',
|
||||
DBSTATUS_CACHE_WRITE => '3007012',
|
||||
OPEN_MEMORY => '3007013',
|
||||
CONFIG_COVERING_INDEX_SCAN => '3007015',
|
||||
CONFIG_SQLLOG => '3007015',
|
||||
IOERR_DELETE_NOENT => '3007015',
|
||||
CANTOPEN_FULLPATH => '3007015',
|
||||
FCNTL_BUSYHANDLER => '3007015',
|
||||
FCNTL_TEMPFILENAME => '3007015',
|
||||
READONLY_ROLLBACK => '3007016',
|
||||
CONSTRAINT_CHECK => '3007016',
|
||||
CONSTRAINT_COMMITHOOK => '3007016',
|
||||
CONSTRAINT_FOREIGNKEY => '3007016',
|
||||
CONSTRAINT_FUNCTION => '3007016',
|
||||
CONSTRAINT_NOTNULL => '3007016',
|
||||
CONSTRAINT_PRIMARYKEY => '3007016',
|
||||
CONSTRAINT_TRIGGER => '3007016',
|
||||
CONSTRAINT_UNIQUE => '3007016',
|
||||
CONSTRAINT_VTAB => '3007016',
|
||||
CONFIG_MMAP_SIZE => '3007017',
|
||||
IOERR_MMAP => '3007017',
|
||||
NOTICE_RECOVER_WAL => '3007017',
|
||||
NOTICE_RECOVER_ROLLBACK => '3007017',
|
||||
NOTICE => '3007017',
|
||||
WARNING => '3007017',
|
||||
FCNTL_MMAP_SIZE => '3007017',
|
||||
IOERR_GETTEMPPATH => '3008000',
|
||||
BUSY_SNAPSHOT => '3008000',
|
||||
WARNING_AUTOINDEX => '3008000',
|
||||
DBSTATUS_DEFERRED_FKS => '3008000',
|
||||
STMTSTATUS_VM_STEP => '3008000',
|
||||
IOERR_CONVPATH => '3008001',
|
||||
CANTOPEN_CONVPATH => '3008001',
|
||||
CONFIG_WIN32_HEAPSIZE => '3008002',
|
||||
CONSTRAINT_ROWID => '3008002',
|
||||
FCNTL_TRACE => '3008002',
|
||||
RECURSIVE => '3008003',
|
||||
READONLY_DBMOVED => '3008003',
|
||||
FCNTL_HAS_MOVED => '3008003',
|
||||
FCNTL_SYNC => '3008003',
|
||||
FCNTL_COMMIT_PHASETWO => '3008003',
|
||||
IOCAP_IMMUTABLE => '3008005',
|
||||
FCNTL_WIN32_SET_HANDLE => '3008005',
|
||||
MUTEX_STATIC_APP1 => '3008006',
|
||||
MUTEX_STATIC_APP2 => '3008006',
|
||||
MUTEX_STATIC_APP3 => '3008006',
|
||||
AUTH_USER => '3008007',
|
||||
LIMIT_WORKER_THREADS => '3008007',
|
||||
CONFIG_PCACHE_HDRSZ => '3008008',
|
||||
CONFIG_PMASZ => '3008008',
|
||||
|
||||
status_parameters_for_prepared_statements => '3006004',
|
||||
extended_result_codes => '3006005',
|
||||
database_connection_configuration_options => '3007000',
|
||||
flags_for_the_xshmlock_vfs_method => '3007000',
|
||||
maximum_xshmlock_index => '3007000',
|
||||
virtual_table_constraint_operator_codes => '3007001',
|
||||
checkpoint_operation_parameters => '3007006',
|
||||
conflict_resolution_modes => '3007007',
|
||||
virtual_table_configuration_options => '3007007',
|
||||
function_flags => '3008003',
|
||||
checkpoint_mode_values => '3008008',
|
||||
prepared_statement_scan_status_opcodes => '3008008',
|
||||
);
|
||||
|
||||
my %until = (
|
||||
CONFIG_CHUNKALLOC => '3006004',
|
||||
DBCONFIG_LOOKASIDE => '3006023',
|
||||
virtual_table_indexing_information => '3007000',
|
||||
checkpoint_operation_parameters => '3008007',
|
||||
);
|
||||
|
||||
my %ignore = map {$_ => 1} qw/
|
||||
OPEN_DELETEONCLOSE OPEN_EXCLUSIVE OPEN_AUTOPROXY
|
||||
OPEN_MAIN_DB OPEN_TEMP_DB OPEN_TRANSIENT_DB
|
||||
OPEN_MAIN_JOURNAL OPEN_TEMP_JOURNAL
|
||||
OPEN_SUBJOURNAL OPEN_MASTER_JOURNAL OPEN_WAL
|
||||
/;
|
||||
|
||||
my %compat = map {$_ => 1} qw/
|
||||
authorizer_action_codes
|
||||
authorizer_return_codes
|
||||
flags_for_file_open_operations
|
||||
/;
|
||||
|
||||
|
||||
sub extract_constants {
|
||||
my $file = shift;
|
||||
$file ||= "$FindBin::Bin/../sqlite3.h";
|
||||
open my $fh, '<', $file or die "$file: $!";
|
||||
my $tag;
|
||||
my %constants;
|
||||
while(<$fh>) {
|
||||
if (/^\*\* CAPI3REF: (.+)/) {
|
||||
$tag = lc $1;
|
||||
$tag =~ s/[ \-]+/_/g;
|
||||
($tag) = $tag =~ /^(\w+)/;
|
||||
$tag =~ s/_$//;
|
||||
$tag = '' if $tag =~ /
|
||||
testing_interface |
|
||||
library_version_numbers |
|
||||
configuration_options | device_characteristics |
|
||||
file_locking | vfs_method | xshmlock_index |
|
||||
mutex_types | scan_status | run_time_limit |
|
||||
standard_file_control | status_parameters |
|
||||
synchronization_type | virtual_table_constraint |
|
||||
virtual_table_indexing_information |
|
||||
checkpoint_operation_parameters | checkpoint_mode |
|
||||
conflict_resolution | text_encodings
|
||||
/x;
|
||||
next;
|
||||
}
|
||||
if ($tag && /^#define SQLITE_(\S+)\s+(?:\d|\(SQLITE)/) {
|
||||
my $name = $1;
|
||||
next if $ignore{$name};
|
||||
if (my $version = $since{$name} || $since{$tag}) {
|
||||
push @{$constants{"${tag}_${version}"} ||= []}, $name;
|
||||
push @{$constants{"_${tag}_${version}"} ||= []}, $name if $compat{$tag};
|
||||
} else {
|
||||
push @{$constants{$tag} ||= []}, $name;
|
||||
push @{$constants{"_$tag"} ||= []}, $name if $compat{$tag};
|
||||
}
|
||||
}
|
||||
}
|
||||
unshift @{$constants{_authorizer_return_codes}}, 'OK';
|
||||
|
||||
%constants;
|
||||
}
|
||||
|
||||
sub versions {
|
||||
my $res = HTTP::Tiny->new->get("http://sqlite.org/changes.html");
|
||||
reverse grep {$_->as_num >= 3060100} map {s/_/./g; SQLiteUtil::Version->new($_)} $res->{content} =~ /name="version_(3_[\d_]+)"/g;
|
||||
}
|
||||
|
||||
sub srcdir {
|
||||
my $version = SQLiteUtil::Version->new(shift);
|
||||
my ($dir) = grep {-d $_} (
|
||||
"$SRCDIR/sqlite-$version",
|
||||
"$SRCDIR/sqlite-autoconf-$version",
|
||||
"$SRCDIR/sqlite-amalgamation-$version",
|
||||
);
|
||||
$dir;
|
||||
}
|
||||
|
||||
sub download_url {
|
||||
my $version = shift;
|
||||
my $year = $version->year;
|
||||
join '',
|
||||
"http://www.sqlite.org/",
|
||||
($version->year ? $version->year."/" : ""),
|
||||
"sqlite-".($version->archive_type)."-$version.tar.gz";
|
||||
}
|
||||
|
||||
sub mirror {
|
||||
my $version = shift;
|
||||
my $file = "$SRCDIR/sqlite-$version.tar.gz";
|
||||
unless (-f $file) {
|
||||
my $url = download_url($version);
|
||||
print "Downloading $version...\n";
|
||||
my $res = HTTP::Tiny->new->mirror($url => $file);
|
||||
die "Can't mirror $file: ".$res->{reason} unless $res->{success};
|
||||
}
|
||||
my $dir = srcdir($version);
|
||||
unless ($dir && -d $dir) {
|
||||
my $cwd = Cwd::cwd;
|
||||
chdir($SRCDIR);
|
||||
system("tar xf sqlite-$version.tar.gz");
|
||||
chdir($cwd);
|
||||
$dir = srcdir($version) or die "Can't find srcdir";
|
||||
}
|
||||
open my $fh, '<', "$dir/sqlite3.c" or die $!;
|
||||
open my $out, '>', "$dir/fts3_tokenizer.h" or die $!;
|
||||
while(<$fh>) {
|
||||
print $out $_ if m{\*+ Begin file fts3_tokenizer\.h}
|
||||
...m{^/\*+ End of fts3_tokenizer\.h};
|
||||
}
|
||||
$dir;
|
||||
}
|
||||
|
||||
sub copy_files {
|
||||
my $version = shift;
|
||||
my $dir = srcdir($version) or return;
|
||||
copy("$dir/sqlite3.c", $ROOT);
|
||||
copy("$dir/sqlite3.h", $ROOT);
|
||||
copy("$dir/sqlite3ext.h", $ROOT);
|
||||
copy("$dir/fts3_tokenizer.h", $ROOT);
|
||||
}
|
||||
|
||||
package SQLiteUtil::Version;
|
||||
|
||||
use overload '""' => sub {
|
||||
my $self = shift;
|
||||
$self->as_num < 3070400 ? $self->dotted : $self->as_num;
|
||||
};
|
||||
|
||||
sub new {
|
||||
my ($class, $version) = @_;
|
||||
my @parts;
|
||||
if ($version =~ m/^3(?:\.[0-9]+){2,3}$/) {
|
||||
@parts = split /\./, $version;
|
||||
}
|
||||
elsif ($version =~ m/^3(?:[0-9]{2}){2,3}$/) {
|
||||
@parts = $version =~ /^(3)([0-9]{2})([0-9]{2})([0-9]{2})?$/;
|
||||
}
|
||||
else {
|
||||
die "improper <version> format for [$version]\n";
|
||||
}
|
||||
bless \@parts, $class;
|
||||
}
|
||||
|
||||
sub as_num {
|
||||
my $self = shift;
|
||||
sprintf '%u%02u%02u%02u', map {$_ || 0} @$self[0..3];
|
||||
}
|
||||
|
||||
sub dotted {
|
||||
my $self = shift;
|
||||
join '.', $self->[3] ? @$self : @$self[0..2];
|
||||
}
|
||||
|
||||
sub year {
|
||||
my $self = shift;
|
||||
my $version = $self->as_num;
|
||||
return 2015 if $version >= 3080800;
|
||||
return 2014 if $version >= 3080300;
|
||||
return 2013 if $version >= 3071600;
|
||||
return;
|
||||
}
|
||||
|
||||
sub archive_type {
|
||||
shift->as_num > 3070400 ? "autoconf" : "amalgamation";
|
||||
}
|
||||
|
||||
1;
|
||||
194
util/constants.pl
Normal file
194
util/constants.pl
Normal file
|
|
@ -0,0 +1,194 @@
|
|||
#!/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/@{[map {"SQLITE_$_"} @{$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{$_};
|
||||
}
|
||||
}
|
||||
|
||||
for my $tag (sort keys %constants) {
|
||||
print $fh <<"END";
|
||||
$tag => [qw/@{[map {"SQLITE_$_"} @{$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.
|
||||
|
||||
END
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue