SQL-Translator-0.11024/ 0000755 0001750 0001750 00000000000 13225114407 013762 5 ustar ilmari ilmari SQL-Translator-0.11024/share/ 0000755 0001750 0001750 00000000000 13225114407 015064 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/ 0000755 0001750 0001750 00000000000 13225114407 020667 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/Parse/ 0000755 0001750 0001750 00000000000 13225114407 021741 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/Parse/RecDescent/ 0000755 0001750 0001750 00000000000 13225114407 023760 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/Parse/RecDescent/DDL/ 0000755 0001750 0001750 00000000000 13225114407 024363 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/ 0000755 0001750 0001750 00000000000 13225114407 025146 5 ustar ilmari ilmari SQL-Translator-0.11024/share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/README 0000644 0001750 0001750 00000000147 12163313615 026032 0 ustar ilmari ilmari The contents of this directory are automatically regenerated when
invoking Makefile.PL in author mode.
SQL-Translator-0.11024/share/DiaUml/ 0000755 0001750 0001750 00000000000 13225114407 016237 5 ustar ilmari ilmari SQL-Translator-0.11024/share/DiaUml/uml-class.tt2 0000644 0001750 0001750 00000000651 12163313615 020576 0 ustar ilmari ilmari [%# vim:ft=tt2
-%]
[% INCLUDE 'uml-class-start.tt2' %]
[%- FOREACH attributes;
INCLUDE "uml-attribute.tt2";
END %]
[% INCLUDE 'uml-class-end.tt2' %]
SQL-Translator-0.11024/share/DiaUml/schema.tt2 0000644 0001750 0001750 00000002144 12163313615 020135 0 ustar ilmari ilmari [%# vim:ft=tt2 -%]
[% WRAPPER diagram.tt2 %]
[% WRAPPER layer.tt2 name="Background" %]
[% FOREACH table IN schema.get_tables %]
[% INCLUDE 'uml-class-start.tt2'
name = table.name
stereotype = 'Table'
visible_operations = 'false'
%]
[% FOREACH field IN table.get_fields;
SET type = field.data_type;
SET type = "$type($field.size)" IF field.size;
INCLUDE "uml-attribute.tt2"
name = field.name
stereotype = 'Field'
type = type
value = field.default_value
;
END %]
[% INCLUDE 'uml-class-end.tt2' %]
[% END %]
[% END %]
[% END %]
SQL-Translator-0.11024/share/DiaUml/diagram.tt2 0000644 0001750 0001750 00000004110 12163313615 020274 0 ustar ilmari ilmari
#A4#
[% content %]
SQL-Translator-0.11024/share/DiaUml/uml-class-all.tt2 0000644 0001750 0001750 00000007375 12163313615 021356 0 ustar ilmari ilmari [%# vim:ft=tt2
-%]
#[% name %]#
#[% stereotype %]#
#[% comment %]#
[% FOREACH attributes %]
[% INCLUDE "uml-attribute.tt2" %]
[% END %]
SQL-Translator-0.11024/share/DiaUml/layer.tt2 0000644 0001750 0001750 00000000210 12163313615 020001 0 ustar ilmari ilmari [%-
DEFAULT name="Layer1" visible="true"
%]
[% content %]
SQL-Translator-0.11024/share/DiaUml/uml-class-end.tt2 0000644 0001750 0001750 00000000045 12163313615 021337 0 ustar ilmari ilmari [%# vim:ft=tt2
-%]
SQL-Translator-0.11024/share/DiaUml/uml-attribute.tt2 0000644 0001750 0001750 00000001727 12163313615 021501 0 ustar ilmari ilmari [%# vim:ft=tt2
-%]
[%-
DEFAULT visibility=0 abstract="false" class_scope="false"
%]
#[% name %]#
#[% type %]#
#[% value %]#
#[% comment %]#
SQL-Translator-0.11024/share/DiaUml/uml-class-start.tt2 0000644 0001750 0001750 00000006736 12163313615 021743 0 ustar ilmari ilmari [% # vim:ft=tt2
DEFAULT
visible_operations='true'
-%]
#[% name %]#
#[% stereotype %]#
#[% comment %]#
SQL-Translator-0.11024/MANIFEST 0000644 0001750 0001750 00000014514 13225114163 015117 0 ustar ilmari ilmari AUTHORS
Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AuthorTests.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/Scripts.pm
inc/Module/Install/Share.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/SQL/Translator.pm
lib/SQL/Translator/Diff.pm
lib/SQL/Translator/Filter/DefaultExtra.pm
lib/SQL/Translator/Filter/Globals.pm
lib/SQL/Translator/Filter/Names.pm
lib/SQL/Translator/Generator/DDL/MySQL.pm
lib/SQL/Translator/Generator/DDL/PostgreSQL.pm
lib/SQL/Translator/Generator/DDL/SQLite.pm
lib/SQL/Translator/Generator/DDL/SQLServer.pm
lib/SQL/Translator/Generator/Role/DDL.pm
lib/SQL/Translator/Generator/Role/Quote.pm
lib/SQL/Translator/Manual.pod
lib/SQL/Translator/Parser.pm
lib/SQL/Translator/Parser/Access.pm
lib/SQL/Translator/Parser/DB2.pm
lib/SQL/Translator/Parser/DB2/Grammar.pm
lib/SQL/Translator/Parser/DBI.pm
lib/SQL/Translator/Parser/DBI/DB2.pm
lib/SQL/Translator/Parser/DBI/MySQL.pm
lib/SQL/Translator/Parser/DBI/Oracle.pm
lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
lib/SQL/Translator/Parser/DBI/SQLite.pm
lib/SQL/Translator/Parser/DBI/SQLServer.pm
lib/SQL/Translator/Parser/DBI/Sybase.pm
lib/SQL/Translator/Parser/Excel.pm
lib/SQL/Translator/Parser/JSON.pm
lib/SQL/Translator/Parser/MySQL.pm
lib/SQL/Translator/Parser/Oracle.pm
lib/SQL/Translator/Parser/PostgreSQL.pm
lib/SQL/Translator/Parser/SQLite.pm
lib/SQL/Translator/Parser/SQLServer.pm
lib/SQL/Translator/Parser/Storable.pm
lib/SQL/Translator/Parser/Sybase.pm
lib/SQL/Translator/Parser/XML.pm
lib/SQL/Translator/Parser/XML/SQLFairy.pm
lib/SQL/Translator/Parser/xSV.pm
lib/SQL/Translator/Parser/YAML.pm
lib/SQL/Translator/Producer.pm
lib/SQL/Translator/Producer/ClassDBI.pm
lib/SQL/Translator/Producer/DB2.pm
lib/SQL/Translator/Producer/Diagram.pm
lib/SQL/Translator/Producer/DiaUml.pm
lib/SQL/Translator/Producer/Dumper.pm
lib/SQL/Translator/Producer/GraphViz.pm
lib/SQL/Translator/Producer/HTML.pm
lib/SQL/Translator/Producer/JSON.pm
lib/SQL/Translator/Producer/Latex.pm
lib/SQL/Translator/Producer/MySQL.pm
lib/SQL/Translator/Producer/Oracle.pm
lib/SQL/Translator/Producer/POD.pm
lib/SQL/Translator/Producer/PostgreSQL.pm
lib/SQL/Translator/Producer/SQLite.pm
lib/SQL/Translator/Producer/SQLServer.pm
lib/SQL/Translator/Producer/Storable.pm
lib/SQL/Translator/Producer/Sybase.pm
lib/SQL/Translator/Producer/TT/Base.pm
lib/SQL/Translator/Producer/TT/Table.pm
lib/SQL/Translator/Producer/TTSchema.pm
lib/SQL/Translator/Producer/XML.pm
lib/SQL/Translator/Producer/XML/SQLFairy.pm
lib/SQL/Translator/Producer/YAML.pm
lib/SQL/Translator/Role/BuildArgs.pm
lib/SQL/Translator/Role/Debug.pm
lib/SQL/Translator/Role/Error.pm
lib/SQL/Translator/Role/ListAttr.pm
lib/SQL/Translator/Schema.pm
lib/SQL/Translator/Schema/Constants.pm
lib/SQL/Translator/Schema/Constraint.pm
lib/SQL/Translator/Schema/Field.pm
lib/SQL/Translator/Schema/Index.pm
lib/SQL/Translator/Schema/Object.pm
lib/SQL/Translator/Schema/Procedure.pm
lib/SQL/Translator/Schema/Role/Compare.pm
lib/SQL/Translator/Schema/Role/Extra.pm
lib/SQL/Translator/Schema/Table.pm
lib/SQL/Translator/Schema/Trigger.pm
lib/SQL/Translator/Schema/View.pm
lib/SQL/Translator/Types.pm
lib/SQL/Translator/Utils.pm
lib/Test/SQL/Translator.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
script/sqlt
script/sqlt-diagram
script/sqlt-diff
script/sqlt-diff-old
script/sqlt-dumper
script/sqlt-graph
script/sqlt.cgi
share/DiaUml/diagram.tt2
share/DiaUml/layer.tt2
share/DiaUml/schema.tt2
share/DiaUml/uml-attribute.tt2
share/DiaUml/uml-class-all.tt2
share/DiaUml/uml-class-end.tt2
share/DiaUml/uml-class-start.tt2
share/DiaUml/uml-class.tt2
share/PrecompiledParsers/Parse/RecDescent/DDL/SQLT/README
t/02mysql-parser.t
t/03mysql-to-oracle.t
t/04file,fh,string.t
t/05bgep-re.t
t/06xsv.t
t/07p_args.t
t/08postgres-to-mysql.t
t/09sqlt-diagram.t
t/10excel.t
t/11normalize.t
t/12header_comment.t
t/13schema.t
t/14postgres-parser.t
t/15oracle-parser.t
t/16xml-parser.t
t/17sqlfxml-producer.t
t/18ttschema-producer.t
t/19sybase-parser.t
t/20format_X_name.t
t/23json.t
t/24yaml.t
t/25storable.t
t/26sybase.t
t/27sqlite-parser.t
t/29html.t
t/30sqlt-new-diff-mysql.t
t/30sqlt-new-diff-pgsql.t
t/30sqlt-new-diff-sqlite.t
t/30sqlt-new-diff.t
t/31dumper.t
t/32schema-lookups.t
t/33tt-table-producer.t
t/34tt-base.t
t/35-access-parser.t
t/36-filters.t
t/38-filter-names.t
t/38-mysql-producer.t
t/39-filter-globals.t
t/40oracle-parser-dbi.t
t/43xml-to-db2.t
t/44-xml-to-db2-array.t
t/45db2-producer.t
t/46xml-to-pg.t
t/47postgres-producer.t
t/48xml-to-sqlite.t
t/49xml-to-pg-samefield.t
t/50-sqlserver-parser.t
t/51-xml-to-oracle.t
t/51-xml-to-oracle_quoted.t
t/52-oracle-options.t
t/53-oracle-delay-constraints.t
t/53-oracle-delay-constraints_quoted.t
t/54-oracle-alter-field.t
t/55-oracle-add-field.t
t/55-oracle-producer.t
t/56-sqlite-producer.t
t/57-class-dbi.t
t/60roundtrip.t
t/61translator_agnostic.t
t/62roundtrip_datacheck.t
t/63-spacial-pgsql.t
t/64xml-to-mysql.t
t/66-postgres-dbi-parser.t
t/70sqlt-diff_script.t
t/70sqlt-diff_script_old.t
t/71-generator-sql_server.t
t/72-sqlite-add-drop-fields.t
t/73-sqlite-respects-quote.t
t/74-filename-arrayref.t
t/data/access/gdpdm.ddl
t/data/diff/create1.yml
t/data/diff/create2.yml
t/data/diff/pgsql/create1.yml
t/data/diff/pgsql/create2.yml
t/data/Excel/t.xls
t/data/mysql/Apache-Session-MySQL.sql
t/data/mysql/BGEP-RE-create.sql
t/data/mysql/cashmusic_db.sql
t/data/mysql/create.sql
t/data/mysql/create2.sql
t/data/mysql/entire_syntax.sql
t/data/mysql/sqlfxml-producer-basic.sql
t/data/oracle/create.sql
t/data/oracle/create2.sql
t/data/oracle/schema_diff_a.yaml
t/data/oracle/schema_diff_b.yaml
t/data/oracle/schema_diff_c.yaml
t/data/oracle/schema_with_options.yaml
t/data/pgsql/Chado-CV-PostGreSQL.sql
t/data/pgsql/entire_syntax.sql
t/data/pgsql/turnkey.sql
t/data/roundtrip.xml
t/data/roundtrip_autogen.yaml
t/data/sqlite/create.sql
t/data/sqlite/create2.sql
t/data/sqlite/named.sql
t/data/sqlserver/create.sql
t/data/sybase/create.sql
t/data/template/basic.tt
t/data/template/table.tt
t/data/template/testresult_basic.txt
t/data/template/testresult_table.txt
t/data/xml/samefield.xml
t/data/xml/schema.xml
t/lib/Producer/BaseTest.pm
t/mysql-sqlite-translate.t
t/postgresql-rename-table-and-field.t
t/sqlite-rename-field.t
xt/eol.t
xt/notabs.t
xt/pod.t
SQL-Translator-0.11024/README 0000644 0001750 0001750 00000034471 13225114154 014652 0 ustar ilmari ilmari NAME
SQL::Translator - manipulate structured data definitions (SQL and more)
SYNOPSIS
use SQL::Translator;
my $translator = SQL::Translator->new(
# Print debug info
debug => 1,
# Print Parse::RecDescent trace
trace => 0,
# Don't include comments in output
no_comments => 0,
# Print name mutations, conflicts
show_warnings => 0,
# Add "drop table" statements
add_drop_table => 1,
# to quote or not to quote, thats the question
quote_identifiers => 1,
# Validate schema object
validate => 1,
# Make all table names CAPS in producers which support this option
format_table_name => sub {my $tablename = shift; return uc($tablename)},
# Null-op formatting, only here for documentation's sake
format_package_name => sub {return shift},
format_fk_name => sub {return shift},
format_pk_name => sub {return shift},
);
my $output = $translator->translate(
from => 'MySQL',
to => 'Oracle',
# Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
filename => $file,
) or die $translator->error;
print $output;
DESCRIPTION
This documentation covers the API for SQL::Translator. For a more
general discussion of how to use the modules and scripts, please see
SQL::Translator::Manual.
SQL::Translator is a group of Perl modules that converts vendor-specific
SQL table definitions into other formats, such as other vendor-specific
SQL, ER diagrams, documentation (POD and HTML), XML, and Class::DBI
classes. The main focus of SQL::Translator is SQL, but parsers exist for
other structured data formats, including Excel spreadsheets and
arbitrarily delimited text files. Through the separation of the code
into parsers and producers with an object model in between, it's
possible to combine any parser with any producer, to plug in custom
parsers or producers, or to manipulate the parsed data via the built-in
object model. Presently only the definition parts of SQL are handled
(CREATE, ALTER), not the manipulation of data (INSERT, UPDATE, DELETE).
CONSTRUCTOR
new
The constructor is called "new", and accepts a optional hash of options.
Valid options are:
* parser / from
* parser_args
* producer / to
* producer_args
* filters
* filename / file
* data
* debug
* add_drop_table
* quote_identifiers
* quote_table_names (DEPRECATED)
* quote_field_names (DEPRECATED)
* no_comments
* trace
* validate
All options are, well, optional; these attributes can be set via
instance methods. Internally, they are; no (non-syntactical) advantage
is gained by passing options to the constructor.
METHODS
add_drop_table
Toggles whether or not to add "DROP TABLE" statements just before the
create definitions.
quote_identifiers
Toggles whether or not to quote identifiers (table, column, constraint,
etc.) with a quoting mechanism suitable for the chosen Producer. The
default (true) is to quote them.
quote_table_names
DEPRECATED - A legacy proxy to "quote_identifiers"
quote_field_names
DEPRECATED - A legacy proxy to "quote_identifiers"
no_comments
Toggles whether to print comments in the output. Accepts a true or false
value, returns the current value.
producer
The "producer" method is an accessor/mutator, used to retrieve or define
what subroutine is called to produce the output. A subroutine defined as
a producer will be invoked as a function (*not a method*) and passed its
container "SQL::Translator" instance, which it should call the "schema"
method on, to get the "SQL::Translator::Schema" generated by the parser.
It is expected that the function transform the schema structure to a
string. The "SQL::Translator" instance is also useful for informational
purposes; for example, the type of the parser can be retrieved using the
"parser_type" method, and the "error" and "debug" methods can be called
when needed.
When defining a producer, one of several things can be passed in: A
module name (e.g., "My::Groovy::Producer"), a module name relative to
the "SQL::Translator::Producer" namespace (e.g., "MySQL"), a module name
and function combination ("My::Groovy::Producer::transmogrify"), or a
reference to an anonymous subroutine. If a full module name is passed in
(for the purposes of this method, a string containing "::" is considered
to be a module name), it is treated as a package, and a function called
"produce" will be invoked: $modulename::produce. If $modulename cannot
be loaded, the final portion is stripped off and treated as a function.
In other words, if there is no file named
My/Groovy/Producer/transmogrify.pm, "SQL::Translator" will attempt to
load My/Groovy/Producer.pm and use "transmogrify" as the name of the
function, instead of the default "produce".
my $tr = SQL::Translator->new;
# This will invoke My::Groovy::Producer::produce($tr, $data)
$tr->producer("My::Groovy::Producer");
# This will invoke SQL::Translator::Producer::Sybase::produce($tr, $data)
$tr->producer("Sybase");
# This will invoke My::Groovy::Producer::transmogrify($tr, $data),
# assuming that My::Groovy::Producer::transmogrify is not a module
# on disk.
$tr->producer("My::Groovy::Producer::transmogrify");
# This will invoke the referenced subroutine directly, as
# $subref->($tr, $data);
$tr->producer(\&my_producer);
There is also a method named "producer_type", which is a string
containing the classname to which the above "produce" function belongs.
In the case of anonymous subroutines, this method returns the string
"CODE".
Finally, there is a method named "producer_args", which is both an
accessor and a mutator. Arbitrary data may be stored in name => value
pairs for the producer subroutine to access:
sub My::Random::producer {
my ($tr, $data) = @_;
my $pr_args = $tr->producer_args();
# $pr_args is a hashref.
Extra data passed to the "producer" method is passed to "producer_args":
$tr->producer("xSV", delimiter => ',\s*');
# In SQL::Translator::Producer::xSV:
my $args = $tr->producer_args;
my $delimiter = $args->{'delimiter'}; # value is ,\s*
parser
The "parser" method defines or retrieves a subroutine that will be
called to perform the parsing. The basic idea is the same as that of
"producer" (see above), except the default subroutine name is "parse",
and will be invoked as "$module_name::parse($tr, $data)". Also, the
parser subroutine will be passed a string containing the entirety of the
data to be parsed.
# Invokes SQL::Translator::Parser::MySQL::parse()
$tr->parser("MySQL");
# Invokes My::Groovy::Parser::parse()
$tr->parser("My::Groovy::Parser");
# Invoke an anonymous subroutine directly
$tr->parser(sub {
my $dumper = Data::Dumper->new([ $_[1] ], [ "SQL" ]);
$dumper->Purity(1)->Terse(1)->Deepcopy(1);
return $dumper->Dump;
});
There is also "parser_type" and "parser_args", which perform analogously
to "producer_type" and "producer_args"
filters
Set or retrieve the filters to run over the schema during the
translation, before the producer creates its output. Filters are sub
routines called, in order, with the schema object to filter as the 1st
arg and a hash of options (passed as a list) for the rest of the args.
They are free to do whatever they want to the schema object, which will
be handed to any following filters, then used by the producer.
Filters are set as an array, which gives the order they run in. Like
parsers and producers, they can be defined by a module name, a module
name relative to the SQL::Translator::Filter namespace, a module name
and function name together or a reference to an anonymous subroutine.
When using a module name a function called "filter" will be invoked in
that package to do the work.
To pass args to the filter set it as an array ref with the 1st value
giving the filter (name or sub) and the rest its args. e.g.
$tr->filters(
sub {
my $schema = shift;
# Do stuff to schema here!
},
DropFKeys,
[ "Names", table => 'lc' ],
[ "Foo", foo => "bar", hello => "world" ],
[ "Filter5" ],
);
Although you normally set them in the constructor, which calls through
to filters. i.e.
my $translator = SQL::Translator->new(
...
filters => [
sub { ... },
[ "Names", table => 'lc' ],
],
...
);
See t/36-filters.t for more examples.
Multiple set calls to filters are cumulative with new filters added to
the end of the current list.
Returns the filters as a list of array refs, the 1st value being a
reference to the filter sub and the rest its args.
show_warnings
Toggles whether to print warnings of name conflicts, identifier
mutations, etc. Probably only generated by producers to let the user
know when something won't translate very smoothly (e.g., MySQL "enum"
fields into Oracle). Accepts a true or false value, returns the current
value.
translate
The "translate" method calls the subroutine referenced by the "parser"
data member, then calls any "filters" and finally calls the "producer"
sub routine (these members are described above). It accepts as arguments
a number of things, in key => value format, including (potentially) a
parser and a producer (they are passed directly to the "parser" and
"producer" methods).
Here is how the parameter list to "translate" is parsed:
* 1 argument means it's the data to be parsed; which could be a string
(filename) or a reference to a scalar (a string stored in memory),
or a reference to a hash, which is parsed as being more than one
argument (see next section).
# Parse the file /path/to/datafile
my $output = $tr->translate("/path/to/datafile");
# Parse the data contained in the string $data
my $output = $tr->translate(\$data);
* More than 1 argument means its a hash of things, and it might be
setting a parser, producer, or datasource (this key is named
"filename" or "file" if it's a file, or "data" for a SCALAR
reference.
# As above, parse /path/to/datafile, but with different producers
for my $prod ("MySQL", "XML", "Sybase") {
print $tr->translate(
producer => $prod,
filename => "/path/to/datafile",
);
}
# The filename hash key could also be:
datasource => \$data,
You get the idea.
filename, data
Using the "filename" method, the filename of the data to be parsed can
be set. This method can be used in conjunction with the "data" method,
below. If both the "filename" and "data" methods are invoked as
mutators, the data set in the "data" method is used.
$tr->filename("/my/data/files/create.sql");
or:
my $create_script = do {
local $/;
open CREATE, "/my/data/files/create.sql" or die $!;
;
};
$tr->data(\$create_script);
"filename" takes a string, which is interpreted as a filename. "data"
takes a reference to a string, which is used as the data to be parsed.
If a filename is set, then that file is opened and read when the
"translate" method is called, as long as the data instance variable is
not set.
schema
Returns the SQL::Translator::Schema object.
trace
Turns on/off the tracing option of Parse::RecDescent.
validate
Whether or not to validate the schema object after parsing and before
producing.
version
Returns the version of the SQL::Translator release.
AUTHORS
See the included AUTHORS file:
GETTING HELP/SUPPORT
If you are stuck with a problem or have doubts about a particular
approach do not hesitate to contact us via any of the following options
(the list is sorted by "fastest response time"):
* IRC: irc.perl.org#sql-translator
* Mailing list:
* RT Bug Tracker:
HOW TO CONTRIBUTE
Contributions are always welcome, in all usable forms (we especially
welcome documentation improvements). The delivery methods include git-
or unified-diff formatted patches, GitHub pull requests, or plain bug
reports either via RT or the Mailing list. Contributors are generally
granted access to the official repository after their first several
patches pass successful review. Don't hesitate to contact us with any
further questions you may have.
This project is maintained in a git repository. The code and related
tools are accessible at the following locations:
* Official repo:
* Official gitweb:
* GitHub mirror:
* Authorized committers:
* Travis-CI log:
COPYRIGHT
Copyright 2012 the SQL::Translator authors, as listed in "AUTHORS".
LICENSE
This library is free software and may be distributed under the same
terms as Perl 5 itself.
PRAISE
If you find this module useful, please use
to rate
it.
SEE ALSO
perl, SQL::Translator::Parser, SQL::Translator::Producer,
Parse::RecDescent, GD, GraphViz, Text::RecordParser, Class::DBI,
XML::Writer.
SQL-Translator-0.11024/Makefile.PL 0000644 0001750 0001750 00000013220 13211233530 015724 0 ustar ilmari ilmari BEGIN { push @INC, '.' unless $INC[-1] eq '.' }
use inc::Module::Install 1.06;
use strict;
use warnings;
# to deal wuth x.y.z versions properly
configure_requires 'ExtUtils::MakeMaker' => '6.54';
perl_version '5.008001';
my $deps = {
requires => {
'Digest::SHA' => '0',
'Carp::Clan' => '0',
'Parse::RecDescent' => '1.967009',
'DBI' => '1.54',
'File::ShareDir' => '1.0',
'Moo' => '1.000003',
'Package::Variant' => '1.001001',
'Sub::Quote' => '0',
'Try::Tiny' => '0.04',
'Scalar::Util' => '0',
},
recommends => {
'Template' => '2.20',
'GD' => '0',
'GraphViz' => '0',
'Graph::Directed' => '0',
'Spreadsheet::ParseExcel' => '0.41',
'Text::RecordParser' => '0.02',
'XML::LibXML' => '1.69',
},
test_requires => {
'JSON' => '2.0',
'YAML' => '0.66',
'XML::Writer' => '0.500',
'Test::More' => '0.88',
'Test::Differences' => '0',
'Test::Exception' => '0.31',
'Text::ParseWords' => '0',
},
};
name 'SQL-Translator';
author 'Ken Youens-Clark ';
abstract 'SQL DDL transformations and more';
license 'perl';
resources repository => 'https://github.com/dbsrgits/sql-translator/';
resources bugtracker => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Translator';
resources Ratings => 'http://cpanratings.perl.org/d/SQL-Translator';
resources IRC => 'irc://irc.perl.org/#sql-translator';
Meta->{values}{x_authority} = 'cpan:JROBINSON';
all_from 'lib/SQL/Translator.pm';
readme_from 'lib/SQL/Translator.pm';
for my $type (qw/requires recommends test_requires/) {
no strict qw/refs/;
my $f = \&$type;
for my $mod (sort keys %{$deps->{$type} || {} }) {
$f->($mod, $deps->{$type}{$mod});
}
}
install_script (qw|
script/sqlt-diagram
script/sqlt-diff
script/sqlt-diff-old
script/sqlt-dumper
script/sqlt-graph
script/sqlt
|);
install_share();
tests_recursive ();
# temporary(?) until I get around to fix M::I wrt xt/
# needs Module::Install::AuthorTests
eval {
# this should not be necessary since the autoloader is supposed
# to work, but there were reports of it failing
require Module::Install::AuthorTests;
recursive_author_tests (qw/xt/);
1;
} || do {
if ($Module::Install::AUTHOR) {
my $err = $@;
# better error message in case of missing dep
eval { require Module::Install::AuthorTests }
|| die "\nYou need Module::Install::AuthorTests installed to run this Makefile.PL in author mode:\n\n$@\n";
die $err;
}
};
auto_install();
if ($Module::Install::AUTHOR) {
_recompile_grammars();
_recreate_rt_source();
}
WriteAll();
sub _recompile_grammars {
return; # disabled until RT#74593 is resolved
require File::Spec;
my $compiled_parser_dir = File::Spec->catdir(qw/
share PrecompiledParsers Parse RecDescent DDL SQLT
/);
# Currently consider only single-name parsers containing a grammar marker
# This is somewhat fragile, but better than loading all kinds of parsers
# to some of which we may not even have the deps
my $parser_libdir = 'lib/SQL/Translator/Parser';
for my $parser_fn (glob "$parser_libdir/*.pm") {
die "$parser_fn does not look like a readable file\n"
unless ( -f $parser_fn and -r $parser_fn );
my ($type) = $parser_fn =~ /^\Q$parser_libdir\E\/(.+)\.pm$/i
or die "$parser_fn not named in expected format\n";
my $parser_source = do { local (@ARGV, $/) = $parser_fn; <> };
next unless $parser_source =~ /\$GRAMMAR.+?END_OF_GRAMMAR/s;
my $precomp_parser_fn = File::Spec->catfile($compiled_parser_dir, "$type.pm");
next if (
-f $precomp_parser_fn
and
(stat($parser_fn))[9] <= (stat($precomp_parser_fn))[9]
);
print "Precompiling parser for $type\n";
require $parser_fn;
require Parse::RecDescent;
Parse::RecDescent->Precompile(
do {
no strict 'refs';
${"SQL::Translator::Parser::${type}::GRAMMAR"}
|| die "No \$GRAMMAR global found in SQL::Translator::Parser::$type ($parser_fn)\n"
},
"Parse::RecDescent::DDL::SQLT::$type"
);
rename( "$type.pm", $precomp_parser_fn )
or die "Unable to move $type.pm to $compiled_parser_dir: $!\n";
}
}
sub _recreate_rt_source {
my $base_xml = "t/data/roundtrip.xml";
my $autogen_yaml = "t/data/roundtrip_autogen.yaml";
print "Updating $autogen_yaml\n";
unlink $autogen_yaml;
eval {
use lib 'lib';
require SQL::Translator;
require SQL::Translator::Parser::XML;
open (my $fh, '>', $autogen_yaml) or die "$autogen_yaml: $!\n";
my $tr = SQL::Translator->new;
my $yaml = $tr->translate (
parser => 'XML',
file => $base_xml,
producer => 'YAML',
) or die sprintf ("Unable to translate %s to YAML: %s\n",
$base_xml,
$tr->error || 'error unknown'
);
print $fh $yaml;
close $fh;
};
if ($@) {
die < 'Test::Pod 1.14 required' if $@;
all_pod_files_ok();
SQL-Translator-0.11024/xt/eol.t 0000644 0001750 0001750 00000000542 12163313615 015364 0 ustar ilmari ilmari use warnings;
use strict;
use Test::More;
eval "use Test::EOL 1.1";
plan skip_all => 'Test::EOL 1.1 required' if $@;
Test::EOL::all_perl_files_ok({ trailing_whitespace => 1},
qw|lib t xt script share/DiaUml|,
);
# FIXME - Test::EOL declares 'no_plan' which conflicts with done_testing
# https://github.com/schwern/test-more/issues/14
#done_testing;
SQL-Translator-0.11024/xt/notabs.t 0000644 0001750 0001750 00000000523 12163313615 016072 0 ustar ilmari ilmari use warnings;
use strict;
use Test::More;
eval "use Test::NoTabs 1.1";
plan skip_all => 'Test::NoTabs 1.1 required' if $@;
Test::NoTabs::all_perl_files_ok(
qw|lib t xt script share/DiaUml|,
);
# FIXME - Test::NoTabs declares 'no_plan' which conflicts with done_testing
# https://github.com/schwern/test-more/issues/14
#done_testing;
SQL-Translator-0.11024/META.yml 0000644 0001750 0001750 00000002454 13225114154 015237 0 ustar ilmari ilmari ---
abstract: 'SQL DDL transformations and more'
author:
- 'Ken Youens-Clark '
build_requires:
ExtUtils::MakeMaker: 6.59
JSON: '2.0'
Test::Differences: 0
Test::Exception: '0.31'
Test::More: '0.88'
Text::ParseWords: 0
XML::Writer: '0.500'
YAML: '0.66'
configure_requires:
ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.18'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: SQL-Translator
no_index:
directory:
- inc
- share
- t
- xt
recommends:
GD: 0
Graph::Directed: 0
GraphViz: 0
Spreadsheet::ParseExcel: '0.41'
Template: '2.20'
Text::RecordParser: '0.02'
XML::LibXML: '1.69'
requires:
Carp::Clan: 0
DBI: '1.54'
Digest::SHA: 0
File::ShareDir: '1.0'
Moo: '1.000003'
Package::Variant: '1.001001'
Parse::RecDescent: '1.967009'
Scalar::Util: 0
Sub::Quote: 0
Try::Tiny: '0.04'
perl: 5.8.1
resources:
IRC: irc://irc.perl.org/#sql-translator
Ratings: http://cpanratings.perl.org/d/SQL-Translator
bugtracker: https://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Translator
license: http://dev.perl.org/licenses/
repository: https://github.com/dbsrgits/sql-translator/
version: '0.11024'
x_authority: cpan:JROBINSON
SQL-Translator-0.11024/inc/ 0000755 0001750 0001750 00000000000 13225114407 014533 5 ustar ilmari ilmari SQL-Translator-0.11024/inc/Module/ 0000755 0001750 0001750 00000000000 13225114407 015760 5 ustar ilmari ilmari SQL-Translator-0.11024/inc/Module/Install.pm 0000644 0001750 0001750 00000027145 13225114153 017733 0 ustar ilmari ilmari #line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '1.18';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
END_DIE
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
It was impossible to maintain duel backends, and has been deprecated.
Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
#-------------------------------------------------------------
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
#-------------------------------------------------------------
unless ( -f $self->{file} ) {
foreach my $key (keys %INC) {
delete $INC{$key} if $key =~ /Module\/Install/;
}
local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
local $^W;
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{'inc/Module/Install.pm'};
delete $INC{'Module/Install.pm'};
# Save to the singleton
$MAIN = $self;
return 1;
}
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
unless ($$sym =~ s/([^:]+)$//) {
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
return;
} elsif ( $method =~ /^_/ and $self->can($method) ) {
# Dispatch to the root M:I class
return $self->$method(@_);
}
# Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
goto &{$self->can('call')};
};
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
}
my @exts = @{$self->{extensions}};
unless ( @exts ) {
@exts = $self->{admin}->load_all_extensions;
}
my %seen;
foreach my $obj ( @exts ) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless $obj->can($method);
next if $method =~ /^_/;
next if $method eq uc($method);
$seen{$method}++;
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
delete $INC{'FindBin.pm'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
require FindBin;
}
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS';
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
$args{bundle} ||= 'inc/BUNDLES';
$args{base} ||= $base_path;
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ( $args{path} ) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
$should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} =
$should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( {no_chdir => 1, wanted => sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($File::Find::name);
my $in_pod = 0;
foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
next if /^\s*#/; # and comments
if ( m/^\s*package\s+($pkg)\s*;/i ) {
$pkg = $1;
last;
}
}
}
push @found, [ $file, $pkg ];
}}, $path ) if -d $path;
@found;
}
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
binmode FH;
my $string = do { local $/; };
close FH or die "close($_[0]): $!";
return $string;
}
sub _readperl {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
return $string;
}
sub _readpod {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
return $string if $_[0] =~ /\.pod\z/;
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
sub _CLASS {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2012 Adam Kennedy.
SQL-Translator-0.11024/inc/Module/Install/ 0000755 0001750 0001750 00000000000 13225114407 017366 5 ustar ilmari ilmari SQL-Translator-0.11024/inc/Module/Install/Share.pm 0000644 0001750 0001750 00000004643 13225114154 020774 0 ustar ilmari ilmari #line 1
package Module::Install::Share;
use strict;
use Module::Install::Base ();
use File::Find ();
use ExtUtils::Manifest ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub install_share {
my $self = shift;
my $dir = @_ ? pop : 'share';
my $type = @_ ? shift : 'dist';
unless ( defined $type and $type eq 'module' or $type eq 'dist' ) {
die "Illegal or invalid share dir type '$type'";
}
unless ( defined $dir and -d $dir ) {
require Carp;
Carp::croak("Illegal or missing directory install_share param: '$dir'");
}
# Split by type
my $S = ($^O eq 'MSWin32') ? "\\" : "\/";
my $root;
if ( $type eq 'dist' ) {
die "Too many parameters to install_share" if @_;
# Set up the install
$root = "\$(INST_LIB)${S}auto${S}share${S}dist${S}\$(DISTNAME)";
} else {
my $module = Module::Install::_CLASS($_[0]);
unless ( defined $module ) {
die "Missing or invalid module name '$_[0]'";
}
$module =~ s/::/-/g;
$root = "\$(INST_LIB)${S}auto${S}share${S}module${S}$module";
}
my $manifest = -r 'MANIFEST' ? ExtUtils::Manifest::maniread() : undef;
my $skip_checker = $ExtUtils::Manifest::VERSION >= 1.54
? ExtUtils::Manifest::maniskip()
: ExtUtils::Manifest::_maniskip();
my $postamble = '';
my $perm_dir = eval($ExtUtils::MakeMaker::VERSION) >= 6.52 ? '$(PERM_DIR)' : 755;
File::Find::find({
no_chdir => 1,
wanted => sub {
my $path = File::Spec->abs2rel($_, $dir);
if (-d $_) {
return if $skip_checker->($File::Find::name);
$postamble .=<<"END";
\t\$(NOECHO) \$(MKPATH) "$root${S}$path"
\t\$(NOECHO) \$(CHMOD) $perm_dir "$root${S}$path"
END
}
else {
return if ref $manifest
&& !exists $manifest->{$File::Find::name};
return if $skip_checker->($File::Find::name);
$postamble .=<<"END";
\t\$(NOECHO) \$(CP) "$dir${S}$path" "$root${S}$path"
END
}
},
}, $dir);
# Set up the install
$self->postamble(<<"END_MAKEFILE");
config ::
$postamble
END_MAKEFILE
# The above appears to behave incorrectly when used with old versions
# of ExtUtils::Install (known-bad on RHEL 3, with 5.8.0)
# So when we need to install a share directory, make sure we add a
# dependency on a moderately new version of ExtUtils::MakeMaker.
$self->build_requires( 'ExtUtils::MakeMaker' => '6.11' );
# 99% of the time we don't want to index a shared dir
$self->no_index( directory => $dir );
}
1;
__END__
#line 154
SQL-Translator-0.11024/inc/Module/Install/Can.pm 0000644 0001750 0001750 00000006405 13225114154 020431 0 ustar ilmari ilmari #line 1
package Module::Install::Can;
use strict;
use Config ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;
my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;
local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
require File::Spec;
my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# Can our C compiler environment build XS files
sub can_xs {
my $self = shift;
# Ensure we have the CBuilder module
$self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
# Do we have the configure_requires checker?
local $@;
eval "require ExtUtils::CBuilder;";
if ( $@ ) {
# They don't obey configure_requires, so it is
# someone old and delicate. Try to avoid hurting
# them by falling back to an older simpler test.
return $self->can_cc();
}
# Do we have a working C compiler
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
unless ( $builder->have_compiler ) {
# No working C compiler
return 0;
}
# Write a C file representative of what XS becomes
require File::Temp;
my ( $FH, $tmpfile ) = File::Temp::tempfile(
"compilexs-XXXXX",
SUFFIX => '.c',
);
binmode $FH;
print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
int main(int argc, char **argv) {
return 0;
}
int boot_sanexs() {
return 1;
}
END_C
close $FH;
# Can the C compiler access the same headers XS does
my @libs = ();
my $object = undef;
eval {
local $^W = 0;
$object = $builder->compile(
source => $tmpfile,
);
@libs = $builder->link(
objects => $object,
module_name => 'sanexs',
);
};
my $result = $@ ? 0 : 1;
# Clean up all the build files
foreach ( $tmpfile, $object, @libs ) {
next unless defined $_;
1 while unlink;
}
return $result;
}
# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
if ($^O eq 'VMS') {
require ExtUtils::CBuilder;
my $builder = ExtUtils::CBuilder->new(
quiet => 1,
);
return $builder->have_compiler;
}
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}
1;
__END__
#line 245
SQL-Translator-0.11024/inc/Module/Install/Metadata.pm 0000644 0001750 0001750 00000043302 13225114153 021444 0 ustar ilmari ilmari #line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
};
my @scalar_keys = qw{
name
module_name
abstract
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
};
my @resource_keys = qw{
homepage
bugtracker
repository
};
my @array_keys = qw{
keywords
author
};
*authors = \&author;
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
sub Meta_ArrayKeys { @array_keys }
foreach my $key ( @boolean_keys ) {
*$key = sub {
my $self = shift;
if ( defined wantarray and not @_ ) {
return $self->{values}->{$key};
}
$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
return $self;
};
}
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} = shift;
return $self;
};
}
foreach my $key ( @array_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} ||= [];
push @{$self->{values}->{$key}}, @_;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}->{resources} };
}
return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
}
foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
my $value = shift or next;
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}->{resources} ||= [];
push @{ $self->{values}->{resources} }, [ $name, $value ];
}
$self->{values}->{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
my $value = @_ ? shift : 1;
if ( $self->{values}->{dynamic_config} ) {
# Once dynamic we never change to static, for safety
return 0;
}
$self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
# Convenience command
sub static_config {
shift->dynamic_config(0);
}
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
# Normalize the version
$version = $self->_perl_version($version);
# We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
$self->{values}->{perl_version} = $version;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
$self->{values}{all_from} = $file;
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
$pod =~ s/\.pm$/.pod/i;
$pod = $file unless -e $pod;
# Pull the different values
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
$self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
return 1;
}
sub provides {
my $self = shift;
my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
sub auto_provides {
my $self = shift;
return $self unless $self->is_admin;
unless (-e 'MANIFEST') {
warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
return $self;
}
# Avoid spurious warnings as we are not checking manifest here.
local $SIG{__WARN__} = sub {1};
require ExtUtils::Manifest;
local *ExtUtils::Manifest::manicheck = sub { return };
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->name,
dist_version => $self->version,
license => $self->license,
);
$self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
my $self = shift;
my $name = shift;
my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}->{features}
? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
return $self->{values}->{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
}
sub write {
my $self = shift;
return $self unless $self->is_admin;
$self->admin->write_meta;
return $self;
}
sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
# for version integrity check
$self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->abstract(
bless(
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
);
}
# Add both distribution and module name
sub name_from {
my ($self, $file) = @_;
if (
Module::Install::_read($file) =~ m/
^ \s*
package \s*
([\w:]+)
[\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
$name =~ s{::}{-}g;
$self->name($name);
unless ( $self->module_name ) {
$self->module_name($module_name);
}
} else {
die("Cannot determine name from $file\n");
}
}
sub _extract_perl_version {
if (
$_[0] =~ m/
^\s*
(?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
return $perl_version;
} else {
return;
}
}
sub perl_version_from {
my $self = shift;
my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
([^\n]*)
/ixms) {
my $author = $1 || $2;
# XXX: ugly but should work anyway...
if (eval "require Pod::Escapes; 1") {
# Pod::Escapes has a mapping table.
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E}{<}g;
$author =~ s{E}{>}g;
}
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
#Stolen from M::B
my %license_urls = (
perl => 'http://dev.perl.org/licenses/',
apache => 'http://apache.org/licenses/LICENSE-2.0',
apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
artistic => 'http://opensource.org/licenses/artistic-license.php',
artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$license = __extract_license($license) || lc $license;
$self->{values}->{license} = $license;
# Automatically fill in license URLs
if ( $license_urls{$license} ) {
$self->resources( license => $license_urls{$license} );
}
return 1;
}
sub _extract_license {
my $pod = shift;
my $matched;
return __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
(=head \d.*|=cut.*|)\z
/xms
) || __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
(=head \d.*|=cut.*|)\z
/xms
);
}
sub __extract_license {
my $license_text = shift or return;
my @phrases = (
'(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
'Artistic and GPL' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
'GNU lesser public license' => 'lgpl', 1,
'GNU library general public license' => 'lgpl', 1,
'GNU library public license' => 'lgpl', 1,
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
'Artistic license 2\.0' => 'artistic_2', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
'BSD' => 'bsd', 1,
'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
'Mozilla Public License' => 'mozilla', 1,
'Q Public License' => 'open_source', 1,
'OpenSSL License' => 'unrestricted', 1,
'SSLeay License' => 'unrestricted', 1,
'zlib License' => 'open_source', 1,
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
return $license;
}
}
return '';
}
sub license_from {
my $self = shift;
if (my $license=_extract_license(Module::Install::_read($_[0]))) {
$self->license($license);
} else {
warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
}
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
https?\Q://rt.cpan.org/\E[^>]+|
https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
@links=keys %links;
return @links;
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->requires( $module => $version );
}
}
sub test_requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
######################################################################
# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
sub write_mymeta_yaml {
my $self = shift;
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
if ( $perl >= 5.006 ) {
$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
}
unshift @$requires, [ perl => $perl ];
}
# Load the advisory META.yml file
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
return $meta;
}
1;
SQL-Translator-0.11024/inc/Module/Install/Base.pm 0000644 0001750 0001750 00000002147 13225114153 020600 0 ustar ilmari ilmari #line 1
package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.18';
}
# Suspend handler for "redefined" warnings
BEGIN {
my $w = $SIG{__WARN__};
$SIG{__WARN__} = sub { $w };
}
#line 42
sub new {
my $class = shift;
unless ( defined &{"${class}::call"} ) {
*{"${class}::call"} = sub { shift->_top->call(@_) };
}
unless ( defined &{"${class}::load"} ) {
*{"${class}::load"} = sub { shift->_top->load(@_) };
}
bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
local $@;
my $func = eval { shift->_top->autoload } or return;
goto &$func;
}
#line 75
sub _top {
$_[0]->{_top};
}
#line 90
sub admin {
$_[0]->_top->{admin}
or
Module::Install::Base::FakeAdmin->new;
}
#line 106
sub is_admin {
! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
use vars qw{$VERSION};
BEGIN {
$VERSION = $Module::Install::Base::VERSION;
}
my $fake;
sub new {
$fake ||= bless(\@_, $_[0]);
}
sub AUTOLOAD {}
sub DESTROY {}
# Restore warning handler
BEGIN {
$SIG{__WARN__} = $SIG{__WARN__}->();
}
1;
#line 159
SQL-Translator-0.11024/inc/Module/Install/Include.pm 0000644 0001750 0001750 00000001015 13225114154 021303 0 ustar ilmari ilmari #line 1
package Module::Install::Include;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub include {
shift()->admin->include(@_);
}
sub include_deps {
shift()->admin->include_deps(@_);
}
sub auto_include {
shift()->admin->auto_include(@_);
}
sub auto_include_deps {
shift()->admin->auto_include_deps(@_);
}
sub auto_include_dependent_dists {
shift()->admin->auto_include_dependent_dists(@_);
}
1;
SQL-Translator-0.11024/inc/Module/Install/Makefile.pm 0000644 0001750 0001750 00000027437 13225114153 021454 0 ustar ilmari ilmari #line 1
package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing or non-interactive session, always use defaults
if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array
# or a hash or something else (which may or may not be appendable).
my %makemaker_argtype = (
C => 'ARRAY',
CONFIG => 'ARRAY',
# CONFIGURE => 'CODE', # ignore
DIR => 'ARRAY',
DL_FUNCS => 'HASH',
DL_VARS => 'ARRAY',
EXCLUDE_EXT => 'ARRAY',
EXE_FILES => 'ARRAY',
FUNCLIST => 'ARRAY',
H => 'ARRAY',
IMPORTS => 'HASH',
INCLUDE_EXT => 'ARRAY',
LIBS => 'ARRAY', # ignore ''
MAN1PODS => 'HASH',
MAN3PODS => 'HASH',
META_ADD => 'HASH',
META_MERGE => 'HASH',
PL_FILES => 'HASH',
PM => 'HASH',
PMLIBDIRS => 'ARRAY',
PMLIBPARENTDIRS => 'ARRAY',
PREREQ_PM => 'HASH',
CONFIGURE_REQUIRES => 'HASH',
SKIP => 'ARRAY',
TYPEMAPS => 'ARRAY',
XS => 'HASH',
# VERSION => ['version',''], # ignore
# _KEEP_AFTER_FLUSH => '',
clean => 'HASH',
depend => 'HASH',
dist => 'HASH',
dynamic_lib=> 'HASH',
linkext => 'HASH',
macro => 'HASH',
postamble => 'HASH',
realclean => 'HASH',
test => 'HASH',
tool_autosplit => 'HASH',
# special cases where you can use makemaker_append
CCFLAGS => 'APPENDABLE',
DEFINE => 'APPENDABLE',
INC => 'APPENDABLE',
LDDLFLAGS => 'APPENDABLE',
LDFROM => 'APPENDABLE',
);
sub makemaker_args {
my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
foreach my $key (keys %new_args) {
if ($makemaker_argtype{$key}) {
if ($makemaker_argtype{$key} eq 'ARRAY') {
$args->{$key} = [] unless defined $args->{$key};
unless (ref $args->{$key} eq 'ARRAY') {
$args->{$key} = [$args->{$key}]
}
push @{$args->{$key}},
ref $new_args{$key} eq 'ARRAY'
? @{$new_args{$key}}
: $new_args{$key};
}
elsif ($makemaker_argtype{$key} eq 'HASH') {
$args->{$key} = {} unless defined $args->{$key};
foreach my $skey (keys %{ $new_args{$key} }) {
$args->{$key}{$skey} = $new_args{$key}{$skey};
}
}
elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
$self->makemaker_append($key => $new_args{$key});
}
}
else {
if (defined $args->{$key}) {
warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
}
$args->{$key} = $new_args{$key};
}
}
return $args;
}
# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{$name} = defined $args->{$name}
? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
sub build_subdirs {
my $self = shift;
my $subdirs = $self->makemaker_args->{DIR} ||= [];
for my $subdir (@_) {
push @$subdirs, $subdir;
}
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
sub _wanted_t {
}
sub tests_recursive {
my $self = shift;
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
File::Find::find(
sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
$dir
);
$self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Check the current Perl version
my $perl_version = $self->perl_version;
if ( $perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
# Make sure we have a new enough MakeMaker
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
# This previous attempted to inherit the version of
# ExtUtils::MakeMaker in use by the module author, but this
# was found to be untenable as some authors build releases
# using future dev versions of EU:MM that nobody else has.
# Instead, #toolchain suggests we use 6.59 which is the most
# stable version on CPAN at time of writing and is, to quote
# ribasushi, "not terminally fucked, > and tested enough".
# TODO: We will now need to maintain this over time to push
# the version up as new versions are released.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{NAME} =~ s/-/::/g;
$args->{VERSION} = $self->version or die <<'EOT';
ERROR: Can't determine distribution version. Please specify it
explicitly via 'version' in Makefile.PL, or set a valid $VERSION
in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
$args->{test} = {
TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( $Module::Install::ExtraTests::use_extratests ) {
# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
# So, just ignore our xt tests here.
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
};
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
#$args->{NO_MYMETA} = 1;
}
if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
if ( $self->makemaker(6.31) and $self->license ) {
$args->{LICENSE} = $self->license;
}
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# Merge both kinds of requires into BUILD_REQUIRES
my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
%$build_prereq = ( %$build_prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires)
);
# Remove any reference to perl, BUILD_REQUIRES doesn't support it
delete $args->{BUILD_REQUIRES}->{perl};
# Delete bundled dists from prereq_pm, add it to Makefile DIR
my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
my %processed;
foreach my $bundle (@{ $self->bundles }) {
my ($mod_name, $dist_dir) = @$bundle;
delete $prereq->{$mod_name};
$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
if (not exists $processed{$dist_dir}) {
if (-d $dist_dir) {
# List as sub-directory to be processed by make
push @$subdirs, $dist_dir;
}
# Else do nothing: the module is already present on the system
$processed{$dist_dir} = undef;
}
}
}
unless ( $self->makemaker('6.55_03') ) {
%$prereq = (%$prereq,%$build_prereq);
delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
if ( $self->makemaker(6.48) ) {
$args->{MIN_PERL_VERSION} = $perl_version;
}
}
if ($self->installdirs) {
warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
$args->{INSTALLDIRS} = $self->installdirs;
}
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
sub fix_up_makefile {
my $self = shift;
my $makefile_name = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; };
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
seek MAKEFILE, 0, SEEK_SET;
truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 544
SQL-Translator-0.11024/inc/Module/Install/WriteAll.pm 0000644 0001750 0001750 00000002376 13225114154 021456 0 ustar ilmari ilmari #line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
sub WriteAll {
my $self = shift;
my %args = (
meta => 1,
sign => 0,
inline => 0,
check_nmake => 1,
@_,
);
$self->sign(1) if $args{sign};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
# XXX: This still may be a bit over-defensive...
unless ($self->makemaker(6.25)) {
$self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
}
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
# we clean it up properly ourself.
$self->realclean_files('MYMETA.yml');
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
if ( $args{meta} ) {
$self->Meta->write;
}
# Experimental support for MYMETA
if ( $ENV{X_MYMETA} ) {
if ( $ENV{X_MYMETA} eq 'JSON' ) {
$self->Meta->write_mymeta_json;
} else {
$self->Meta->write_mymeta_yaml;
}
}
return 1;
}
1;
SQL-Translator-0.11024/inc/Module/Install/AuthorTests.pm 0000644 0001750 0001750 00000002215 13225114154 022210 0 ustar ilmari ilmari #line 1
package Module::Install::AuthorTests;
use 5.005;
use strict;
use Module::Install::Base;
use Carp ();
#line 16
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.002';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
#line 42
sub author_tests {
my ($self, @dirs) = @_;
_add_author_tests($self, \@dirs, 0);
}
#line 56
sub recursive_author_tests {
my ($self, @dirs) = @_;
_add_author_tests($self, \@dirs, 1);
}
sub _wanted {
my $href = shift;
sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
}
sub _add_author_tests {
my ($self, $dirs, $recurse) = @_;
return unless $Module::Install::AUTHOR;
my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
# XXX: pick a default, later -- rjbs, 2008-02-24
my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
@dirs = grep { -d } @dirs;
if ($recurse) {
require File::Find;
my %test_dir;
File::Find::find(_wanted(\%test_dir), @dirs);
$self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
} else {
$self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
}
}
#line 107
1;
SQL-Translator-0.11024/inc/Module/Install/Fetch.pm 0000644 0001750 0001750 00000004627 13225114154 020765 0 ustar ilmari ilmari #line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
SQL-Translator-0.11024/inc/Module/Install/Win32.pm 0000644 0001750 0001750 00000003403 13225114154 020625 0 ustar ilmari ilmari #line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
);
die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
Since you are using Microsoft Windows, you will need the 'nmake' utility
before installation. It's available at:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
or
ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
Please download the file manually, save it to a directory in %PATH% (e.g.
C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
that directory, and run "Nmake15.exe" from there; that will create the
'nmake.exe' file needed by this module.
You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
}
1;
SQL-Translator-0.11024/inc/Module/Install/ReadmeFromPod.pm 0000644 0001750 0001750 00000010164 13225114153 022410 0 ustar ilmari ilmari #line 1
package Module::Install::ReadmeFromPod;
use 5.006;
use strict;
use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
$VERSION = '0.30';
{
# these aren't defined until after _require_admin is run, so
# define them so prototypes are available during compilation.
sub io;
sub capture(&;@);
#line 28
my $done = 0;
sub _require_admin {
# do this once to avoid redefinition warnings from IO::All
return if $done;
require IO::All;
IO::All->import( '-binary' );
require Capture::Tiny;
Capture::Tiny->import ( 'capture' );
return;
}
}
sub readme_from {
my $self = shift;
return unless $self->is_admin;
_require_admin;
# Input file
my $in_file = shift || $self->_all_from
or die "Can't determine file to make readme_from";
# Get optional arguments
my ($clean, $format, $out_file, $options);
my $args = shift;
if ( ref $args ) {
# Arguments are in a hashref
if ( ref($args) ne 'HASH' ) {
die "Expected a hashref but got a ".ref($args)."\n";
} else {
$clean = $args->{'clean'};
$format = $args->{'format'};
$out_file = $args->{'output_file'};
$options = $args->{'options'};
}
} else {
# Arguments are in a list
$clean = $args;
$format = shift;
$out_file = shift;
$options = \@_;
}
# Default values;
$clean ||= 0;
$format ||= 'txt';
# Generate README
print "readme_from $in_file to $format\n";
if ($format =~ m/te?xt/) {
$out_file = $self->_readme_txt($in_file, $out_file, $options);
} elsif ($format =~ m/html?/) {
$out_file = $self->_readme_htm($in_file, $out_file, $options);
} elsif ($format eq 'man') {
$out_file = $self->_readme_man($in_file, $out_file, $options);
} elsif ($format eq 'md') {
$out_file = $self->_readme_md($in_file, $out_file, $options);
} elsif ($format eq 'pdf') {
$out_file = $self->_readme_pdf($in_file, $out_file, $options);
}
if ($clean) {
$self->clean_files($out_file);
}
return 1;
}
sub _readme_txt {
my ($self, $in_file, $out_file, $options) = @_;
$out_file ||= 'README';
require Pod::Text;
my $parser = Pod::Text->new( @$options );
my $io = io->file($out_file)->open(">");
my $out_fh = $io->io_handle;
$parser->output_fh( *$out_fh );
$parser->parse_file( $in_file );
return $out_file;
}
sub _readme_htm {
my ($self, $in_file, $out_file, $options) = @_;
$out_file ||= 'README.htm';
require Pod::Html;
my ($o) = capture {
Pod::Html::pod2html(
"--infile=$in_file",
"--outfile=-",
@$options,
);
};
io->file($out_file)->print($o);
# Remove temporary files if needed
for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
if (-e $file) {
unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
}
}
return $out_file;
}
sub _readme_man {
my ($self, $in_file, $out_file, $options) = @_;
$out_file ||= 'README.1';
require Pod::Man;
my $parser = Pod::Man->new( @$options );
my $io = io->file($out_file)->open(">");
my $out_fh = $io->io_handle;
$parser->output_fh( *$out_fh );
$parser->parse_file( $in_file );
return $out_file;
}
sub _readme_pdf {
my ($self, $in_file, $out_file, $options) = @_;
$out_file ||= 'README.pdf';
eval { require App::pod2pdf; }
or die "Could not generate $out_file because pod2pdf could not be found\n";
my $parser = App::pod2pdf->new( @$options );
$parser->parse_from_file($in_file);
my ($o) = capture { $parser->output };
io->file($out_file)->print($o);
return $out_file;
}
sub _readme_md {
my ($self, $in_file, $out_file, $options) = @_;
$out_file ||= 'README.md';
require Pod::Markdown;
my $parser = Pod::Markdown->new( @$options );
my $io = io->file($out_file)->open(">");
my $out_fh = $io->io_handle;
$parser->output_fh( *$out_fh );
$parser->parse_file( $in_file );
return $out_file;
}
sub _all_from {
my $self = shift;
return unless $self->admin->{extensions};
my ($metadata) = grep {
ref($_) eq 'Module::Install::Metadata';
} @{$self->admin->{extensions}};
return unless $metadata;
return $metadata->{values}{all_from} || '';
}
'Readme!';
__END__
#line 316
SQL-Translator-0.11024/inc/Module/Install/Scripts.pm 0000644 0001750 0001750 00000001011 13225114154 021343 0 ustar ilmari ilmari #line 1
package Module::Install::Scripts;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub install_script {
my $self = shift;
my $args = $self->makemaker_args;
my $exe = $args->{EXE_FILES} ||= [];
foreach ( @_ ) {
if ( -f $_ ) {
push @$exe, $_;
} elsif ( -d 'script' and -f "script/$_" ) {
push @$exe, "script/$_";
} else {
die("Cannot find script '$_'");
}
}
}
1;
SQL-Translator-0.11024/inc/Module/Install/AutoInstall.pm 0000644 0001750 0001750 00000004162 13225114154 022165 0 ustar ilmari ilmari #line 1
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.18';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub AutoInstall { $_[0] }
sub run {
my $self = shift;
$self->auto_install_now(@_);
}
sub write {
my $self = shift;
$self->auto_install(@_);
}
sub auto_install {
my $self = shift;
return if $self->{done}++;
# Flatten array of arrays into a single array
my @core = map @$_, map @$_, grep ref,
$self->build_requires, $self->requires;
my @config = @_;
# We'll need Module::AutoInstall
$self->include('Module::AutoInstall');
require Module::AutoInstall;
my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
my %seen;
my @requires = map @$_, map @$_, grep ref, $self->requires;
while (my ($mod, $ver) = splice(@requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @deduped;
while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
}
$self->requires(@deduped);
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
$self->postamble(
"# --- $class section:\n" .
Module::AutoInstall::postamble()
);
}
sub installdeps_target {
my ($self, @args) = @_;
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall::_installdeps_target(1);
$self->auto_install(@args);
}
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
Module::AutoInstall::do_install();
}
1;
SQL-Translator-0.11024/inc/Module/AutoInstall.pm 0000644 0001750 0001750 00000062311 13225114154 020557 0 ustar ilmari ilmari #line 1
package Module::AutoInstall;
use strict;
use Cwd ();
use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.18';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
$Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
$UpgradeDeps
);
my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
$PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
$PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
_init();
sub _accept_default {
$AcceptDefault = shift;
}
sub _installdeps_target {
$InstallDepsTarget = shift;
}
sub missing_modules {
return @Missing;
}
sub do_install {
__PACKAGE__->install(
[
$Config
? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
: ()
],
@Missing,
);
}
# initialize various flags, and/or perform install
sub _init {
foreach my $arg (
@ARGV,
split(
/[\s\t]+/,
$ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
)
)
{
if ( $arg =~ /^--config=(.*)$/ ) {
$Config = [ split( ',', $1 ) ];
}
elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
$UpgradeDeps = 1;
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
elsif ( $arg =~ /^--check(?:deps)?$/ ) {
$CheckOnly = 1;
}
elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
$SkipInstall = 1;
}
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
elsif ( $arg =~ /^--all(?:deps)?$/ ) {
$AllDeps = 1;
}
}
}
# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
my ( $prompt, $default ) = @_;
my $y = ( $default =~ /^[Yy]/ );
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
print "$default\n";
return $default;
}
# the workhorse
sub import {
my $class = shift;
my @args = @_ or return;
my $core_all;
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
my $cwd = Cwd::getcwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
if ( $feature =~ m/^-(\w+)$/ ) {
my $option = lc($1);
# check for a newer version of myself
_update_to( $modules, @_ ) and return if $option eq 'version';
# sets CPAN configuration options
$Config = $modules if $option eq 'config';
# promote every features to core status
$core_all = ( $modules =~ /^all$/i ) and next
if $option eq 'core';
next unless $option eq 'core';
}
print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
my $option = lc($1);
$default = $arg if ( $option eq 'default' );
$conflict = $arg if ( $option eq 'conflict' );
@tests = @{$arg} if ( $option eq 'tests' );
@skiptests = @{$arg} if ( $option eq 'skiptests' );
next;
}
printf( "- %-${maxlen}s ...", $mod );
if ( $arg and $arg =~ /^\D/ ) {
unshift @$modules, $arg;
$arg = 0;
}
# XXX: check for conflicts and uninstalls(!) them.
my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
if (not defined $cur) # indeed missing
{
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
}
else
{
# no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
print "too old. ($cur < $arg)\n";
}
push @required, $mod => $arg;
}
}
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
if (
!$SkipInstall
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or $InstallDepsTarget
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
my $make = $Config::Config{make};
if ($InstallDepsTarget) {
print
"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
}
else {
print
"*** Dependencies will be installed the next time you type '$make'.\n";
}
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
if eval '$>';
}
print "*** $class configuration finished.\n";
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
return (@Existing, @Missing);
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
return unless @Missing or @_;
if ($ENV{PERL5_CPANM_IS_RUNNING}) {
return _running_under('cpanminus');
}
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
}
require CPAN;
if ($CPAN::VERSION > '1.89') {
if ($cpan_env) {
return _running_under('CPAN');
}
return; # CPAN.pm new enough, don't need to check further
}
# last ditch attempt, this -will- configure CPAN, very sorry
_load_cpan(1); # force initialize even though it's already loaded
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
return unless -f $lock;
# Check the lock
local *LOCK;
return unless open(LOCK, $lock);
if (
( $^O eq 'MSWin32' ? _under_cpan() : == getppid() )
and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
) {
print <<'END_MESSAGE';
*** Since we're running under CPAN, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
close LOCK;
return;
}
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed, @modules_to_upgrade );
while (my ($pkg, $ver) = splice(@_, 0, 2)) {
# grep out those already installed
if (_version_cmp(_version_of($pkg), $ver) >= 0) {
push @installed, $pkg;
if ($UpgradeDeps) {
push @modules_to_upgrade, $pkg, $ver;
}
}
else {
push @modules, $pkg, $ver;
}
}
if ($UpgradeDeps) {
push @modules, @modules_to_upgrade;
@installed = ();
@modules_to_upgrade = ();
}
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
print "*** Installing dependencies...\n";
return unless _connected_to('cpan.org');
my %args = @config;
my %failed;
local *FAILED;
if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
while () { chomp; $failed{$_}++ }
close FAILED;
my @newmod;
while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
push @newmod, ( $k => $v ) unless $failed{$k};
}
@modules = @newmod;
}
if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
}
print "*** $class installation finished.\n";
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
print FAILED "$pkg\n";
}
}
close FAILED if $args{do_once};
return @installed;
}
sub _install_cpanplus {
my @modules = @{ +shift };
my @config = _cpanplus_config( @{ +shift } );
my $installed = 0;
require CPANPLUS::Backend;
my $cp = CPANPLUS::Backend->new;
my $conf = $cp->configure_object;
return unless $conf->can('conf') # 0.05x+ with "sudo" support
or _can_write($conf->_get_build('base')); # 0.04x
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $conf->get_conf('makeflags') || '';
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
# 0.03+ uses a hashref here
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
} else {
# 0.02 and below uses a scalar
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
}
$conf->set_conf( makeflags => $makeflags );
$conf->set_conf( prereqs => 1 );
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
$conf->set_conf( $key, $val );
}
my $modtree = $cp->module_tree;
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
print "*** Installing $pkg...\n";
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
my $success;
my $obj = $modtree->{$pkg};
if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $cp->install( modules => [ $obj->{module} ] );
if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
print "*** $pkg successfully installed.\n";
$success = 1;
} else {
print "*** $pkg installation cancelled.\n";
$success = 0;
}
$installed += $success;
} else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _cpanplus_config {
my @config = ();
while ( @_ ) {
my ($key, $value) = (shift(), shift());
if ( $key eq 'prerequisites_policy' ) {
if ( $value eq 'follow' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
} elsif ( $value eq 'ask' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
} elsif ( $value eq 'ignore' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
push @config, 'prereqs', $value;
} elsif ( $key eq 'force' ) {
push @config, $key, $value;
} elsif ( $key eq 'notest' ) {
push @config, 'skiptest', $value;
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
}
return @config;
}
sub _install_cpan {
my @modules = @{ +shift };
my @config = @{ +shift };
my $installed = 0;
my %args;
_load_cpan();
require Config;
if (CPAN->VERSION < 1.80) {
# no "sudo" support, probe for writableness
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
and _can_write( $Config::Config{sitelib} );
}
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^(?:force|notest)$/; # pseudo-option
$CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg;
}
if ($args{notest} && (not CPAN::Shell->can('notest'))) {
die "Your version of CPAN is too old to support the 'notest' pragma";
}
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
print "*** Installing $pkg...\n";
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = do {
if ($args{force}) {
CPAN::Shell->force( install => $pkg )
} elsif ($args{notest}) {
CPAN::Shell->notest( install => $pkg )
} else {
CPAN::Shell->install($pkg)
}
};
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
if $CPAN::META;
};
if ( $rv eq 'YES' ) {
print "*** $pkg successfully installed.\n";
$success = 1;
}
else {
print "*** $pkg installation failed.\n";
$success = 0;
}
$installed += $success;
}
else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _has_cpanplus {
return (
$HasCPANPLUS = (
$INC{'CPANPLUS/Config.pm'}
or _load('CPANPLUS::Shell::Default')
)
);
}
# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
require Cwd;
require File::Spec;
my $cwd = File::Spec->canonpath( Cwd::getcwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
}
sub _update_to {
my $class = __PACKAGE__;
my $ver = shift;
return
if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
'y' ) =~ /^[Nn]/
)
{
die "*** Please install $class $ver manually.\n";
}
print << ".";
*** Trying to fetch it from CPAN...
.
# install ourselves
_load($class) and return $class->import(@_)
if $class->install( [], $class, $ver );
print << '.'; exit 1;
*** Cannot bootstrap myself. :-( Installation terminated.
.
}
# check if we're connected to some host, using inet_aton
sub _connected_to {
my $site = shift;
return (
( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
qq(
*** Your host cannot resolve the domain name '$site', which
probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/
);
}
# check if a directory is writable; may create it on demand
sub _can_write {
my $path = shift;
mkdir( $path, 0755 ) unless -e $path;
return 1 if -w $path;
print << ".";
*** You are not allowed to write to the directory '$path';
the installation may fail due to insufficient permissions.
.
if (
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
qq(
==> Should we try to re-execute the autoinstall process with 'sudo'?),
((-t STDIN) ? 'y' : 'n')
) =~ /^[Yy]/
)
{
# try to bootstrap ourselves from sudo
print << ".";
*** Trying to re-execute the autoinstall process with 'sudo'...
.
my $missing = join( ',', @Missing );
my $config = join( ',',
UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/;
}
# load a module and return the version it reports
sub _load {
my $mod = pop; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# report version without loading a module
sub _version_of {
my $mod = pop; # method/function doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
foreach my $dir ( @INC ) {
next if ref $dir;
my $path = File::Spec->catfile($dir, $file);
next unless -e $path;
require ExtUtils::MM_Unix;
return ExtUtils::MM_Unix->parse_version($path);
}
return undef;
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
# CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
# CPAN::HandleConfig->load. CPAN reports that the redirection
# is deprecated in a warning printed at the user.
# CPAN-1.81 expects CPAN::HandleConfig->load, does not have
# $CPAN::HandleConfig::VERSION but cannot handle
# CPAN::Config->load
# Which "versions expect CPAN::Config->load?
if ( $CPAN::HandleConfig::VERSION
|| CPAN::HandleConfig->can('load')
) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
# Older versions had the load method in Config directly
CPAN::Config->load;
}
}
# compare two versions, either use Sort::Versions or plain comparison
# return values same as <=>
sub _version_cmp {
my ( $cur, $min ) = @_;
return -1 unless defined $cur; # if 0 keep comparing
return 1 unless $min;
$cur =~ s/\s+$//;
# check for version numbers that are not in decimal format
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
if ( ( $version::VERSION or defined( _load('version') )) and
version->can('new')
) {
# use version.pm if it is installed.
return version->new($cur) <=> version->new($min);
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return Sort::Versions::versioncmp( $cur, $min );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return $cur <=> $min;
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
sub _make_args {
my %args = @_;
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
if $UnderCPAN or $TestOnly;
if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
require ExtUtils::Manifest;
my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
$args{EXE_FILES} =
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
$PostambleActions = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
my $deps_list = join( ',', @Missing, @Existing );
$PostambleActionsUpgradeDeps =
"\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
my $config_notest =
join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
'notest', 1 )
if $Config;
$PostambleActionsNoTest = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
$PostambleActionsUpgradeDepsNoTest =
"\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
$PostambleActionsListDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
my @all = (@Missing, @Existing);
$PostambleActionsListAllDeps =
'@$(PERL) -le "print for @ARGV" '
. join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
return %args;
}
# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
require Carp;
Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
if ($CheckOnly) {
print << ".";
*** Makefile not written in check-only mode.
.
return;
}
my %args = _make_args(@_);
no strict 'refs';
$PostambleUsed = 0;
local *MY::postamble = \&postamble unless defined &MY::postamble;
ExtUtils::MakeMaker::WriteMakefile(%args);
print << "." unless $PostambleUsed;
*** WARNING: Makefile written with customized MY::postamble() without
including contents from Module::AutoInstall::postamble() --
auto installation features disabled. Please contact the author.
.
return 1;
}
sub postamble {
$PostambleUsed = 1;
my $fragment;
$fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
AUTO_INSTALL
$fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
installdeps ::
\t$PostambleActions
installdeps_notest ::
\t$PostambleActionsNoTest
upgradedeps ::
\t$PostambleActionsUpgradeDeps
upgradedeps_notest ::
\t$PostambleActionsUpgradeDepsNoTest
listdeps ::
\t$PostambleActionsListDeps
listalldeps ::
\t$PostambleActionsListAllDeps
END_MAKE
return $fragment;
}
1;
__END__
#line 1197
SQL-Translator-0.11024/t/ 0000755 0001750 0001750 00000000000 13225114407 014225 5 ustar ilmari ilmari SQL-Translator-0.11024/t/30sqlt-new-diff-sqlite.t 0000644 0001750 0001750 00000010502 12375130371 020535 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use warnings;
use SQL::Translator;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use Test::More;
use Test::Differences;
use Test::SQL::Translator qw(maybe_plan);
plan tests => 4;
use_ok('SQL::Translator::Diff') or die "Cannot continue\n";
my $tr = SQL::Translator->new;
my ( $source_schema, $target_schema ) = map {
my $t = SQL::Translator->new;
$t->parser( 'YAML' )
or die $tr->error;
my $out = $t->translate( catfile($Bin, qw/data diff/, $_ ) )
or die $tr->error;
my $schema = $t->schema;
unless ( $schema->name ) {
$schema->name( $_ );
}
($schema);
} (qw/create1.yml create2.yml/);
# Test for differences
my $out = SQL::Translator::Diff::schema_diff( $source_schema, 'SQLite', $target_schema, 'SQLite',
{ no_batch_alters => 1,
ignore_missing_methods => 1,
output_db => 'SQLite',
}
);
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
CREATE TABLE added (
id int(11)
);
ALTER TABLE old_name RENAME TO new_name;
DROP INDEX FK5302D47D93FE702E;
DROP INDEX UC_age_name;
DROP INDEX u_name;
-- SQL::Translator::Producer::SQLite cant drop_field;
ALTER TABLE new_name ADD COLUMN new_field int;
ALTER TABLE person ADD COLUMN is_rock_star tinyint(4) DEFAULT 1;
-- SQL::Translator::Producer::SQLite cant alter_field;
-- SQL::Translator::Producer::SQLite cant rename_field;
CREATE UNIQUE INDEX unique_name ON person (name);
CREATE UNIQUE INDEX UC_person_id ON person (person_id);
CREATE UNIQUE INDEX UC_age_name ON person (age, name);
DROP TABLE deleted;
COMMIT;
## END OF DIFF
$out = SQL::Translator::Diff::schema_diff($source_schema, 'SQLite', $target_schema, 'SQLite',
{ ignore_index_names => 1,
ignore_constraint_names => 1,
output_db => 'SQLite',
});
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
CREATE TABLE added (
id int(11)
);
CREATE TEMPORARY TABLE employee_temp_alter (
position varchar(50) NOT NULL,
employee_id int(11) NOT NULL,
PRIMARY KEY (position, employee_id),
FOREIGN KEY (employee_id) REFERENCES person(person_id)
);
INSERT INTO employee_temp_alter( position, employee_id) SELECT position, employee_id FROM employee;
DROP TABLE employee;
CREATE TABLE employee (
position varchar(50) NOT NULL,
employee_id int(11) NOT NULL,
PRIMARY KEY (position, employee_id),
FOREIGN KEY (employee_id) REFERENCES person(person_id)
);
INSERT INTO employee SELECT position, employee_id FROM employee_temp_alter;
DROP TABLE employee_temp_alter;
ALTER TABLE old_name RENAME TO new_name;
ALTER TABLE new_name ADD COLUMN new_field int;
CREATE TEMPORARY TABLE person_temp_alter (
person_id INTEGER PRIMARY KEY NOT NULL,
name varchar(20) NOT NULL,
age int(11) DEFAULT 18,
weight double(11,2),
iq int(11) DEFAULT 0,
is_rock_star tinyint(4) DEFAULT 1,
value double(8,2) DEFAULT 0.00,
physical_description text
);
INSERT INTO person_temp_alter( person_id, name, age, weight, iq, value, physical_description) SELECT person_id, name, age, weight, iq, value, description FROM person;
DROP TABLE person;
CREATE TABLE person (
person_id INTEGER PRIMARY KEY NOT NULL,
name varchar(20) NOT NULL,
age int(11) DEFAULT 18,
weight double(11,2),
iq int(11) DEFAULT 0,
is_rock_star tinyint(4) DEFAULT 1,
value double(8,2) DEFAULT 0.00,
physical_description text
);
CREATE UNIQUE INDEX unique_name02 ON person (name);
CREATE UNIQUE INDEX UC_person_id02 ON person (person_id);
CREATE UNIQUE INDEX UC_age_name02 ON person (age, name);
INSERT INTO person SELECT person_id, name, age, weight, iq, is_rock_star, value, physical_description FROM person_temp_alter;
DROP TABLE person_temp_alter;
DROP TABLE deleted;
COMMIT;
## END OF DIFF
# Note the 02 in the 3 names above (end of diff) are an implementation
# quirk - there is nothing to reset the global seen-names register
# The rewrite should abolish this altogether, and carry the register in
# the main schema object
# Test for sameness
$out = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $source_schema, 'MySQL' );
eq_or_diff($out, <<'## END OF DIFF', "No differences found");
-- Convert schema 'create1.yml' to 'create1.yml':;
-- No differences found;
## END OF DIFF
SQL-Translator-0.11024/t/38-mysql-producer.t 0000644 0001750 0001750 00000071570 12542755372 017657 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
#
# Note that the bulk of the testing for the mysql producer is in
# 08postgres-to-mysql.t. This test is for additional stuff that can't be tested
# using an Oracle schema as source e.g. extra attributes.
#
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
use FindBin qw/$Bin/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(75,
'YAML',
'SQL::Translator::Producer::MySQL',
'Test::Differences',
)
}
use Test::Differences;
use SQL::Translator;
# Main test.
{
my $yaml_in = <new(
show_warnings => 1,
no_comments => 1,
# debug => 1,
from => "YAML",
to => "MySQL",
quote_table_names => 1,
quote_field_names => 1
);
my $out = $sqlt->translate(\$yaml_in)
or die "Translate error:".$sqlt->error;
ok $out ne "", "Produced something!";
eq_or_diff $out, $mysql_out, "Scalar output looks right with quoting";
my @out = $sqlt->translate(\$yaml_in)
or die "Translat eerror:".$sqlt->error;
is_deeply \@out, \@stmts_no_drop, "Array output looks right with quoting";
$sqlt->quote_identifiers(0);
$out = $sqlt->translate(\$yaml_in)
or die "Translate error:".$sqlt->error;
@out = $sqlt->translate(\$yaml_in)
or die "Translate error:".$sqlt->error;
$mysql_out =~ s/`//g;
my @unquoted_stmts = map { s/`//g; $_} @stmts_no_drop;
eq_or_diff $out, $mysql_out, "Output looks right without quoting";
is_deeply \@out, \@unquoted_stmts, "Array output looks right without quoting";
$sqlt->quote_identifiers(1);
$sqlt->add_drop_table(1);
@out = $sqlt->translate(\$yaml_in)
or die "Translat eerror:".$sqlt->error;
$out = $sqlt->translate(\$yaml_in)
or die "Translat eerror:".$sqlt->error;
eq_or_diff $out, join(";\n\n", @stmts) . ";\n\n", "Output looks right with DROP TABLEs";
is_deeply \@out, \@stmts, "Array output looks right with DROP TABLEs";
}
###############################################################################
# New alter/add subs
{
my $table = SQL::Translator::Schema::Table->new( name => 'mytable');
my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field1_sql = SQL::Translator::Producer::MySQL::create_field($field1);
is($field1_sql, 'myfield VARCHAR(10) NULL', 'Create field works');
my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 25,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $alter_field = SQL::Translator::Producer::MySQL::alter_field($field1,
$field2);
is($alter_field, 'ALTER TABLE mytable CHANGE COLUMN myfield myfield VARCHAR(25) NOT NULL', 'Alter field works');
my $add_field = SQL::Translator::Producer::MySQL::add_field($field1);
is($add_field, 'ALTER TABLE mytable ADD COLUMN myfield VARCHAR(10) NULL', 'Add field works');
my $drop_field = SQL::Translator::Producer::MySQL::drop_field($field2);
is($drop_field, 'ALTER TABLE mytable DROP COLUMN myfield', 'Drop field works');
my $field3 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'boolean',
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field3_sql = SQL::Translator::Producer::MySQL::create_field($field3, { mysql_version => 4.1 });
is($field3_sql, 'myfield boolean NOT NULL', 'For Mysql >= 4, use boolean type');
$field3_sql = SQL::Translator::Producer::MySQL::create_field($field3, { mysql_version => 3.22 });
is($field3_sql, "myfield enum('0','1') NOT NULL", 'For Mysql < 4, use enum for boolean type');
$field3_sql = SQL::Translator::Producer::MySQL::create_field($field3,);
is($field3_sql, "myfield enum('0','1') NOT NULL", 'When no version specified, use enum for boolean type');
my $number_sizes = {
'3, 2' => 'double',
12 => 'bigint',
1 => 'tinyint',
4 => 'int',
};
for my $size (keys %$number_sizes) {
my $expected = $number_sizes->{$size};
my $number_field = SQL::Translator::Schema::Field->new(
name => "numberfield_$expected",
table => $table,
data_type => 'number',
size => $size,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
is(
SQL::Translator::Producer::MySQL::create_field($number_field),
"numberfield_$expected $expected($size) NULL",
"Use $expected for NUMBER types of size $size"
);
}
my $varchars;
for my $size (qw/255 256 65535 65536/) {
$varchars->{$size} = SQL::Translator::Schema::Field->new(
name => "vch_$size",
table => $table,
data_type => 'varchar',
size => $size,
is_nullable => 1,
);
}
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}, { mysql_version => 5.000003 }),
'vch_255 varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}, { mysql_version => 5.0 }),
'vch_255 varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}),
'vch_255 varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}, { mysql_version => 5.000003 }),
'vch_256 varchar(256) NULL',
'VARCHAR(256) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}, { mysql_version => 5.0 }),
'vch_256 text NULL',
'VARCHAR(256) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}),
'vch_256 text NULL',
'VARCHAR(256) is substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}, { mysql_version => 5.000003 }),
'vch_65535 varchar(65535) NULL',
'VARCHAR(65535) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}, { mysql_version => 5.0 }),
'vch_65535 text NULL',
'VARCHAR(65535) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}),
'vch_65535 text NULL',
'VARCHAR(65535) is substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}, { mysql_version => 5.000003 }),
'vch_65536 text NULL',
'VARCHAR(65536) is substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}, { mysql_version => 5.0 }),
'vch_65536 text NULL',
'VARCHAR(65536) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}),
'vch_65536 text NULL',
'VARCHAR(65536) is substituted with TEXT when no version specified',
);
{
my $view1 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',
extra => {
mysql_definer => 'CURRENT_USER',
mysql_algorithm => 'MERGE',
mysql_security => 'DEFINER',
});
my $create_opts = { add_replace_view => 1, no_comments => 1 };
my $view1_sql1 = SQL::Translator::Producer::MySQL::create_view($view1, $create_opts);
my $view_sql_replace = <<'EOV';
CREATE OR REPLACE
ALGORITHM = MERGE
DEFINER = CURRENT_USER
SQL SECURITY DEFINER
VIEW view_foo ( id, name ) AS
SELECT id, name FROM thing
EOV
is($view1_sql1, $view_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL');
my $view2 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',);
my $create2_opts = { add_replace_view => 0, no_comments => 1 };
my $view1_sql2 = SQL::Translator::Producer::MySQL::create_view($view2, $create2_opts);
my $view_sql_noreplace = <<'EOV';
CREATE
VIEW view_foo ( id, name ) AS
SELECT id, name FROM thing
EOV
is($view1_sql2, $view_sql_noreplace, 'correct "CREATE VIEW" SQL');
{
my %extra = $view1->extra;
is_deeply \%extra,
{
'mysql_algorithm' => 'MERGE',
'mysql_definer' => 'CURRENT_USER',
'mysql_security' => 'DEFINER'
},
'Extra attributes';
}
$view1->remove_extra(qw/mysql_definer mysql_security/);
{
my %extra = $view1->extra;
is_deeply \%extra, { 'mysql_algorithm' => 'MERGE', }, 'Extra attributes after first reset_extra call';
}
$view1->remove_extra();
{
my %extra = $view1->extra;
is_deeply \%extra, {}, 'Extra attributes completely removed';
}
}
{
# certain types do not support a size, see also:
# http://dev.mysql.com/doc/refman/5.1/de/create-table.html
for my $type (qw/date time timestamp datetime year/) {
my $field = SQL::Translator::Schema::Field->new(
name => "my$type",
table => $table,
data_type => $type,
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
my $sql = SQL::Translator::Producer::MySQL::create_field($field);
is($sql, "my$type $type NULL", "Skip length param for type $type");
}
}
} #non quoted test
{
#Quoted test
my $table = SQL::Translator::Schema::Table->new( name => 'mydb.mytable');
my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 25,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field3 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'boolean',
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $qt = '`';
my $qf = '`';
my $options = {
quote_table_names => $qt,
quote_field_names => $qf,
};
my $alter_field = SQL::Translator::Producer::MySQL::alter_field($field1, $field2, $options);
is($alter_field, 'ALTER TABLE `mydb`.`mytable` CHANGE COLUMN `myfield` `myfield` VARCHAR(25) NOT NULL', 'Alter field works');
my $add_field = SQL::Translator::Producer::MySQL::add_field($field1, $options);
is($add_field, 'ALTER TABLE `mydb`.`mytable` ADD COLUMN `myfield` VARCHAR(10) NULL', 'Add field works');
my $drop_field = SQL::Translator::Producer::MySQL::drop_field($field2, $options);
is($drop_field, 'ALTER TABLE `mydb`.`mytable` DROP COLUMN `myfield`', 'Drop field works');
my $field3_sql = SQL::Translator::Producer::MySQL::create_field($field3, { mysql_version => 4.1, %$options });
is($field3_sql, '`myfield` boolean NOT NULL', 'For Mysql >= 4, use boolean type');
$field3_sql = SQL::Translator::Producer::MySQL::create_field($field3, { mysql_version => 3.22, %$options });
is($field3_sql, "`myfield` enum('0','1') NOT NULL", 'For Mysql < 4, use enum for boolean type');
$field3_sql = SQL::Translator::Producer::MySQL::create_field($field3,$options);
is($field3_sql, "`myfield` enum('0','1') NOT NULL", 'When no version specified, use enum for boolean type');
my $number_sizes = {
'3, 2' => 'double',
12 => 'bigint',
1 => 'tinyint',
4 => 'int',
};
for my $size (keys %$number_sizes) {
my $expected = $number_sizes->{$size};
my $number_field = SQL::Translator::Schema::Field->new(
name => "numberfield_$expected",
table => $table,
data_type => 'number',
size => $size,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
is(
SQL::Translator::Producer::MySQL::create_field($number_field, $options),
"`numberfield_$expected` $expected($size) NULL",
"Use $expected for NUMBER types of size $size"
);
}
my $varchars;
for my $size (qw/255 256 65535 65536/) {
$varchars->{$size} = SQL::Translator::Schema::Field->new(
name => "vch_$size",
table => $table,
data_type => 'varchar',
size => $size,
is_nullable => 1,
);
}
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}, { mysql_version => 5.000003, %$options }),
'`vch_255` varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}, { mysql_version => 5.0, %$options }),
'`vch_255` varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{255}, $options),
'`vch_255` varchar(255) NULL',
'VARCHAR(255) is not substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}, { mysql_version => 5.000003, %$options }),
'`vch_256` varchar(256) NULL',
'VARCHAR(256) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}, { mysql_version => 5.0, %$options }),
'`vch_256` text NULL',
'VARCHAR(256) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{256}, $options),
'`vch_256` text NULL',
'VARCHAR(256) is substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}, { mysql_version => 5.000003, %$options }),
'`vch_65535` varchar(65535) NULL',
'VARCHAR(65535) is not substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}, { mysql_version => 5.0, %$options }),
'`vch_65535` text NULL',
'VARCHAR(65535) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65535}, $options),
'`vch_65535` text NULL',
'VARCHAR(65535) is substituted with TEXT when no version specified',
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}, { mysql_version => 5.000003, %$options }),
'`vch_65536` text NULL',
'VARCHAR(65536) is substituted with TEXT for Mysql >= 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}, { mysql_version => 5.0, %$options }),
'`vch_65536` text NULL',
'VARCHAR(65536) is substituted with TEXT for Mysql < 5.0.3'
);
is (
SQL::Translator::Producer::MySQL::create_field($varchars->{65536}, $options),
'`vch_65536` text NULL',
'VARCHAR(65536) is substituted with TEXT when no version specified',
);
{
my $view1 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT `id`, `name` FROM `my`.`thing`',
extra => {
mysql_definer => 'CURRENT_USER',
mysql_algorithm => 'MERGE',
mysql_security => 'DEFINER',
});
my $create_opts = { add_replace_view => 1, no_comments => 1, %$options };
my $view1_sql1 = SQL::Translator::Producer::MySQL::create_view($view1, $create_opts);
my $view_sql_replace = <<'EOV';
CREATE OR REPLACE
ALGORITHM = MERGE
DEFINER = CURRENT_USER
SQL SECURITY DEFINER
VIEW `view_foo` ( `id`, `name` ) AS
SELECT `id`, `name` FROM `my`.`thing`
EOV
is($view1_sql1, $view_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL');
my $view2 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT `id`, `name` FROM `my`.`thing`',);
my $create2_opts = { add_replace_view => 0, no_comments => 1, %$options };
my $view1_sql2 = SQL::Translator::Producer::MySQL::create_view($view2, $create2_opts);
my $view_sql_noreplace = <<'EOV';
CREATE
VIEW `view_foo` ( `id`, `name` ) AS
SELECT `id`, `name` FROM `my`.`thing`
EOV
is($view1_sql2, $view_sql_noreplace, 'correct "CREATE VIEW" SQL');
{
my %extra = $view1->extra;
is_deeply \%extra,
{
'mysql_algorithm' => 'MERGE',
'mysql_definer' => 'CURRENT_USER',
'mysql_security' => 'DEFINER'
},
'Extra attributes';
}
$view1->remove_extra(qw/mysql_definer mysql_security/);
{
my %extra = $view1->extra;
is_deeply \%extra, { 'mysql_algorithm' => 'MERGE', }, 'Extra attributes after first reset_extra call';
}
$view1->remove_extra();
{
my %extra = $view1->extra;
is_deeply \%extra, {}, 'Extra attributes completely removed';
}
}
{
# certain types do not support a size, see also:
# http://dev.mysql.com/doc/refman/5.1/de/create-table.html
for my $type (qw/date time timestamp datetime year/) {
my $field = SQL::Translator::Schema::Field->new(
name => "my$type",
table => $table,
data_type => $type,
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
my $sql = SQL::Translator::Producer::MySQL::create_field($field, $options);
is($sql, "`my$type` $type NULL", "Skip length param for type $type");
}
}
}
{ # test for rt62250
my $table = SQL::Translator::Schema::Table->new(name => 'table');
$table->add_field(
SQL::Translator::Schema::Field->new( name => 'mypk',
table => $table,
data_type => 'INT',
size => 10,
default_value => undef,
is_auto_increment => 1,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 1 ));
my $constraint = $table->add_constraint(fields => ['mypk'], type => 'PRIMARY_KEY');
my $options = {quote_table_names => '`'};
is(SQL::Translator::Producer::MySQL::alter_drop_constraint($constraint,$options),
'ALTER TABLE `table` DROP PRIMARY KEY','valid drop primary key');
}
{
my $schema = SQL::Translator::Schema->new();
my $table = $schema->add_table( name => 'foo', fields => ['bar'] );
{
my $trigger = $schema->add_trigger(
name => 'mytrigger',
perform_action_when => 'before',
database_events => 'update',
on_table => 'foo',
fields => ['bar'],
action => 'BEGIN baz(); END'
);
my ($def) = SQL::Translator::Producer::MySQL::create_trigger($trigger);
my $expected
= "--\n"
. "-- Trigger mytrigger\n"
. "--\n"
. "CREATE TRIGGER mytrigger before update ON foo\n"
. " FOR EACH ROW BEGIN baz(); END";
is($def, $expected, 'trigger created');
}
{
my $trigger = $schema->add_trigger(
name => 'mytrigger2',
perform_action_when => 'after',
database_events => ['insert'],
on_table => 'foo',
fields => ['bar'],
action => 'baz()'
);
my ($def) = SQL::Translator::Producer::MySQL::create_trigger($trigger);
my $expected
= "--\n"
. "-- Trigger mytrigger2\n"
. "--\n"
. "CREATE TRIGGER mytrigger2 after insert ON foo\n"
. " FOR EACH ROW BEGIN baz(); END";
is($def, $expected, 'trigger created');
}
}
SQL-Translator-0.11024/t/29html.t 0000644 0001750 0001750 00000004600 12411003422 015517 0 ustar ilmari ilmari #!/usr/local/bin/perl -w
# vim: set ft=perl:
# This test creates an HTML::Parser instance and uses it to selectively
# parse the output of the HTML producer. Rather than try to ensure
# that the produced HTML turns into a particular parse tree or anything
# like that, it performs some heuristics on the output.
use strict;
use vars qw(%HANDLERS);
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
BEGIN {
maybe_plan(5,
'CGI',
'HTML::Parser',
'SQL::Translator::Parser::MySQL',
'SQL::Translator::Producer::HTML');
}
my ($p, $tables, $classes);
$p = HTML::Parser->new(api_version => 3);
$p->strict_names(1);
my $create = q|
CREATE TABLE foo (
int id PRIMARY KEY AUTO_INCREMENT NOT NULL,
name VARCHAR(255)
);
|;
my $tr = SQL::Translator->new(parser => 'MySQL', producer => 'HTML');
my $parsed = $tr->translate(data => $create) or die $tr->error;
my $status;
eval {
$status = $p->parse($parsed);
};
if ($@) {
daig $@;
fail("Unable to parse the output!");
}
# General
ok($parsed, "Parsed table OK");
ok($status, "Parsed HTML OK");
$p->handler(start => @{$HANDLERS{count_tables}});
$p->parse($parsed);
is($tables, 3, "One table in the SQL produces 3 tags");
$tables = $classes = 0;
$p->handler(start => @{$HANDLERS{count_classes}});
$p->parse($parsed);
is($classes, 1, "One 'LinkTable' class");
$tables = $classes = 0;
$p->handler(start => @{$HANDLERS{sqlfairy}});
$p->parse($parsed);
is($classes, 1, "SQLfairy plug is alive and well ");
$tables = $classes = 0;
# Handler functions for the parser
BEGIN {
%HANDLERS = (
count_tables => [
sub {
my $tagname = shift;
$tables++ if ($tagname eq 'table');
}, 'tagname',
],
count_classes => [
sub {
my ($tagname, $attr) = @_;
if ($tagname eq 'table' &&
$attr->{'class'} &&
$attr->{'class'} eq 'LinkTable') {
$classes++;
}
}, 'tagname,attr',
],
sqlfairy => [
sub {
my ($tagname, $attr) = @_;
if ($tagname eq 'a' &&
$attr->{'href'} &&
$attr->{'href'} =~ /sqlfairy/i) {
$classes++;
}
}, 'tagname,attr',
],
);
}
SQL-Translator-0.11024/t/03mysql-to-oracle.t 0000644 0001750 0001750 00000002046 12421750467 017620 0 ustar ilmari ilmari #!/usr/local/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator;
use Test::SQL::Translator qw(maybe_plan);
my $create = q|
CREATE TABLE random (
id int auto_increment PRIMARY KEY,
foo varchar(255) not null default '',
bar enum('wibble','wo''bble'),
updated timestamp
);
CREATE UNIQUE INDEX random_foo_update ON random(foo,updated);
CREATE INDEX random_foo ON random(foo);
|;
BEGIN {
maybe_plan(undef,
'SQL::Translator::Parser::MySQL',
'SQL::Translator::Producer::Oracle');
}
my $tr = SQL::Translator->new(
parser => "MySQL",
producer => "Oracle",
quote_table_names => 0,
quote_field_names => 0,
);
my $output = $tr->translate(\$create);
ok( $output, 'Translate MySQL to Oracle' );
ok( $output =~ /CREATE INDEX random_foo /, 'Normal index definition translated.');
ok( $output =~ /CREATE UNIQUE INDEX random_foo_update /, 'Unique index definition translated.');
ok( $output =~ /\QCHECK (bar IN ('wibble', 'wo''bble'))\E/, 'Enum translated and escaped.');
done_testing;
SQL-Translator-0.11024/t/15oracle-parser.t 0000644 0001750 0001750 00000027076 12163313615 017335 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan);
maybe_plan(99, 'SQL::Translator::Parser::Oracle');
SQL::Translator::Parser::Oracle->import('parse');
my $t = SQL::Translator->new( trace => 0 );
my $sql = q[
CREATE TABLE qtl_trait_category
(
qtl_trait_category_id NUMBER(11) NOT NULL
CONSTRAINT pk_qtl_trait_category PRIMARY KEY,
trait_category VARCHAR2(100) NOT NULL,
CONSTRAINT AVCON_4287_PARAM_000 CHECK
(trait_category IN ('S', 'A', 'E')) ENABLE,
UNIQUE ( trait_category )
);
COMMENT ON TABLE qtl_trait_category IS
'hey, hey, hey, hey';
comment on column qtl_trait_category.qtl_trait_category_id
is 'the primary key!';
-- foo bar comment
CREATE TABLE qtl_trait
(
qtl_trait_id NUMBER(11) NOT NULL
CONSTRAINT pk_qtl_trait PRIMARY KEY,
trait_symbol VARCHAR2(100 BYTE) NOT NULL,
trait_name VARCHAR2(200 CHAR) NOT NULL,
qtl_trait_category_id NUMBER(11) NOT NULL,
UNIQUE ( trait_symbol ),
UNIQUE ( trait_name ),
FOREIGN KEY ( qtl_trait_category_id ) REFERENCES qtl_trait_category
);
/* qtl table comment */
CREATE TABLE qtl
(
/* qtl_id comment */
qtl_id NUMBER(11) NOT NULL
CONSTRAINT pk_qtl PRIMARY KEY,
qtl_accession_id VARCHAR2(20) NOT NULL /* accession comment */,
published_symbol VARCHAR2(100),
qtl_trait_id NUMBER(11) NOT NULL,
linkage_group VARCHAR2(32) NOT NULL,
start_position NUMBER(11,2) NOT NULL,
stop_position NUMBER(11,2) NOT NULL,
comments long,
FOREIGN KEY ( qtl_trait_id ) REFERENCES qtl_trait
);
CREATE UNIQUE INDEX qtl_accession ON qtl ( qtl_accession_id );
CREATE UNIQUE INDEX qtl_accession_upper ON qtl ( UPPER(qtl_accession_id) );
CREATE INDEX qtl_index ON qtl ( qtl_accession_id );
CREATE TABLE qtl_trait_synonym
(
qtl_trait_synonym_id NUMBER(11) NOT NULL
CONSTRAINT pk_qtl_trait_synonym PRIMARY KEY,
trait_synonym VARCHAR2(200) NOT NULL,
qtl_trait_id NUMBER(11) NOT NULL,
UNIQUE( qtl_trait_id, trait_synonym ),
FOREIGN KEY ( qtl_trait_id ) REFERENCES qtl_trait ON DELETE SET NULL
);
-- View and procedure testing
CREATE OR REPLACE PROCEDURE CMDOMAIN_LATEST.P_24_HOUR_EVENT_SUMMARY
IS
ldate varchar2(10);
user_added INT;
user_deleted INT;
workingsets_created INT;
change_executed INT;
change_detected INT;
reports_run INT;
backup_complete INT;
backup_failed INT;
devices_in_inventory INT;
BEGIN
select CAST(TO_CHAR(sysdate,'MM/DD/YYYY') AS varchar2(10)) INTO ldate from dual;
END;
/
CREATE OR REPLACE FORCE VIEW CMDOMAIN_MIG.VS_ASSET (ASSET_ID, FQ_NAME, FOLDER_NAME, ASSET_NAME, ANNOTATION, ASSET_TYPE, FOREIGN_ASSET_ID, FOREIGN_ASSET_ID2, DATE_CREATED, DATE_MODIFIED, CONTAINER_ID, CREATOR_ID, MODIFIER_ID, USER_ACCESS) AS
SELECT
a.asset_id, a.fq_name,
ap_extract_folder(a.fq_name) AS folder_name,
ap_extract_asset(a.fq_name) AS asset_name,
a.annotation,
a.asset_type,
a.foreign_asset_id,
a.foreign_asset_id2,
a.dateCreated AS date_created,
a.dateModified AS date_modified,
a.container_id,
a.creator_id,
a.modifier_id,
m.user_id AS user_access
from asset a
JOIN M_ACCESS_CONTROL m on a.acl_id = m.acl_id;
];
$| = 1;
my $data = parse( $t, $sql );
my $schema = $t->schema;
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema object' );
my @tables = $schema->get_tables;
is( scalar @tables, 4, 'Found four tables' );
#
# qtl_trait_category
#
my $t1 = shift @tables;
is( $t1->name, 'qtl_trait_category', 'First table is "qtl_trait_category"' );
is( $t1->comments, 'hey, hey, hey, hey', 'Comment = "hey, hey, hey, hey"' );
my @t1_fields = $t1->get_fields;
is( scalar @t1_fields, 2, '2 fields in table' );
my $f1 = shift @t1_fields;
is( $f1->name, 'qtl_trait_category_id',
'First field is "qtl_trait_category_id"' );
is( $f1->data_type, 'number', 'Field is a number' );
is( $f1->size, 11, 'Size is "11"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, undef, 'Default value is undefined' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( join(',', $f1->comments), 'the primary key!', 'Comment = "the primary key!"' );
my $f2 = shift @t1_fields;
is( $f2->name, 'trait_category', 'Second field is "trait_category"' );
is( $f2->data_type, 'varchar2', 'Field is a varchar2' );
is( $f2->size, 100, 'Size is "100"' );
is( $f2->is_nullable, 0, 'Field cannot be null' );
is( $f2->default_value, undef, 'Default value is undefined' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my @t1_indices = $t1->get_indices;
is( scalar @t1_indices, 0, '0 indices on table' );
my @t1_constraints = $t1->get_constraints;
#use Data::Dumper;
#print STDERR Dumper(\@t1_constraints), "\n";
is( scalar @t1_constraints, 3, '3 constraints on table' );
my $c1 = $t1_constraints[0];
is( $c1->name, 'pk_qtl_trait_category',
'Constraint name is "pk_qtl_trait_category"' );
is( $c1->type, PRIMARY_KEY, 'First constraint is PK' );
is( join(',', $c1->fields), 'qtl_trait_category_id',
'Constraint is on field "qtl_trait_category_id"' );
my $c2 = $t1_constraints[1];
is( $c2->type, CHECK_C, 'Second constraint is a check' );
is( $c2->expression,
"( trait_category IN ('S', 'A', 'E') ) ENABLE",
'Constraint is on field "trait_category"' );
my $c3 = $t1_constraints[2];
is( $c3->type, UNIQUE, 'Third constraint is unique' );
is( join(',', $c3->fields), 'trait_category',
'Constraint is on field "trait_category"' );
#
# qtl_trait
#
my $t2 = shift @tables;
is( $t2->name, 'qtl_trait', 'Table "qtl_trait" exists' );
is( $t2->comments, 'foo bar comment', 'Comment "foo bar" exists' );
my @t2_fields = $t2->get_fields;
is( scalar @t2_fields, 4, '4 fields in table' );
my $t2_f1 = shift @t2_fields;
is( $t2_f1->name, 'qtl_trait_id', 'First field is "qtl_trait_id"' );
is( $t2_f1->data_type, 'number', 'Field is a number' );
is( $t2_f1->size, 11, 'Size is "11"' );
is( $t2_f1->is_nullable, 0, 'Field cannot be null' );
is( $t2_f1->default_value, undef, 'Default value is undefined' );
is( $t2_f1->is_primary_key, 1, 'Field is PK' );
my $t2_f2 = shift @t2_fields;
is( $t2_f2->name, 'trait_symbol', 'Second field is "trait_symbol"' );
is( $t2_f2->data_type, 'varchar2', 'Field is a varchar2' );
is( $t2_f2->size, 100, 'Size is "100"' );
is( $t2_f2->is_nullable, 0, 'Field cannot be null' );
is( $t2_f2->is_foreign_key, 0, 'Field is not a FK' );
my $t2_f3 = shift @t2_fields;
is( $t2_f3->name, 'trait_name', 'Third field is "trait_name"' );
is( $t2_f3->data_type, 'varchar2', 'Field is a varchar2' );
is( $t2_f3->size, 200, 'Size is "200"' );
is( $t2_f3->is_nullable, 0, 'Field cannot be null' );
is( $t2_f3->is_foreign_key, 0, 'Field is not a FK' );
my $t2_f4 = shift @t2_fields;
is( $t2_f4->name, 'qtl_trait_category_id',
'Fourth field is "qtl_trait_category_id"' );
is( $t2_f4->data_type, 'number', 'Field is a number' );
is( $t2_f4->size, 11, 'Size is "11"' );
is( $t2_f4->is_nullable, 0, 'Field cannot be null' );
is( $t2_f4->is_foreign_key, 1, 'Field is a FK' );
my $f4_fk = $t2_f4->foreign_key_reference;
isa_ok( $f4_fk, 'SQL::Translator::Schema::Constraint', 'FK' );
is( $f4_fk->reference_table, 'qtl_trait_category',
'FK references table "qtl_trait_category"' );
is( join(',', $f4_fk->reference_fields), 'qtl_trait_category_id',
'FK references field "qtl_trait_category_id"' );
my @t2_constraints = $t2->get_constraints;
is( scalar @t2_constraints, 4, '4 constraints on table' );
my $t2_c1 = shift @t2_constraints;
is( $t2_c1->type, PRIMARY_KEY, 'First constraint is PK' );
is( $t2_c1->name, 'pk_qtl_trait', 'Name is "pk_qtl_trait"' );
is( join(',', $t2_c1->fields), 'qtl_trait_id', 'Fields = "qtl_trait_id"' );
my $t2_c2 = shift @t2_constraints;
is( $t2_c2->type, UNIQUE, 'Second constraint is unique' );
is( $t2_c2->name, '', 'No name' );
is( join(',', $t2_c2->fields), 'trait_symbol', 'Fields = "trait_symbol"' );
my $t2_c3 = shift @t2_constraints;
is( $t2_c3->type, UNIQUE, 'Third constraint is unique' );
is( $t2_c3->name, '', 'No name' );
is( join(',', $t2_c3->fields), 'trait_name', 'Fields = "trait_name"' );
my $t2_c4 = shift @t2_constraints;
is( $t2_c4->type, FOREIGN_KEY, 'Fourth constraint is FK' );
is( $t2_c4->name, '', 'No name' );
is( join(',', $t2_c4->fields), 'qtl_trait_category_id',
'Fields = "qtl_trait_category_id"' );
is( $t2_c4->reference_table, 'qtl_trait_category',
'Reference table = "qtl_trait_category"' );
is( join(',', $t2_c4->reference_fields), 'qtl_trait_category_id',
'Reference fields = "qtl_trait_category_id"' );
#
# qtl
#
my $t3 = shift @tables;
is( $t3->name, 'qtl', 'Table "qtl" exists' );
my @t3_fields = $t3->get_fields;
is( scalar @t3_fields, 8, '8 fields in table' );
my @t3_constraints = $t3->get_constraints;
is( scalar @t3_constraints, 4, '4 constraints on table' );
my $t3_c4 = $t3_constraints[3];
is( $t3_c4->type, UNIQUE, 'Fourth constraint is unique' );
is( $t3_c4->name, 'qtl_accession_upper', 'Name = "qtl_accession_upper"' );
is( join(',', $t3_c4->fields), 'UPPER(qtl_accession_id)', 'Fields = "UPPER(qtl_accession_id)"' );
is( $t3->comments, 'qtl table comment', 'Comment "qtl table comment" exists' );
my $t3_f1 = shift @t3_fields;
is( $t3_f1->comments, 'qtl_id comment', 'Comment "qtl_id comment" exists' );
my $t3_f2 = shift @t3_fields;
is( $t3_f2->comments, 'accession comment',
'Comment "accession comment" exists' );
my @t3_indices = $t3->get_indices;
is( scalar @t3_indices, 1, '1 index on table' );
my $t3_i1 = shift @t3_indices;
is( $t3_i1->type, 'NORMAL', 'First index is normal' );
is( $t3_i1->name, 'qtl_index', 'Name is "qtl_index"' );
is( join(',', $t3_i1->fields), 'qtl_accession_id', 'Fields = "qtl_accession_id"' );
#
# qtl_trait_synonym
#
my $t4 = shift @tables;
is( $t4->name, 'qtl_trait_synonym', 'Table "qtl_trait_synonym" exists' );
my @t4_fields = $t4->get_fields;
is( scalar @t4_fields, 3, '3 fields in table' );
my @t4_constraints = $t4->get_constraints;
is( scalar @t4_constraints, 3, '3 constraints on table' );
my $t4_c3 = $t4_constraints[2];
is( $t4_c3->type, FOREIGN_KEY, 'Third constraint is FK' );
is( $t4_c3->name, '', 'No name' );
is( join(',', $t4_c3->fields), 'qtl_trait_id',
'Fields = "qtl_trait_id"' );
is( $t4_c3->reference_table, 'qtl_trait',
'Reference table = "qtl_trait"' );
is( join(',', $t4_c3->reference_fields), 'qtl_trait_id',
'Reference fields = "qtl_trait_id"' );
is( $t4_c3->on_delete, 'SET NULL',
'on_delete = "SET NULL"' );
my @views = $schema->get_views;
is( scalar @views, 1, 'Right number of views (1)' );
my $view1 = shift @views;
is( $view1->name, 'VS_ASSET', 'Found "VS_ASSET" view' );
like($view1->sql, qr/VS_ASSET/, "Detected view VS_ASSET");
unlike($view1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG");
my @procs = $schema->get_procedures;
is( scalar @procs, 1, 'Right number of procedures (1)' );
my $proc1 = shift @procs;
is( $proc1->name, 'P_24_HOUR_EVENT_SUMMARY', 'Found "P_24_HOUR_EVENT_SUMMARY" procedure' );
like($proc1->sql, qr/P_24_HOUR_EVENT_SUMMARY/, "Detected procedure P_24_HOUR_EVENT_SUMMARY");
unlike($proc1->sql, qr/CMDOMAIN_MIG/, "Did not detect CMDOMAIN_MIG");
SQL-Translator-0.11024/t/70sqlt-diff_script_old.t 0000644 0001750 0001750 00000007247 12411012516 020700 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use Test::More;
use IPC::Open3;
use Test::SQL::Translator qw(maybe_plan);
use Text::ParseWords qw(shellwords);
my @script = qw(script sqlt-diff-old);
my @create1 = qw(data sqlite create.sql);
my @create2 = qw(data sqlite create2.sql);
my $sqlt_diff = catfile($Bin, updir, @script);
my $create1 = catfile($Bin, @create1);
my $create2 = catfile($Bin, @create2);
BEGIN {
maybe_plan(21,
'SQL::Translator::Parser::SQLite',
'SQL::Translator::Parser::MySQL',
'SQL::Translator::Parser::Oracle',
);
}
ok(-e $sqlt_diff, 'Found sqlt-diff script');
my $out = _run_cmd ($sqlt_diff, "$create1=SQLite", "$create2=SQLite");
like($out, qr/-- Target database SQLite is untested/, "Detected 'untested' comment");
like($out, qr/ALTER TABLE person CHANGE iq/, "Detected altered 'iq' field");
like($out, qr/ALTER TABLE person ADD is_rock_star/,
"Detected missing rock star field");
$out = _run_cmd ($sqlt_diff, "$create1=SQLite", "$create1=SQLite");
like($out, qr/There were no differences/, "Properly detected no differences");
my @mysql_create1 = qw(data mysql create.sql);
my @mysql_create2 = qw(data mysql create2.sql);
my $mysql_create1 = (-d "t")
? catfile($Bin, @mysql_create1)
: catfile($Bin, "t", @mysql_create1);
my $mysql_create2 = (-d "t")
? catfile($Bin, @mysql_create2)
: catfile($Bin, "t", @mysql_create2);
# Test for differences
$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
unlike($out, qr/-- Target database MySQL is untested/, "Did not detect 'untested' comment");
like($out, qr/ALTER TABLE person CHANGE person_id/, "Detected altered 'person_id' field");
like($out, qr/ALTER TABLE person CHANGE iq/, "Detected altered 'iq' field");
like($out, qr/ALTER TABLE person CHANGE name/, "Detected altered 'name' field");
like($out, qr/ALTER TABLE person CHANGE age/, "Detected altered 'age' field");
like($out, qr/ALTER TABLE person ADD is_rock_star/,
"Detected missing rock star field");
like($out, qr/ALTER TABLE person ADD UNIQUE UC_person_id/,
"Detected missing unique constraint");
like($out, qr/CREATE UNIQUE INDEX unique_name/,
"Detected unique index with different name");
like($out, qr/ALTER TABLE person ENGINE=InnoDB;/,
"Detected altered table option");
like($out, qr/ALTER TABLE employee DROP FOREIGN KEY FK5302D47D93FE702E/,
"Detected drop foreign key");
like($out, qr/ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff/,
"Detected add constraint");
unlike($out, qr/ALTER TABLE employee ADD PRIMARY KEY/, "Primary key looks different when it shouldn't");
# Test for sameness
$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
like($out, qr/There were no differences/, "Properly detected no differences");
my @oracle_create1 = qw(data oracle create.sql);
my @oracle_create2 = qw(data oracle create2.sql);
my $oracle_create1 = (-d "t")
? catfile($Bin, @oracle_create1)
: catfile($Bin, "t", @oracle_create1);
my $oracle_create2 = (-d "t")
? catfile($Bin, @oracle_create2)
: catfile($Bin, "t", @oracle_create2);
$out = _run_cmd ($sqlt_diff, "$oracle_create1=Oracle", "$oracle_create2=Oracle");
unlike($out, qr/-- Target database Oracle is untested/, "Did not detect 'untested' comment");
like($out, qr/ALTER TABLE TABLE1 DROP FOREIGN KEY/,
"Detected drop foreign key");
like($out, qr/ALTER TABLE TABLE1 ADD CONSTRAINT/,
"Detected add constraint");
sub _run_cmd {
my $out;
my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}||''), @_ );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
$res;
}
SQL-Translator-0.11024/t/33tt-table-producer.t 0000644 0001750 0001750 00000004461 12163313615 020124 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
use vars '%opt';
BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
use constant DEBUG => (exists $opt{d} ? 1 : 0);
use FindBin qw/$Bin/;
use File::Temp qw/tempdir/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(8, 'Template 2.20', 'Test::Differences')
}
use Test::Differences;
use SQL::Translator;
use SQL::Translator::Producer::TT::Table;
# Setup a tmp directory we can output files to.
my $tdir = tempdir( CLEANUP => 1 );
# Parse the test XML schema
my $obj;
$obj = SQL::Translator->new(
debug => DEBUG, #$opt{d},
show_warnings => 1,
add_drop_table => 1,
from => "SQLite",
filename => "$Bin/data/sqlite/create.sql",
to => "TT-Table",
producer_args => {
tt_table => "$Bin/data/template/table.tt",
mk_files => 1,
mk_files_base => "$tdir",
mk_file_ext => "txt",
on_exists => "replace",
},
);
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
ok $out ne "" ,"Produced something!";
warn $obj->error unless $out;
# Normal output looks ok
local $/ = undef; # slurp
eq_or_diff
$out,
do { local (@ARGV, $/) = "$Bin/data/template/testresult_table.txt"; <> },
"Output looks right"
;
# File output
my @files = glob("$tdir/*.txt");
ok( @files == 2, "Wrote 2 files." );
is( $files[0], "$tdir/person.txt" , "Wrote person.txt" );
is( $files[1], "$tdir/pet.txt" , "Wrote pet.txt" );
open(FILE, "$tdir/person.txt") || die "Couldn't open $tdir/person.txt : $!";
eq_or_diff , qq{Table: person
Primary Key: person_id
Foreign Keys:\x20
Data Fields: name, age, weight, iq, description
}
, "person.txt looks right";
close(FILE);
open(FILE, "$tdir/pet.txt") || die "Couldn't open $tdir/pet.txt : $!";
eq_or_diff , qq{Table: pet
Primary Key: pet_id, person_id
Foreign Keys:\x20
Data Fields: name, age
}
, "pet.txt looks right";
close(FILE);
print $out if DEBUG;
#print "Debug:", Dumper($obj) if DEBUG;
SQL-Translator-0.11024/t/27sqlite-parser.t 0000644 0001750 0001750 00000005400 12163313615 017357 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use FindBin qw/$Bin/;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(25,
'SQL::Translator::Parser::SQLite');
}
SQL::Translator::Parser::SQLite->import('parse');
my $file = "$Bin/data/sqlite/create.sql";
{
local $/;
open my $fh, "<$file" or die "Can't read file '$file': $!\n";
my $data = <$fh>;
my $t = SQL::Translator->new;
parse($t, $data);
my $schema = $t->schema;
my @tables = $schema->get_tables;
is( scalar @tables, 2, 'Parsed two tables' );
my $t1 = shift @tables;
is( $t1->name, 'person', "'Person' table" );
my @fields = $t1->get_fields;
is( scalar @fields, 6, 'Six fields in "person" table');
my $fld1 = shift @fields;
is( $fld1->name, 'person_id', 'First field is "person_id"');
is( $fld1->is_auto_increment, 1, 'Is an autoincrement field');
my $t2 = shift @tables;
is( $t2->name, 'pet', "'Pet' table" );
my @constraints = $t2->get_constraints;
is( scalar @constraints, 3, '3 constraints on pet' );
my $c1 = pop @constraints;
is( $c1->type, 'FOREIGN KEY', 'FK constraint' );
is( $c1->reference_table, 'person', 'References person table' );
is( join(',', $c1->reference_fields), 'person_id',
'References person_id field' );
my @views = $schema->get_views;
is( scalar @views, 1, 'Parsed one views' );
my @triggers = $schema->get_triggers;
is( scalar @triggers, 1, 'Parsed one triggers' );
}
$file = "$Bin/data/sqlite/named.sql";
{
local $/;
open my $fh, "<$file" or die "Can't read file '$file': $!\n";
my $data = <$fh>;
my $t = SQL::Translator->new;
parse($t, $data);
my $schema = $t->schema;
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Parsed one table' );
my $t1 = shift @tables;
is( $t1->name, 'pet', "'Pet' table" );
my @constraints = $t1->get_constraints;
is( scalar @constraints, 5, '5 constraints on pet' );
my $c1 = $constraints[2];
is( $c1->type, 'FOREIGN KEY', 'FK constraint' );
is( $c1->reference_table, 'person', 'References person table' );
is( $c1->name, 'fk_person_id', 'Constraint name fk_person_id' );
is( $c1->on_delete, 'RESTRICT', 'On delete restrict' );
is( $c1->on_update, 'CASCADE', 'On update cascade' );
is( join(',', $c1->reference_fields), 'person_id',
'References person_id field' );
my $c2 = $constraints[3];
is( $c2->on_delete, 'SET DEFAULT', 'On delete set default' );
is( $c2->on_update, 'SET NULL', 'On update set null' );
my $c3 = $constraints[4];
is( $c3->on_update, 'NO ACTION', 'On update no action' );
is( $c3->on_delete, '', 'On delete not defined' );
}
SQL-Translator-0.11024/t/07p_args.t 0000644 0001750 0001750 00000003756 12163313615 016051 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
#
use strict;
use SQL::Translator;
use Test::More tests => 9;
sub silly_parser {
my ($tr, $data) = @_;
my $pargs = $tr->parser_args;
my @fields = split /$pargs->{'delimiter'}/, $data;
my $schema = $tr->schema;
my $table = $schema->add_table( name => 'foo') or die $schema->error;
for my $value ( @fields ) {
my $field = $table->add_field( name => $value ) or die $table->error;
}
return 1;
}
# The "data" to be parsed
my $data = q(Id|Name|Phone Number|Favorite Flavor|);
my $tr = SQL::Translator->new;
# Pass parser_args as an explicit method call
$tr->parser(\&silly_parser);
$tr->parser_args(delimiter => '\|');
my $pargs = $tr->parser_args;
$tr->translate(\$data);
my $schema = $tr->schema;
is($pargs->{'delimiter'}, '\|', "parser_args works when called directly");
my @tables = $schema->get_tables;
is(scalar @tables, 1, "right number of tables");
my $table = shift @tables;
my @fields = $table->get_fields;
is(scalar @fields, 4, "right number of fields");
#
# Blow away the existing schema object.
#
$tr->reset;
# Now, pass parser_args indirectly...
$tr->parser(\&silly_parser, { delimiter => "\t" });
$data =~ s/\|/\t/g;
$pargs = $tr->parser_args;
$tr->translate(\$data);
is($pargs->{'delimiter'}, "\t",
"parser_args works when called indirectly");
@tables = $schema->get_tables;
is(scalar @tables, 1, "right number of tables");
$table = shift @tables;
@fields = $table->get_fields;
is(scalar @fields, 4, "right number of fields");
undef $tr;
$tr = SQL::Translator->new(parser => \&silly_parser,
parser_args => { delimiter => ":" });
$data =~ s/\t/:/g;
$pargs = $tr->parser_args;
$tr->translate(\$data);
is($pargs->{'delimiter'}, ":",
"parser_args works when called as constructor arg");
@tables = $schema->get_tables;
is(scalar @tables, 1, "right number of tables");
$table = shift @tables;
@fields = $table->get_fields;
is(scalar @fields, 4, "right number of fields with new delimiter");
SQL-Translator-0.11024/t/40oracle-parser-dbi.t 0000644 0001750 0001750 00000000317 12163313615 020054 0 ustar ilmari ilmari use strict;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(1,
'SQL::Translator::Parser::DBI::Oracle',
);
}
use_ok('SQL::Translator::Parser::DBI::Oracle');
1;
SQL-Translator-0.11024/t/34tt-base.t 0000644 0001750 0001750 00000002433 12163313615 016124 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(4, 'Template 2.20',
'Test::Differences',
'SQL::Translator::Parser::XML::SQLFairy')
}
use Test::Differences;
use SQL::Translator;
use FindBin qw/$Bin/;
# Access to test libs. We want Producer/BaseTest.pm from here.
use lib ("$Bin/lib");
# Parse the test XML schema
my $obj;
$obj = SQL::Translator->new(
debug => 0,
show_warnings => 0,
add_drop_table => 1,
from => "XML-SQLFairy",
filename => "$Bin/data/xml/schema.xml",
to => "Producer::BaseTest::produce",
);
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
is $obj->error, '' ,"No errors";
ok $out ne "" ,"Produced something!";
local $/ = undef; # slurp
eq_or_diff $out, ,"Output looks right";
__DATA__
Hello World
Tables: Basic, Another
Basic
------
Fields: id title description email explicitnulldef explicitemptystring emptytagdef another_id timest
Another
------
Fields: id num
SQL-Translator-0.11024/t/38-filter-names.t 0000644 0001750 0001750 00000004024 12163313615 017232 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
BEGIN {
maybe_plan(4, 'YAML', 'Test::Differences')
}
use Test::Differences;
use SQL::Translator;
my $in_yaml = qq{---
schema:
tables:
Person:
name: Person
fields:
first_name:
data_type: foovar
name: first_name
};
my $ans_yaml = qq{---
schema:
procedures: {}
tables:
person:
constraints: []
fields:
First_name:
data_type: foovar
default_value: ~
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: First_name
order: 1
size:
- 0
indices: []
name: person
options: []
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: ~
no_comments: 0
parser_args: {}
parser_type: SQL::Translator::Parser::YAML
producer_args: {}
producer_type: SQL::Translator::Producer::YAML
show_warnings: 1
trace: 0
version: SUPPRESSED
};
# Parse the test schema
my $obj;
$obj = SQL::Translator->new(
debug => 0,
show_warnings => 1,
from => "YAML",
to => "YAML",
data => $in_yaml,
filters => [
# Filter from SQL::Translator::Filter::*
[ 'Names', {
tables => 'lc',
fields => 'ucfirst',
} ],
],
) or die "Failed to create translator object: ".SQL::Translator->error;
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
is $obj->error, '' ,"No errors";
ok $out ne "" ,"Produced something!";
# Somewhat hackishly modify the yaml with a regex to avoid
# failing randomly on every change of version.
$out =~ s/version: .*/version: SUPPRESSED/;
eq_or_diff $out, $ans_yaml ,"Output looks right";
SQL-Translator-0.11024/t/50-sqlserver-parser.t 0000644 0001750 0001750 00000007635 12163313615 020171 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl ts=4 et:
#
# Copied from 19sybase-parser.t with some additions
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(46, 'SQL::Translator::Parser::SQLServer');
SQL::Translator::Parser::SQLServer->import('parse');
}
my $file = "$Bin/data/sqlserver/create.sql";
ok( -e $file, "File exists" );
my $data;
{
local $/;
open my $fh, "<$file" or die "Can't read file '$file': $!\n";
$data = <$fh>;
close $fh;
}
ok( $data, 'Data' );
my $t = SQL::Translator->new;
my $val = parse($t, $data);
is( $val, 1, 'Parse' );
my $schema = $t->schema;
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema' );
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 8, 'Eight tables' );
{
my $t = $schema->get_table( 'jdbc_function_escapes' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'jdbc_function_escapes', "Name = 'jdbc_function_escapes'" );
my @fields = $t->get_fields;
is( scalar @fields, 2, 'Two fields' );
is( $fields[0]->name, 'escape_name', "First field name is 'escape_name'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 40, "First field size is '40'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
is( $fields[1]->name, 'map_string', "Second field name is 'map_string'" );
is( $fields[1]->data_type, 'varchar', "Second field is 'varchar'" );
is( $fields[1]->size, 40, "Second field size is '40'" );
is( $fields[1]->is_nullable, 0, "Second field cannot be null" );
}
{
my $t = $schema->get_table( 'spt_jtext' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'spt_jtext', "Name = 'spt_jtext'" );
my @fields = $t->get_fields;
is( scalar @fields, 2, 'Two fields' );
is( $fields[0]->name, 'mdinfo', "First field name is 'mdinfo'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 30, "First field size is '30'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
is( $fields[1]->name, 'value', "Second field name is 'value'" );
is( $fields[1]->data_type, 'text', "Second field is 'text'" );
is( $fields[1]->size, 0, "Second field size is '0'" );
is( $fields[1]->is_nullable, 0, "Second field cannot be null" );
my @constraints = $t->get_constraints;
is( scalar @constraints, 1, 'One constraint' );
is( $constraints[0]->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $constraints[0]->fields), 'mdinfo', 'On "mdinfo"' );
}
{
my $t = $schema->get_table( 'spt_mda' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'spt_mda', "Name = 'spt_mda'" );
my @fields = $t->get_fields;
is( scalar @fields, 7, 'Seven fields' );
is( $fields[0]->name, 'mdinfo', "First field name is 'mdinfo'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 30, "First field size is '30'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
my @constraints = $t->get_constraints;
is( scalar @constraints, 1, 'One constraint' );
is( $constraints[0]->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $constraints[0]->fields),
'mdinfo,mdaver_end,srvver_end', 'On "mdinfo,mdaver_end,srvver_end"' );
}
# New testing for views and procedures
my @views = $schema->get_views;
is( scalar @views, 1, 'One view' );
like($views[0]->sql, qr/vs_xdp_data/, "Detected view vs_xdp_data");
my @procedures = $schema->get_procedures;
is( scalar @procedures, 10, 'Ten procedures' );
like($procedures[8]->sql, qr/Tx_B_Get_Vlan/, "Detected procedure Tx_B_Get_Vlan");
like($procedures[9]->sql, qr/\[dbo\].inet_ntoa/, "Detected function [dbo].inet_ntoa");
SQL-Translator-0.11024/t/25storable.t 0000644 0001750 0001750 00000000175 12163313615 016401 0 ustar ilmari ilmari use Test::More tests => 2;
use_ok('SQL::Translator::Parser::Storable');
use_ok('SQL::Translator::Producer::Storable');
1;
SQL-Translator-0.11024/t/32schema-lookups.t 0000644 0001750 0001750 00000005747 12163313615 017530 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#
# Run script with -d for debug.
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
#use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema;
use SQL::Translator::Schema::Constants;
# Simple options. -d for debug
my %opt;
BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
use constant DEBUG => (exists $opt{d} ? 1 : 0);
# Setup a (somewaht contrived!) test schema
#=============================================================================
my $schema = SQL::Translator::Schema->new( name => "Lookup-tests" );
my $tbl_order = $schema->add_table( name => "Order" );
# Fields
$tbl_order->add_field(
name => "order_id",
data_type => "INT",
size => "10",
is_primary_key => 1,
);
$tbl_order->add_field(
name => "customer_id",
data_type => "INT",
size => "10",
);
$tbl_order->add_field(
name => "invoice_number",
data_type => "VARCHAR",
size => "20",
);
$tbl_order->add_field(
name => "notes",
data_type => "TEXT",
);
# Constraints
$tbl_order->add_constraint(
name => "con_pkey",
type => PRIMARY_KEY,
fields => "order_id",
);
$tbl_order->add_constraint(
name => "con_customer_fkey",
type => FOREIGN_KEY,
fields => "customer_id",
reference_table => "Customer",
reference_fields => "customer_id",
);
$tbl_order->add_constraint(
name => "con_unique_invoice",
type => UNIQUE,
fields => "invoice_number",
);
print STDERR "Test Schema:",Dumper($schema) if DEBUG;
die "Test is schema is invalid! : ".$schema->err unless $schema->is_valid;
# Testing 1,2,3,..
#=============================================================================
plan( tests => 15 );
my (@flds,@cons);
@flds = $tbl_order->pkey_fields;
is( join(",",@flds), "order_id", "pkey_fields" );
isa_ok( $flds[0], "SQL::Translator::Schema::Field" );
@flds = $tbl_order->fkey_fields;
is( join(",",@flds), "customer_id", "fkey_fields" );
isa_ok( $flds[0], "SQL::Translator::Schema::Field" );
@flds = $tbl_order->nonpkey_fields;
is( join(",",@flds), "customer_id,invoice_number,notes", "nonpkey_fields" );
isa_ok( $flds[0], "SQL::Translator::Schema::Field" );
isa_ok( $flds[1], "SQL::Translator::Schema::Field" );
@flds = $tbl_order->data_fields;
is( join(",",@flds), "invoice_number,notes", "data_fields" );
isa_ok( $flds[0], "SQL::Translator::Schema::Field" );
@flds = $tbl_order->unique_fields;
is( join(",",@flds), "invoice_number", "unique_fields" );
isa_ok( $flds[0], "SQL::Translator::Schema::Field" );
@cons = $tbl_order->unique_constraints;
is( scalar @cons, 1, "Number of unique_constraints is 1" );
is( $cons[0]->name, "con_unique_invoice", "unique_constraints" );
@cons = $tbl_order->fkey_constraints;
is( scalar @cons, 1, "Number of fkey_constraints is 1" );
is( $cons[0]->name, "con_customer_fkey", "fkey_constraints" );
SQL-Translator-0.11024/t/51-xml-to-oracle_quoted.t 0000644 0001750 0001750 00000010573 12163313615 020711 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Test::Differences;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::Oracle');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
quote_table_names => 1,
quote_field_names => 1,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my @sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'Oracle',
filename => $xmlfile,
) or die $sqlt->error;
my $sql_string = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'Oracle',
filename => $xmlfile,
) or die $sqlt->error;
my $want = [
'DROP TABLE "Basic" CASCADE CONSTRAINTS',
'DROP SEQUENCE "sq_Basic_id"',
'CREATE SEQUENCE "sq_Basic_id"',
'CREATE TABLE "Basic" (
"id" number(10) NOT NULL,
"title" varchar2(100) DEFAULT \'hello\' NOT NULL,
"description" clob DEFAULT \'\',
"email" varchar2(500),
"explicitnulldef" varchar2(4000),
"explicitemptystring" varchar2(4000) DEFAULT \'\',
"emptytagdef" varchar2(4000) DEFAULT \'\',
"another_id" number(10) DEFAULT \'2\',
"timest" date,
PRIMARY KEY ("id"),
CONSTRAINT "u_Basic_emailuniqueindex" UNIQUE ("email"),
CONSTRAINT "u_Basic_very_long_index_name_o" UNIQUE ("title")
)',
'DROP TABLE "Another" CASCADE CONSTRAINTS',
'DROP SEQUENCE "sq_Another_id"',
'CREATE SEQUENCE "sq_Another_id"',
'CREATE TABLE "Another" (
"id" number(10) NOT NULL,
"num" number(10,2),
PRIMARY KEY ("id")
)',
'DROP VIEW "email_list"',
'CREATE VIEW "email_list" AS
SELECT email FROM Basic WHERE (email IS NOT NULL)',
'ALTER TABLE "Basic" ADD CONSTRAINT "Basic_another_id_fk" FOREIGN KEY ("another_id") REFERENCES "Another" ("id")',
'CREATE OR REPLACE TRIGGER "ai_Basic_id"
BEFORE INSERT ON "Basic"
FOR EACH ROW WHEN (
new."id" IS NULL OR new."id" = 0
)
BEGIN
SELECT "sq_Basic_id".nextval
INTO :new."id"
FROM dual;
END;
',
'CREATE OR REPLACE TRIGGER "ts_Basic_timest"
BEFORE INSERT OR UPDATE ON "Basic"
FOR EACH ROW WHEN (new."timest" IS NULL)
BEGIN
SELECT sysdate INTO :new."timest" FROM dual;
END;
',
'CREATE OR REPLACE TRIGGER "ai_Another_id"
BEFORE INSERT ON "Another"
FOR EACH ROW WHEN (
new."id" IS NULL OR new."id" = 0
)
BEGIN
SELECT "sq_Another_id".nextval
INTO :new."id"
FROM dual;
END;
',
'CREATE INDEX "titleindex" on "Basic" ("title")'];
is_deeply(\@sql, $want, 'Got correct Oracle statements in list context');
eq_or_diff($sql_string, q|DROP TABLE "Basic" CASCADE CONSTRAINTS;
DROP SEQUENCE "sq_Basic_id01";
CREATE SEQUENCE "sq_Basic_id01";
CREATE TABLE "Basic" (
"id" number(10) NOT NULL,
"title" varchar2(100) DEFAULT 'hello' NOT NULL,
"description" clob DEFAULT '',
"email" varchar2(500),
"explicitnulldef" varchar2(4000),
"explicitemptystring" varchar2(4000) DEFAULT '',
"emptytagdef" varchar2(4000) DEFAULT '',
"another_id" number(10) DEFAULT '2',
"timest" date,
PRIMARY KEY ("id"),
CONSTRAINT "u_Basic_emailuniqueindex01" UNIQUE ("email"),
CONSTRAINT "u_Basic_very_long_index_name01" UNIQUE ("title")
);
DROP TABLE "Another" CASCADE CONSTRAINTS;
DROP SEQUENCE "sq_Another_id01";
CREATE SEQUENCE "sq_Another_id01";
CREATE TABLE "Another" (
"id" number(10) NOT NULL,
"num" number(10,2),
PRIMARY KEY ("id")
);
DROP VIEW "email_list";
CREATE VIEW "email_list" AS
SELECT email FROM Basic WHERE (email IS NOT NULL);
ALTER TABLE "Basic" ADD CONSTRAINT "Basic_another_id_fk01" FOREIGN KEY ("another_id") REFERENCES "Another" ("id");
CREATE INDEX "titleindex01" on "Basic" ("title");
CREATE OR REPLACE TRIGGER "ai_Basic_id01"
BEFORE INSERT ON "Basic"
FOR EACH ROW WHEN (
new."id" IS NULL OR new."id" = 0
)
BEGIN
SELECT "sq_Basic_id01".nextval
INTO :new."id"
FROM dual;
END;
/
CREATE OR REPLACE TRIGGER "ts_Basic_timest01"
BEFORE INSERT OR UPDATE ON "Basic"
FOR EACH ROW WHEN (new."timest" IS NULL)
BEGIN
SELECT sysdate INTO :new."timest" FROM dual;
END;
/
CREATE OR REPLACE TRIGGER "ai_Another_id01"
BEFORE INSERT ON "Another"
FOR EACH ROW WHEN (
new."id" IS NULL OR new."id" = 0
)
BEGIN
SELECT "sq_Another_id01".nextval
INTO :new."id"
FROM dual;
END;
/
|);
SQL-Translator-0.11024/t/39-filter-globals.t 0000644 0001750 0001750 00000010434 12163313615 017555 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(3, 'YAML', 'Test::Differences')
}
use Test::Differences;
use SQL::Translator;
# The _GLOBAL_ table should be removed and its fields copied onto all other
# tables.
#
# FIXME - the loader should not require order for globals, needs to be able
# to recognize/sort approproately
my $in_yaml = qq{---
schema:
tables:
_GLOBAL_:
order: 99
name: _GLOBAL_
fields:
modified:
name: modified
data_type: timestamp
indices:
- fields:
- modified
constraints:
- fields:
- modified
type: UNIQUE
Person:
order: 1
name: Person
fields:
first_name:
data_type: foovar
name: first_name
};
# Parse the test XML schema
my $obj;
$obj = SQL::Translator->new(
debug => 0,
show_warnings => 1,
from => "YAML",
to => "YAML",
data => $in_yaml,
filters => [
# Filter from SQL::Translator::Filter::*
[ 'Globals',
# A global field to add given in the args
fields => [
{
name => 'created',
data_type => 'timestamp',
is_nullable => 0,
}
],
indices => [
{
fields => 'created',
}
],
],
],
) or die "Failed to create translator object: ".SQL::Translator->error;
my $struct;
lives_ok { $struct = YAML::Load($obj->translate) } "Translate/yaml reload ran";
is $obj->error, '', "No errors";
# Should include the the items added from the Global table defined above in the
# schema as well as those defined in the filter args below.
is_deeply ($struct, {
schema => {
procedures => {},
tables => {
Person => {
constraints => [
{
deferrable => 1,
expression => "",
fields => [
"modified"
],
match_type => "",
name => "",
on_delete => "",
on_update => "",
options => [],
reference_fields => [],
reference_table => "",
type => "UNIQUE"
}
],
fields => {
first_name => {
data_type => "foovar",
default_value => undef,
is_nullable => 1,
is_primary_key => 0,
is_unique => 0,
name => "first_name",
order => 1,
size => [
0
]
},
created => {
data_type => "timestamp",
default_value => undef,
is_nullable => 0,
is_primary_key => 0,
is_unique => 0,
name => "created",
order => 2,
size => [
0
]
},
modified => {
data_type => "timestamp",
default_value => undef,
is_nullable => 1,
is_primary_key => 0,
is_unique => 1,
name => "modified",
order => 3,
size => [
0
]
}
},
indices => [
{
fields => [
"created"
],
name => "",
options => [],
type => "NORMAL"
},
{
fields => [
"modified"
],
name => "",
options => [],
type => "NORMAL"
}
],
name => "Person",
options => [],
order => 1
}
},
triggers => {},
views => {}
},
translator => {
add_drop_table => 0,
filename => undef,
no_comments => 0,
parser_args => {},
parser_type => "SQL::Translator::Parser::YAML",
producer_args => {},
producer_type => "SQL::Translator::Producer::YAML",
show_warnings => 1,
trace => 0,
version => $SQL::Translator::VERSION,
}
}, 'Expected final yaml-schema');
SQL-Translator-0.11024/t/53-oracle-delay-constraints_quoted.t 0000644 0001750 0001750 00000001470 12163313615 023132 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::Oracle');
}
my $yamlfile = "$Bin/data/oracle/schema_with_options.yaml";
my $sqlt;
$sqlt = SQL::Translator->new(
show_warnings => 0,
add_drop_table => 0,
producer_args => { 'delay_constraints' => 1 },
quote_table_names => 1,
quote_field_names => 1,
);
my $sql_string = $sqlt->translate(
from => 'YAML',
to => 'Oracle',
filename => $yamlfile,
);
ok($sql_string, 'Translation successfull');
ok($sql_string =~ /ADD CONSTRAINT "pk_d_operator" PRIMARY KEY/, 'constraints delayed');
SQL-Translator-0.11024/t/70sqlt-diff_script.t 0000644 0001750 0001750 00000005007 12411012516 020032 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use IPC::Open3;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use Text::ParseWords qw(shellwords);
my @script = qw(script sqlt-diff);
my @create1 = qw(data sqlite create.sql);
my @create2 = qw(data sqlite create2.sql);
my $sqlt_diff = catfile($Bin, updir, @script);
my $create1 = catfile($Bin, @create1);
my $create2 = catfile($Bin, @create2);
BEGIN {
maybe_plan(16,
'SQL::Translator::Parser::MySQL',
);
}
my @mysql_create1 = qw(data mysql create.sql);
my @mysql_create2 = qw(data mysql create2.sql);
my $mysql_create1 = (-d "t")
? catfile($Bin, @mysql_create1)
: catfile($Bin, "t", @mysql_create1);
my $mysql_create2 = (-d "t")
? catfile($Bin, @mysql_create2)
: catfile($Bin, "t", @mysql_create2);
# Test for differences
my $out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
like($out, qr/CHANGE COLUMN person_id/, "Detected altered 'person_id' field");
like($out, qr/CHANGE COLUMN iq/, "Detected altered 'iq' field");
like($out, qr/CHANGE COLUMN name/, "Detected altered 'name' field");
like($out, qr/CHANGE COLUMN age/, "Detected altered 'age' field");
like($out, qr/ADD COLUMN is_rock_star/,
"Detected missing rock star field");
like($out, qr/ADD UNIQUE UC_person_id/,
"Detected missing unique constraint");
like($out, qr/ADD UNIQUE INDEX unique_name/,
"Detected unique index with different name");
like($out, qr/DROP FOREIGN KEY FK5302D47D93FE702E/,
"Detected drop foreign key");
like($out, qr/ADD CONSTRAINT FK5302D47D93FE702E_diff/,
"Detected add constraint");
unlike($out, qr/ADD PRIMARY KEY/, "Primary key looks different when it shouldn't");
# Test for quoted output
$out = _run_cmd ($sqlt_diff, '--quote=`', "$mysql_create1=MySQL", "$mysql_create2=MySQL");
like($out, qr/ALTER TABLE `person`/, "Quoted table name");
like($out, qr/CHANGE COLUMN `person_id`/, "Quoted 'person_id' field");
like($out, qr/CHANGE COLUMN `iq`/, "Quoted 'iq' field");
like($out, qr/CHANGE COLUMN `name`/, "Quoted 'name' field");
like($out, qr/CHANGE COLUMN `age`/, "Quoted 'age' field");
# Test for sameness
$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
like($out, qr/No differences found/, "Properly detected no differences");
sub _run_cmd {
my $out;
my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}||''), @_ );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
$res;
}
SQL-Translator-0.11024/t/16xml-parser.t 0000644 0001750 0001750 00000017662 13070420670 016667 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#
# Run script with -d for debug.
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
# Simple options. -d for debug
my %opt;
BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
use constant DEBUG => (exists $opt{d} ? 1 : 0);
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(undef, 'SQL::Translator::Parser::XML::SQLFairy');
}
my $testschema = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
debug => DEBUG,
show_warnings => 1,
add_drop_table => 1,
);
die "Can't find test schema $testschema" unless -e $testschema;
my $sql;
{
my @w;
local $SIG{__WARN__} = sub { push @w, $_[0] if $_[0] =~ /The database_event tag is deprecated - please use database_events/ };
$sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'MySQL',
filename => $testschema,
) or die $sqlt->error;
print $sql if DEBUG;
ok (@w, 'database_event deprecation warning issued');
}
# Test the schema objs generted from the XML
#
my $scma = $sqlt->schema;
# Hmmm, when using schema_ok the field test data gets a bit too nested and
# fiddly to work with. (See 28xml-xmi-parser-sqlfairy.t for more a split out
# version)
schema_ok( $scma, {
tables => [
{
name => "Basic",
options => [ { ENGINE => 'InnoDB' } ],
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
fields => [
{
name => "id",
data_type => "int",
default_value => undef,
is_nullable => 0,
size => 10,
is_primary_key => 1,
is_auto_increment => 1,
extra => { ZEROFILL => 1 },
},
{
name => "title",
data_type => "varchar",
is_nullable => 0,
default_value => "hello",
size => 100,
is_unique => 1,
},
{
name => "description",
data_type => "text",
is_nullable => 1,
default_value => "",
},
{
name => "email",
data_type => "varchar",
size => 500,
is_unique => 1,
default_value => undef,
is_nullable => 1,
extra => {
foo => "bar",
hello => "world",
bar => "baz",
}
},
{
name => "explicitnulldef",
data_type => "varchar",
default_value => undef,
is_nullable => 1,
size => 255,
},
{
name => "explicitemptystring",
data_type => "varchar",
default_value => "",
is_nullable => 1,
size => 255,
},
{
name => "emptytagdef",
data_type => "varchar",
default_value => "",
is_nullable => 1,
comments => "Hello emptytagdef",
size => 255,
},
{
name => "another_id",
data_type => "int",
size => "10",
default_value => 2,
is_nullable => 1,
is_foreign_key => 1,
},
{
name => "timest",
data_type => "timestamp",
size => "0",
is_nullable => 1,
},
],
constraints => [
{
type => PRIMARY_KEY,
fields => ["id"],
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
},
{
name => 'emailuniqueindex',
type => UNIQUE,
fields => ["email"],
},
{
name => 'very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms',
type => UNIQUE,
fields => ["title"],
},
{
type => FOREIGN_KEY,
fields => ["another_id"],
reference_table => "Another",
reference_fields => ["id"],
name => 'Basic_fk'
},
],
indices => [
{
name => "titleindex",
fields => ["title"],
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
},
],
}, # end table Basic
{
name => "Another",
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
options => [ { ENGINE => 'InnoDB' } ],
fields => [
{
name => "id",
data_type => "int",
default_value => undef,
is_nullable => 0,
size => 10,
is_primary_key => 1,
is_auto_increment => 1,
},
{
name => "num",
data_type => "numeric",
default_value => undef,
size => '10,2',
},
],
}, # end table Another
], # end tables
views => [
{
name => 'email_list',
sql => "SELECT email FROM Basic WHERE (email IS NOT NULL)",
fields => ['email'],
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
},
],
triggers => [
{
name => 'foo_trigger',
perform_action_when => 'after',
database_events => 'insert',
on_table => 'Basic',
action => 'update modified=timestamp();',
scope => 'row',
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
},
{
name => 'bar_trigger',
perform_action_when => 'before',
database_events => 'insert,update',
on_table => 'Basic',
action => 'update modified2=timestamp();',
scope => 'row',
extra => {
hello => "aliens",
},
},
],
procedures => [
{
name => 'foo_proc',
sql => 'select foo from bar',
parameters => ['foo', 'bar'],
owner => 'Nomar',
comments => 'Go Sox!',
extra => {
foo => "bar",
hello => "world",
bar => "baz",
},
},
],
}); # end schema
done_testing;
SQL-Translator-0.11024/t/04file,fh,string.t 0000644 0001750 0001750 00000002232 12163313615 017373 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
# This tests that the same file can be passed in using a filename,
# a filehandle, and a string, and return identical results. There's
# a lot of setup here, because we have to emulate the various ways
# that $tr->translate might be called: with a string (filename),
# with a filehandle (IO::File, FileHandle, or \*FOO), and with a
# scalar reference (data in a string).
#
use strict;
use IO::File;
use SQL::Translator;
use Test::More tests => 3;
# The filename, holder for all the data, and the filehandle
my $datafile = "t/data/mysql/Apache-Session-MySQL.sql";
my $data;
my $fh = IO::File->new($datafile);
my ($v1, $v2);
{
my $tr = SQL::Translator->new;
# Pass filename: simplest way
$tr->translate($datafile);
$v1 = $tr->schema;
}
{
my $tr = SQL::Translator->new;
# Pass string reference
read($fh, $data, -s $datafile);
$tr->translate(\$data);
$v2 = $tr->schema;
}
# XXX- Hack to remove Graph hack!
$_->translator (undef) for ($v1, $v2);
ok(length $v1, "passing string (filename) works");
ok(length $v2, "passing string as SCALAR reference");
is_deeply($v1, $v2, "from file == from string");
SQL-Translator-0.11024/t/62roundtrip_datacheck.t 0000644 0001750 0001750 00000002037 12163313615 020603 0 ustar ilmari ilmari use warnings;
use strict;
use Test::SQL::Translator;
use Test::Differences;
use FindBin qw/$Bin/;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML',
'SQL::Translator::Producer::XML');
}
# It's very hard to read and modify YAML by hand. Thus we
# use an XML file for definitions, and generate a YAML from
# it in Makefile.PL, so we do not saddle the user with XML
# dependencies for testing. This test makes sure they do
# not drift apart.
use SQL::Translator;
my $base_xml_fn = "$Bin/data/roundtrip.xml";
my $autogen_yaml_fn = "$Bin/data/roundtrip_autogen.yaml";
my $orig_xml = _parse_to_xml ($base_xml_fn, 'XML');
my $new_xml = _parse_to_xml ($autogen_yaml_fn, 'YAML');
eq_or_diff ("$new_xml", "$orig_xml", 'YAML test schema matches original XML schema');
sub _parse_to_xml {
my ($fn, $type) = @_;
my $tr = SQL::Translator->new;
$tr->no_comments (1); # this will drop the XML header
my $xml = $tr->translate (
parser => $type,
file => $fn,
producer => 'XML',
) or die $tr->error;
return $xml;
}
SQL-Translator-0.11024/t/64xml-to-mysql.t 0000644 0001750 0001750 00000005123 12163313615 017152 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Test::Differences;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::MySQL');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
show_warnings => 0,
add_drop_table => 1,
producer_args => {
mysql_version => 5.005,
},
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my @want = (
q[SET foreign_key_checks=0],
q[DROP TABLE IF EXISTS `Basic`],
q[CREATE TABLE `Basic` (
`id` integer(10) zerofill NOT NULL auto_increment,
`title` varchar(100) NOT NULL DEFAULT 'hello',
`description` text NULL DEFAULT '',
`email` varchar(500) NULL,
`explicitnulldef` varchar(255) NULL,
`explicitemptystring` varchar(255) NULL DEFAULT '',
`emptytagdef` varchar(255) NULL DEFAULT '' comment 'Hello emptytagdef',
`another_id` integer(10) NULL DEFAULT 2,
`timest` timestamp NULL,
INDEX `titleindex` (`title`),
INDEX (`another_id`),
PRIMARY KEY (`id`),
UNIQUE `emailuniqueindex` (`email`),
UNIQUE `very_long_index_name_on_title_field_which_should_be_tru_14b59999` (`title`),
CONSTRAINT `Basic_fk` FOREIGN KEY (`another_id`) REFERENCES `Another` (`id`)
) ENGINE=InnoDB],
q[DROP TABLE IF EXISTS `Another`],
q[CREATE TABLE `Another` (
`id` integer(10) NOT NULL auto_increment,
`num` numeric(10, 2) NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB],
q[CREATE OR REPLACE
VIEW `email_list` ( `email` ) AS
SELECT email FROM Basic WHERE (email IS NOT NULL)
],
q[DROP TRIGGER IF EXISTS `foo_trigger`],
q[CREATE TRIGGER `foo_trigger` after insert ON `Basic`
FOR EACH ROW BEGIN update modified=timestamp(); END],
q[DROP TRIGGER IF EXISTS `bar_trigger_insert`],
q[CREATE TRIGGER `bar_trigger_insert` before insert ON `Basic`
FOR EACH ROW BEGIN update modified2=timestamp(); END],
q[DROP TRIGGER IF EXISTS `bar_trigger_update`],
q[CREATE TRIGGER `bar_trigger_update` before update ON `Basic`
FOR EACH ROW BEGIN update modified2=timestamp(); END],
q[SET foreign_key_checks=1],
);
my $sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'MySQL',
filename => $xmlfile,
) or die $sqlt->error;
eq_or_diff($sql, join("", map { "$_;\n\n" } @want));
my @sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'MySQL',
filename => $xmlfile,
) or die $sqlt->error;
is_deeply(\@sql, \@want);
SQL-Translator-0.11024/t/66-postgres-dbi-parser.t 0000644 0001750 0001750 00000014164 12453027474 020556 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan table_ok);
maybe_plan(undef, 'SQL::Translator::Parser::DBI::PostgreSQL');
my @dsn =
$ENV{DBICTEST_PG_DSN} ? @ENV{ map { "DBICTEST_PG_$_" } qw/DSN USER PASS/ }
: $ENV{DBI_DSN} ? @ENV{ map { "DBI_$_" } qw/DSN USER PASS/ }
: plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test';
my $dbh = eval {
DBI->connect(@dsn, {AutoCommit => 1, RaiseError=>1,PrintError => 1} );
};
if (my $err = ($@ || $DBI::err )) {
chomp $err;
plan skip_all => "No connection to test db. DBI says '$err'";
}
ok($dbh, "dbh setup correctly");
$dbh->do('SET client_min_messages=WARNING');
my $sql = q[
drop table if exists sqlt_test2;
drop table if exists sqlt_test1;
drop table if exists sqlt_products_1;
create table sqlt_test1 (
f_serial serial NOT NULL primary key,
f_varchar character varying(255),
f_text text default 'FOO',
f_to_drop integer,
f_last text
);
comment on table sqlt_test1 is 'this is a comment on the first table';
comment on column sqlt_test1.f_text is 'this is a comment on a field of the first table';
create index sqlt_test1_f_last_idx on sqlt_test1 (f_last);
create table sqlt_test2 (
f_id integer NOT NULL,
f_int smallint,
f_fk1 integer NOT NULL references sqlt_test1 (f_serial),
primary key (f_id, f_fk1)
);
CREATE TABLE sqlt_products_1 (
product_no integer,
name text,
price numeric
);
-- drop a column, to not have a linear id
-- When the table t_test1 is created, f_last get id 5 but
-- after this drop, there is only 4 columns.
alter table sqlt_test1 drop column f_to_drop;
];
$| = 1;
$dbh->begin_work;
$dbh->do($sql);
my $t = SQL::Translator->new(
trace => 0,
parser => 'DBI',
parser_args => { dbh => $dbh },
);
$t->translate;
my $schema = $t->schema;
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema object' );
ok ($dbh->ping, 'External handle still connected');
my @tables = $schema->get_tables;
my $t1 = $schema->get_table("sqlt_test1");
is( $t1->name, 'sqlt_test1', 'Table sqlt_test1 exists' );
is( $t1->comments, 'this is a comment on the first table', 'First table has a comment');
my @t1_fields = $t1->get_fields;
is( scalar @t1_fields, 4, '4 fields in sqlt_test1' );
my $f1 = shift @t1_fields;
is( $f1->name, 'f_serial', 'First field is "f_serial"' );
is( $f1->data_type, 'integer', 'Field is an integer' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, "nextval('sqlt_test1_f_serial_seq'::regclass)", 'Default value is nextval()' );
is( $f1->is_primary_key, 1, 'Field is PK' );
#FIXME: not set to auto-increment? maybe we can guess auto-increment behavior by looking at the default_value (i.e. it call function nextval() )
#is( $f1->is_auto_increment, 1, 'Field is auto increment' );
my $f2 = shift @t1_fields;
is( $f2->name, 'f_varchar', 'Second field is "f_varchar"' );
is( $f2->data_type, 'character varying(255)', 'Field is a character varying(255)' );
is( $f2->is_nullable, 1, 'Field can be null' );
#FIXME: should not be 255?
is( $f2->size, 259, 'Size is "259"' );
is( $f2->default_value, undef, 'Default value is undefined' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
is( $f2->is_auto_increment, 0, 'Field is not auto increment' );
is( $f2->comments, '', 'There is no comment on the second field');
my $f3 = shift @t1_fields;
is( $f3->name, 'f_text', 'Third field is "f_text"' );
is( $f3->data_type, 'text', 'Field is a text' );
is( $f3->is_nullable, 1, 'Field can be null' );
is( $f3->size, 0, 'Size is 0' );
is( $f3->default_value, "'FOO'::text", 'Default value is "FOO"' );
is( $f3->is_primary_key, 0, 'Field is not PK' );
is( $f3->is_auto_increment, 0, 'Field is not auto increment' );
is( $f3->comments, 'this is a comment on a field of the first table', 'There is a comment on the third field');
my $f4 = shift @t1_fields;
is( $f4->name, 'f_last', 'Fouth field is "f_last"' );
is( $f4->data_type, 'text', 'Field is a text' );
is( $f4->is_nullable, 1, 'Field can be null' );
is( $f4->size, 0, 'Size is 0' );
is( $f4->default_value, undef, 'No default value' );
is( $f4->is_primary_key, 0, 'Field is not PK' );
is( $f4->is_auto_increment, 0, 'Field is not auto increment' );
#TODO: no 'NOT NULL' constraint not set
my $t2 = $schema->get_table("sqlt_test2");
is( $t2->name, 'sqlt_test2', 'Table sqlt_test2 exists' );
is( $t2->comments, undef, 'No comment on table sqlt_test2');
my @t2_fields = $t2->get_fields;
is( scalar @t2_fields, 3, '3 fields in sqlt_test2' );
my $t2_f1 = shift @t2_fields;
is( $t2_f1->name, 'f_id', 'First field is "f_id"' );
is( $t2_f1->data_type, 'integer', 'Field is an integer' );
is( $t2_f1->is_nullable, 0, 'Field cannot be null' );
is( $t2_f1->size, 0, 'Size is "0"' );
is( $t2_f1->default_value, undef, 'Default value is undefined' );
is( $t2_f1->is_primary_key, 1, 'Field is PK' );
my $t2_f2= shift @t2_fields;
is( $t2_f2->name, 'f_int', 'Third field is "f_int"' );
is( $t2_f2->data_type, 'smallint', 'Field is an smallint' );
is( $t2_f2->is_nullable, 1, 'Field can be null' );
is( $t2_f2->size, 0, 'Size is "0"' );
is( $t2_f2->default_value, undef, 'Default value is undefined' );
is( $t2_f2->is_primary_key, 0, 'Field is not PK' );
my $t2_f3 = shift @t2_fields;
is( $t2_f3->name, 'f_fk1', 'Third field is "f_fk1"' );
is( $t2_f3->data_type, 'integer', 'Field is an integer' );
is( $t2_f3->is_nullable, 0, 'Field cannot be null' );
is( $t2_f3->size, 0, 'Size is "0"' );
is( $t2_f3->default_value, undef, 'Default value is undefined' );
is( $t2_f3->is_primary_key, 1, 'Field is PK' );
is( $t2_f3->is_foreign_key, 1, 'Field is a FK' );
my $fk_ref1 = $t2_f3->foreign_key_reference;
isa_ok( $fk_ref1, 'SQL::Translator::Schema::Constraint', 'FK' );
is( $fk_ref1->reference_table, 'sqlt_test1', 'FK is to "sqlt_test1" table' );
my @t2_constraints = $t2->get_constraints;
is( scalar @t2_constraints, 1, "One constraint on table" );
my $t2_c1 = shift @t2_constraints;
is( $t2_c1->type, FOREIGN_KEY, "Constraint is a FK" );
$dbh->rollback;
$dbh->disconnect;
done_testing();
SQL-Translator-0.11024/t/26sybase.t 0000644 0001750 0001750 00000000454 12163313615 016055 0 ustar ilmari ilmari use strict;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(3,
'SQL::Translator::Parser::DBI::Sybase',
);
}
use_ok('SQL::Translator::Parser::DBI::Sybase');
use_ok('SQL::Translator::Parser::Storable');
use_ok('SQL::Translator::Producer::Storable');
1;
SQL-Translator-0.11024/t/43xml-to-db2.t 0000644 0001750 0001750 00000003653 12163313615 016457 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Differences;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::DB2');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my $sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'DB2',
filename => $xmlfile,
) or die $sqlt->error;
eq_or_diff($sql, << "SQL");
DROP TABLE Basic;
CREATE TABLE Basic (
id INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1) NOT NULL,
title VARCHAR(100) NOT NULL DEFAULT 'hello',
description VARCHAR(0) DEFAULT '',
email VARCHAR(500),
explicitnulldef VARCHAR(0),
explicitemptystring VARCHAR(0) DEFAULT '',
emptytagdef VARCHAR(0) DEFAULT '',
another_id INTEGER DEFAULT 2,
timest TIMESTAMP,
PRIMARY KEY (id),
CONSTRAINT emailuniqueindex UNIQUE (email),
CONSTRAINT very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms UNIQUE (title)
);
DROP TABLE Another;
CREATE TABLE Another (
id INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1) NOT NULL,
num NUMERIC(10,2),
PRIMARY KEY (id)
);
ALTER TABLE Basic ADD FOREIGN KEY (another_id) REFERENCES Another(id);
CREATE INDEX titleindex ON Basic ( title );
CREATE VIEW email_list AS
SELECT email FROM Basic WHERE (email IS NOT NULL);
CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();
CREATE TRIGGER bar_trigger before insert, update ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified2=timestamp();
SQL
SQL-Translator-0.11024/t/54-oracle-alter-field.t 0000644 0001750 0001750 00000002315 12163313615 020276 0 ustar ilmari ilmari #!/usr/bin/perl
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Diff;
BEGIN {
maybe_plan(3, 'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::Oracle');
}
my $schema1 = $Bin.'/data/oracle/schema_diff_a.yaml';
my $schema2 = $Bin.'/data/oracle/schema_diff_b.yaml';
open my $io1, '<', $schema1 or die $!;
open my $io2, '<', $schema2 or die $!;
my ($yaml1, $yaml2);
{
local $/ = undef;
$yaml1 = <$io1>;
$yaml2 = <$io2>;
};
close $io1;
close $io2;
my $s = SQL::Translator->new(from => 'YAML');
$s->parser->($s,$yaml1);
my $t = SQL::Translator->new(from => 'YAML');
$t->parser->($t,$yaml2);
my $d = SQL::Translator::Diff->new
({
output_db => 'Oracle',
target_db => 'Oracle',
source_schema => $s->schema,
target_schema => $t->schema,
});
my $diff = $d->compute_differences->produce_diff_sql || die $d->error;
ok($diff, 'Diff generated.');
like($diff, '/ALTER TABLE d_operator MODIFY \( name nvarchar2\(10\) \)/',
'Alter table generated.');
like($diff, '/ALTER TABLE d_operator MODIFY \( other nvarchar2\(10\) NOT NULL \)/',
'Alter table generated.');
SQL-Translator-0.11024/t/30sqlt-new-diff-pgsql.t 0000644 0001750 0001750 00000007537 12612463104 020375 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use warnings;
use SQL::Translator;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use Test::More;
use Test::Differences;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator::Schema::Constants;
use Storable 'dclone';
plan tests => 4;
use_ok('SQL::Translator::Diff') or die "Cannot continue\n";
my $tr = SQL::Translator->new;
my ( $source_schema, $target_schema, $parsed_sql_schema ) = map {
my $t = SQL::Translator->new;
$t->parser( 'YAML' )
or die $tr->error;
my $out = $t->translate( catfile($Bin, qw/data diff pgsql/, $_ ) )
or die $tr->error;
my $schema = $t->schema;
unless ( $schema->name ) {
$schema->name( $_ );
}
($schema);
} (qw( create1.yml create2.yml ));
# Test for differences
my $out = SQL::Translator::Diff::schema_diff(
$source_schema,
'PostgreSQL',
$target_schema,
'PostgreSQL',
{
producer_args => {
quote_identifiers => 1,
}
}
);
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
CREATE TABLE "added" (
"id" bigint
);
ALTER TABLE "employee" DROP CONSTRAINT "FK5302D47D93FE702E";
ALTER TABLE "employee" DROP COLUMN "job_title";
ALTER TABLE "employee" ADD CONSTRAINT "FK5302D47D93FE702E_diff" FOREIGN KEY ("employee_id")
REFERENCES "person" ("person_id") DEFERRABLE;
ALTER TABLE "old_name" RENAME TO "new_name";
ALTER TABLE "new_name" ADD COLUMN "new_field" integer;
ALTER TABLE "person" DROP CONSTRAINT "UC_age_name";
DROP INDEX "u_name";
ALTER TABLE "person" ADD COLUMN "is_rock_star" smallint DEFAULT 1;
ALTER TABLE "person" ALTER COLUMN "person_id" TYPE serial;
ALTER TABLE "person" ALTER COLUMN "name" SET NOT NULL;
ALTER TABLE "person" ALTER COLUMN "age" SET DEFAULT 18;
ALTER TABLE "person" ALTER COLUMN "iq" TYPE bigint;
ALTER TABLE "person" ALTER COLUMN "nickname" SET NOT NULL;
ALTER TABLE "person" ALTER COLUMN "nickname" TYPE character varying(24);
ALTER TABLE "person" RENAME COLUMN "description" TO "physical_description";
ALTER TABLE "person" ADD CONSTRAINT "unique_name" UNIQUE ("name");
ALTER TABLE "person" ADD CONSTRAINT "UC_person_id" UNIQUE ("person_id");
ALTER TABLE "person" ADD CONSTRAINT "UC_age_name" UNIQUE ("age", "name");
DROP TABLE "deleted" CASCADE;
COMMIT;
## END OF DIFF
$out = SQL::Translator::Diff::schema_diff(
$source_schema, 'PostgreSQL', $target_schema, 'PostgreSQL',
{ ignore_index_names => 1,
ignore_constraint_names => 1,
producer_args => {
quote_identifiers => 0,
}
});
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
CREATE TABLE added (
id bigint
);
ALTER TABLE employee DROP COLUMN job_title;
ALTER TABLE old_name RENAME TO new_name;
ALTER TABLE new_name ADD COLUMN new_field integer;
ALTER TABLE person DROP CONSTRAINT UC_age_name;
ALTER TABLE person ADD COLUMN is_rock_star smallint DEFAULT 1;
ALTER TABLE person ALTER COLUMN person_id TYPE serial;
ALTER TABLE person ALTER COLUMN name SET NOT NULL;
ALTER TABLE person ALTER COLUMN age SET DEFAULT 18;
ALTER TABLE person ALTER COLUMN iq TYPE bigint;
ALTER TABLE person ALTER COLUMN nickname SET NOT NULL;
ALTER TABLE person ALTER COLUMN nickname TYPE character varying(24);
ALTER TABLE person RENAME COLUMN description TO physical_description;
ALTER TABLE person ADD CONSTRAINT UC_person_id UNIQUE (person_id);
ALTER TABLE person ADD CONSTRAINT UC_age_name UNIQUE (age, name);
DROP TABLE deleted CASCADE;
COMMIT;
## END OF DIFF
# Test for sameness
$out = SQL::Translator::Diff::schema_diff(
$source_schema, 'PostgreSQL', $source_schema, 'PostgreSQL'
);
eq_or_diff($out, <<'## END OF DIFF', "No differences found");
-- Convert schema 'create1.yml' to 'create1.yml':;
-- No differences found;
## END OF DIFF
SQL-Translator-0.11024/t/24yaml.t 0000644 0001750 0001750 00000012716 13154007117 015531 0 ustar ilmari ilmari use warnings;
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
use FindBin '$Bin';
BEGIN {
maybe_plan(2,
'SQL::Translator::Parser::SQLite',
'SQL::Translator::Producer::YAML');
}
my $sqlt_version = $SQL::Translator::VERSION;
use YAML qw(Load);
my $yaml = Load(<;
my $tr = SQL::Translator->new(
parser => 'SQLite',
producer => 'YAML',
data => $data,
);
my $out;
lives_ok { $out = Load($tr->translate) } 'Translate SQLite to YAML';
is_deeply( $out, $yaml, 'YAML matches expected' );
SQL-Translator-0.11024/t/data/ 0000755 0001750 0001750 00000000000 13225114407 015136 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/pgsql/ 0000755 0001750 0001750 00000000000 13225114407 016264 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/pgsql/Chado-CV-PostGreSQL.sql 0000644 0001750 0001750 00000007045 12163313615 022302 0 ustar ilmari ilmari -- The cvterm module design is based on the ontology
-- ================================================
-- TABLE: cv
-- ================================================
create table cv (
cv_id serial not null,
primary key (cv_id),
cvname varchar not null,
cvdefinition text,
unique(cvname)
);
-- ================================================
-- TABLE: cvterm
-- ================================================
create table cvterm (
cvterm_id serial not null,
primary key (cvterm_id),
cv_id int not null,
foreign key (cv_id) references cv (cv_id),
name varchar(255) not null,
termdefinition text,
-- the primary dbxref for this term. Other dbxrefs may be cvterm_dbxref
dbxref_id int,
foreign key (dbxref_id) references dbxref (dbxref_id),
unique(termname, cv_id)
-- The unique key on termname, termtype_id ensures that all terms are
-- unique within a given cv
);
create index cvterm_idx1 on cvterm (cv_id);
-- ================================================
-- TABLE: cvrelationship
-- ================================================
create table cvrelationship (
cvrelationship_id serial not null,
primary key (cvrelationship_id),
reltype_id int not null,
foreign key (reltype_id) references cvterm (cvterm_id),
subjterm_id int not null,
foreign key (subjterm_id) references cvterm (cvterm_id),
objterm_id int not null,
foreign key (objterm_id) references cvterm (cvterm_id),
unique(reltype_id, subjterm_id, objterm_id)
);
create index cvrelationship_idx1 on cvrelationship (reltype_id);
create index cvrelationship_idx2 on cvrelationship (subjterm_id);
create index cvrelationship_idx3 on cvrelationship (objterm_id);
-- ================================================
-- TABLE: cvpath
-- ================================================
create table cvpath (
cvpath_id serial not null,
primary key (cvpath_id),
reltype_id int,
foreign key (reltype_id) references cvterm (cvterm_id),
subjterm_id int not null,
foreign key (subjterm_id) references cvterm (cvterm_id),
objterm_id int not null,
foreign key (objterm_id) references cvterm (cvterm_id),
cv_id int not null,
foreign key (cv_id) references cv (cv_id),
pathdistance int,
unique (subjterm_id, objterm_id)
);
create index cvpath_idx1 on cvpath (reltype_id);
create index cvpath_idx2 on cvpath (subjterm_id);
create index cvpath_idx3 on cvpath (objterm_id);
create index cvpath_idx4 on cvpath (cv_id);
-- ================================================
-- TABLE: cvtermsynonym
-- ================================================
create table cvtermsynonym (
cvterm_id int not null,
foreign key (cvterm_id) references cvterm (cvterm_id),
termsynonym varchar(255) not null,
unique(cvterm_id, termsynonym)
);
create index cvterm_synonym_idx1 on cvterm_synonym (cvterm_id);
-- ================================================
-- TABLE: cvterm_dbxref
-- ================================================
create table cvterm_dbxref (
cvterm_dbxref_id serial not null,
primary key (cvterm_dbxref_id),
cvterm_id int not null,
foreign key (cvterm_id) references cvterm (cvterm_id),
dbxref_id int not null,
foreign key (dbxref_id) references dbxref (dbxref_id),
unique(cvterm_id, dbxref_id)
);
create index cvterm_dbxref_idx1 on cvterm_dbxref (cvterm_id);
create index cvterm_dbxref_idx2 on cvterm_dbxref (dbxref_id);
SQL-Translator-0.11024/t/data/pgsql/entire_syntax.sql 0000644 0001750 0001750 00000004632 12163313615 021710 0 ustar ilmari ilmari -- $Header: /home/faga/work/sqlfairy_svn/sqlfairy-cvsbackup/sqlfairy/t/data/pgsql/entire_syntax.sql,v 1.1 2003-08-17 00:42:57 rossta Exp $
-- done:
-- smallint int2 signed two-byte integer
-- integer int, int4 signed four-byte integer
-- bigint int8 signed eight-byte integer
-- serial serial4 autoincrementing four-byte integer
-- bigserial serial8 autoincrementing eight-byte integer
-- real float4 single precision floating-point number
-- double precision float8 double precision floating-point number
-- numeric [ (p, s) ] decimal [ (p, s) ] exact numeric with selectable precision
-- character(n) char(n) fixed-length character string
-- character varying(n) varchar(n) variable-length character string
-- date calendar date (year, month, day)
-- time [ (p) ] [ without time zone ] time of day
-- time [ (p) ] with time zone timetz time of day, including time zone
-- timestamp [ (p) ] without time zone timestamp date and time
-- timestamp [ (p) ] [ with time zone ] timestamptz date and time, including time zone
-- bytea binary data
-- text variable-length character string
-- to do:
-- bit fixed-length bit string
-- bit varying(n) varbit(n) variable-length bit string
-- boolean bool logical Boolean (true/false)
-- box rectangular box in 2D plane
-- cidr IP network address
-- circle circle in 2D plane
-- inet IP host address
-- interval(p) general-use time span
-- line infinite line in 2D plane (not implemented)
-- lseg line segment in 2D plane
-- macaddr MAC address
-- money currency amount
-- path open and closed geometric path in 2D plane
-- point geometric point in 2D plane
-- polygon closed geometric path in 2D plane
-- Compatibility: The following types (or spellings thereof) are specified by SQL:
-- bit, bit varying, boolean, char, character, character varying, varchar, date,
-- double precision, integer, interval, numeric, decimal, real, smallint, time,
-- timestamp (both with or without time zone).
CREATE TABLE t01 (
i01 SMALLINT,
i02 INT2,
i03 INT,
i04 INTEGER,
i05 INT4,
i06 BIGINT,
i07 INT8,
i08 SERIAL,
i09 SERIAL4,
i10 BIGSERIAL,
i11 SERIAL8,
r01 REAL,
r02 FLOAT4,
r03 DOUBLE PRECISION,
r04 FLOAT,
r05 FLOAT8,
n01 DECIMAL,
n02 NUMERIC,
c01 CHAR(10),
c02 VARCHAR(10),
c03 CHARACTER(10),
c04 CHARACTER VARYING(10),
d01 DATE,
d02 TIME,
d03 TIMETZ,
d04 TIMESTAMP,
d05 TIMESTAMPTZ,
b01 BYTEA,
t01 TEXT
);
SQL-Translator-0.11024/t/data/pgsql/turnkey.sql 0000644 0001750 0001750 00000011374 12163313615 020516 0 ustar ilmari ilmari -- standalone, data table
create table b (
b_id serial not null,
primary key (b_id),
name text
);
-- 1 single FK import, data table
create table a (
a_id serial not null,
primary key (a_id),
b_id int not null,
foreign key (b_id) references b (b_id),
name text
);
-- 2 single FK import, link table between 'a' and 'b'
-- note that 'a' both imports a FK from 'b', as well as links to 'b' via 'a_b'
create table a_b (
a_b_id serial not null,
primary key (a_b_id),
a_id int not null,
foreign key (a_id) references a (a_id),
b_id int not null,
foreign key (b_id) references b (b_id)
);
-- 1 single FK import, data table
create table c (
c_id serial not null,
primary key (c_id),
b_id int not null,
foreign key (b_id) references b (b_id),
name text
);
-- 1 single FK import, data table
create table d (
d_id serial not null,
primary key (d_id),
c_id int not null,
foreign key (c_id) references c (c_id),
name text
);
-- standalone, data table
create table e (
e_id serial not null,
primary key (e_id),
name text
);
-- 2 single FK import, link table between 'c' and 'e'
create table c_e (
c_e_id serial not null,
primary key (c_e_id),
c_id int not null,
foreign key (c_id) references c (c_id),
e_id int not null,
foreign key (e_id) references e (e_id)
);
-- 1 triple FK import, link table between 'e', 'e', and 'e'
create table f (
f_id serial not null,
primary key (f_id),
e1_id int not null,
foreign key (e1_id) references e (e_id),
e2_id int not null,
foreign key (e2_id) references e (e_id),
e3_id int not null,
foreign key (e3_id) references e (e_id)
);
-- 1 single FK import, 1 double FK import, link table between 'a', 'e', and 'e'
create table g (
g_id serial not null,
primary key (g_id),
a_id int not null,
foreign key (a_id) references a (a_id),
e1_id int not null,
foreign key (e1_id) references e (e_id),
e2_id int not null,
foreign key (e2_id) references e (e_id)
);
-- 1 double FK import, 1 triple FK import, link table between 'a', 'a', 'e', 'e', and 'e'
create table h (
h_id serial not null,
primary key (h_id),
a1_id int not null,
foreign key (a1_id) references a (a_id),
a2_id int not null,
foreign key (a2_id) references a (a_id),
e1_id int not null,
foreign key (e1_id) references e (e_id),
e2_id int not null,
foreign key (e2_id) references e (e_id),
e3_id int not null,
foreign key (e3_id) references e (e_id)
);
-- 3 single FK import, link table between 'b', 'c', and 'd'
create table i (
i_id serial not null,
primary key (i_id),
b_id int not null,
foreign key (b_id) references b (b_id),
c_id int not null,
foreign key (c_id) references c (c_id),
d_id int not null,
foreign key (d_id) references d (d_id)
);
insert into b (name) values ('balloon');
insert into b (name) values ('bangup');
insert into b (name) values ('beluga');
insert into b (name) values ('blanch');
insert into b (name) values ('botch');
insert into b (name) values ('brooch');
insert into b (name) values ('broccoli');
insert into b (name) values ('blitz');
insert into b (name) values ('blintz');
insert into a (name,b_id) values ('alkane',1);
insert into a (name,b_id) values ('alkyne',2);
insert into a (name,b_id) values ('amygdala',3);
insert into a (name,b_id) values ('aorta',4);
insert into a_b (a_id,b_id) values (1,5);
insert into c (name,b_id) values ('cairn',6);
insert into c (name,b_id) values ('cootie',7);
insert into c (name,b_id) values ('cochlea',8);
insert into d (name,c_id) values ('drake',1);
insert into e (name) values ('ear');
insert into e (name) values ('element');
insert into e (name) values ('embryo');
insert into e (name) values ('encumber');
insert into e (name) values ('enhance');
insert into e (name) values ('ependyma');
insert into e (name) values ('epididymis');
insert into e (name) values ('ergot');
insert into e (name) values ('esophagus');
insert into c_e (c_id,e_id) values (2,1);
insert into f (e1_id,e2_id,e3_id) values (2,3,4);
insert into g (a_id,e1_id,e2_id) values (2,5,6);
insert into h (a1_id,a2_id,e1_id,e2_id,e3_id) values (3,4,7,8,9);
insert into i (b_id,c_id,d_id) values (9,3,1);
SQL-Translator-0.11024/t/data/xml/ 0000755 0001750 0001750 00000000000 13225114407 015736 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/xml/samefield.xml 0000644 0001750 0001750 00000001533 12163313615 020415 0 ustar ilmari ilmari
SQL-Translator-0.11024/t/data/xml/schema.xml 0000644 0001750 0001750 00000010624 13070420670 017723 0 ustar ilmari ilmari
SELECT email FROM Basic WHERE (email IS NOT NULL)
update modified=timestamp();
update modified2=timestamp();
select foo from bar
Go Sox!
SQL-Translator-0.11024/t/data/roundtrip_autogen.yaml 0000644 0001750 0001750 00000016750 13225114154 021602 0 ustar ilmari ilmari ---
schema:
procedures:
foo_proc:
comments: Go Sox!
extra:
bar: baz
foo: bar
hello: world
name: foo_proc
order: 1
owner: Nomar
parameters:
- foo
- bar
sql: select foo from bar
tables:
' table with spaces ':
constraints: []
fields:
' field with spaces ':
data_type: text
default_value: ' value with spaces '
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: ' field with spaces '
order: 1
size:
- 0
indices: []
name: ' table with spaces '
options: []
order: 4
Another:
constraints:
- deferrable: 1
expression: ''
fields:
- id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
extra:
bar: baz
foo: bar
hello: world
mysql_table_type: InnoDB
fields:
id:
data_type: int
default_value: ~
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id
order: 1
size:
- 10
indices: []
name: Another
options: []
order: 2
Basic:
constraints:
- deferrable: 1
expression: ''
extra:
bar: baz
foo: bar
hello: world
fields:
- id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
- deferrable: 1
expression: ''
fields:
- email
match_type: ''
name: emailuniqueindex
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
- deferrable: 1
expression: ''
fields:
- another_id
match_type: ''
name: Basic
on_delete: ''
on_update: ''
options: []
reference_fields:
- id
reference_table: Another
type: FOREIGN KEY
extra:
bar: baz
foo: bar
hello: world
mysql_table_type: InnoDB
fields:
another_id:
data_type: int
default_value: 2
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: another_id
order: 8
size:
- 10
decimal:
data_type: decimal
default_value: ~
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: decimal
order: 11
size:
- 10
- 2
description:
data_type: text
default_value: ''
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: description
order: 3
size:
- 0
email:
data_type: varchar
default_value: ~
extra:
bar: baz
foo: bar
hello: world
is_nullable: 1
is_primary_key: 0
is_unique: 1
name: email
order: 4
size:
- 500
emptytagdef:
comments:
- Hello 'emptytagdef'
data_type: varchar
default_value: backslash \ single-quote '
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: emptytagdef
order: 7
size:
- 0
explicitemptystring:
data_type: varchar
default_value: ''
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: explicitemptystring
order: 6
size:
- 0
explicitnulldef:
data_type: varchar
default_value: ~
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: explicitnulldef
order: 5
size:
- 0
id:
data_type: int
default_value: ~
extra:
ZEROFILL: 1
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id
order: 1
size:
- 10
numeric:
data_type: numeric
default_value: 42.69
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: numeric
order: 10
size:
- 9
- 1
timest:
data_type: timestamp
default_value: ~
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: timest
order: 9
size:
- 0
title:
data_type: varchar
default_value: hello
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: title
order: 2
size:
- 100
indices:
- extra:
bar: baz
foo: bar
hello: world
fields:
- title
name: titleindex
options: []
type: NORMAL
name: Basic
options: []
order: 1
'`table` [with] "quotes"':
constraints:
- deferrable: 1
expression: ''
fields:
- '`field` [with] "quotes"'
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
'`field` [with] "quotes"':
data_type: int
default_value: ~
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: '`field` [with] "quotes"'
order: 1
size:
- 10
indices: []
name: '`table` [with] "quotes"'
options: []
order: 3
triggers:
'`trigger` [with] "quotes"':
action: select timestamp();
database_events:
- insert
fields: ~
name: '`trigger` [with] "quotes"'
on_table: '`table` [with] "quotes"'
order: 3
perform_action_when: before
bar_trigger:
action: update modified2=timestamp();
database_events:
- insert
- update
extra:
hello: aliens
fields: ~
name: bar_trigger
on_table: Basic
order: 2
perform_action_when: before
foo_trigger:
action: update modified=timestamp();
database_events:
- insert
extra:
bar: baz
foo: bar
hello: world
fields: ~
name: foo_trigger
on_table: Basic
order: 1
perform_action_when: after
views:
email_list:
extra:
bar: baz
foo: bar
hello: world
fields:
- email
name: email_list
order: 1
sql: SELECT email FROM Basic WHERE (email IS NOT NULL)
translator:
add_drop_table: 0
filename: t/data/roundtrip.xml
no_comments: 0
parser_args: {}
parser_type: SQL::Translator::Parser::XML
producer_args: {}
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
version: 0.11024
SQL-Translator-0.11024/t/data/Excel/ 0000755 0001750 0001750 00000000000 13225114407 016176 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/Excel/t.xls 0000644 0001750 0001750 00000020000 12163313615 017163 0 ustar ilmari ilmari ÐÏࡱá > þÿ þÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿ
þÿÿÿþÿÿÿ
þÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ R ÿÿÿÿÿÿÿÿ À F €†«7²£Ã À W o r k b o o k ÿÿÿÿÿÿÿÿ Z S u m m a r y I n f o r m a t i o n ( ÿÿÿÿ Ø D o c u m e n t S u m m a r y I n f o r m a t i o n 8 ÿÿÿÿÿÿÿÿÿÿÿÿ %Ì á °Á â \ p Ken Clark B °a = œ ¯ ¼ = P àBH&8 X@ " · Ú 1 ´ Helv1 È Helv1 ´ Helv1 ´ Helv "$"#,##0_);\("$"#,##0\) ! "$"#,##0_);[Red]\("$"#,##0\) " "$"#,##0.00_);\("$"#,##0.00\) ' " "$"#,##0.00_);[Red]\("$"#,##0.00\) 7 * 2 _("$"* #,##0_);_("$"* \(#,##0\);_("$"* "-"_);_(@_) . ) ) _(* #,##0_);_(* \(#,##0\);_(* "-"_);_(@_) ? , : _("$"* #,##0.00_);_("$"* \(#,##0.00\);_("$"* "-"??_);_(@_) 6 + 1 _(* #,##0.00_);_(* \(#,##0.00\);_(* "-"??_);_(@_) ¤
yyyy/mm/ddà õÿ À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à õÿ ô À à À à + õÿ ø À à ) õÿ ø À à , õÿ ø À à * õÿ ø À à õÿ ø À à Ð ¿ ¿ ˆ à Ø ¿ ¿ ˆ à ¤ Ô ¿ ¿ ˆ “ €ÿ“ ÿ“ ÿ“ ÿ“ ÿ“ €ÿ’ â 8 ÿÿÿ ÿ ÿ ÿ ÿÿ ÿ ÿ ÿÿ € € € €€ € € €€ ÀÀÀ €€€ ™™ÿ ™3f ÿÿÌ Ìÿÿ f f ÿ€€ fÌ ÌÌÿ € ÿ ÿ ÿÿ ÿÿ € € € €€ ÿ Ìÿ Ìÿÿ ÌÿÌ ÿÿ™ ™Ìÿ ÿ™Ì Ì™ÿ ÿÌ™ 3fÿ 3ÌÌ ™Ì ÿÌ ÿ™ ÿf ff™ ––– 3f 3™f 3 33 ™3 ™3f 33™ ÇÇÇ \ ÿÿÿ ` … U Sheet1… ü
Sheet2… + Sheet3Œ ® Á Á ai ü t ID text number math bitmap today$ silly field (with random characters) sdfgdfg I like cakeÿ
× ¿ÿ5 j HÚ°H–Ü¿ÿœH ¿ÿš ) ÆoÀŽ¬a¿ÿœ IE Æqä¿ÿL¿ÿš°Cà !:Ä :P¿ÿšà $ ýø¿ÿœ !QÜ¿ÿšðÊ€Cà R¿ÿšð 3PX x¿ÿœ¸ ¡µ\ x xÊ€"Hü¿ÿ›0 8 H e l¿ÿœ t i ÆrX¿ÿ›PÊ€ 8 ÿÿÿ ¡µ\"3¿ÿ› x"4 £ÔŒNPè"5Ð °¿ÿ› H—„ H¹ÄDñ°¿ÿ›À ¿ÿ›Ð£¨è HË£Ò˜ ¿ÿœ 8 ÆÏØO8¿ÿœ $¿ÿ ¿ÿ ¿ÿ #¿ÿ !H—„¿ÿ " ¿ÿ Dñ° £À x £Ò˜ £`¿ÿŸ ¿ÿœ@¿ÿ ÆoÀ£—Ê ÊDñ°H¹ÄIGnIG^HÕt‘¥H¿ÿœ€ ‘¥x¿ÿœ¿ÿ # !ThH—„¿ÿ "Cà ¿ÿ Dñ° £À £Ò˜ ¡\ HÚ°H–Ü£³°HÚ°¿ÿž Cà 3{Ü %<Dñ°¿ÿœè¿ÿ Ø¿ÿ ’ ¡\ 3{lD"€¿ÿœCà HÚ°¿ÿ #¿ÿ !H—„¿ÿ " ¿ÿ Dñ° £À x £Ò˜ £`¿ÿ€£³°HÚ° ¿ÿÀ:¿ÿ $ I'ÔI'Ø ¿ÿ ¿ÿÐ ,ÿ˜ ¿ÿž ?ä4ÄŒ Aðoà÷ý?à ÿø ‚ @ÐI3 H–Ü¿ÿ ¿ÿžP£À 3„Hx £Ò˜ Á ¿ÿ ¿ÿžPCà ,ÿ˜H—„¿ÿ " ¿ÿ Dñ°¿ÿž£À x¿ÿž£Ò˜Á
%Ì ½
d ü©ñÒMbP?_ * + ‚ € % Ü Á ƒ „ ¡ " Ü à? à? U
} 3
} ™ } ™
} Ì } ™ } 3 } }
ÿ ( @l ÿ ( @´ ÿ @O ÿ @O ÿ @Oý
ý
ý
ý
ý
ý
ý
~
ÎÂ ý
½ ž@ ~
zM ý
× P b N > ¶ @
%Ì ¸ ô
d ü©ñÒMbP?_ * + ‚ € % Ü Á ƒ „ ¡ " Ü à? à? U
}
ÿ ( @l × > ¶ @
%Ì ç #
d ü©ñÒMbP?_ * + ‚ € % Ü Á ƒ „ ¡ " Ü à? à? U
}
ÿ ( @l × > ¶ @
þÿÿÿ þÿÿÿ
þÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿþÿ
à…ŸòùOh«‘ +'³Ù0 ¨ @ H \ p ˆ
” ' Boston.com
Ken Clark Microsoft Excel @ €Ë†•ýÂ@ )XH ý þÿ
ÕÍÕœ.“— +,ù®0 ì P X x € ˆ ˜
É ' New York Times Digital s $
Sheet1 Sheet2 Sheet3 Worksheets þÿ ÿÿÿÿ À F Microsoft Excel Worksheet þÿÿÿ8FIB Excel.Sheet.8 C o m p O b j ÿÿÿÿÿÿÿÿÿÿÿÿ X ÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿ ÿÿÿÿÿÿÿÿÿÿÿÿ SQL-Translator-0.11024/t/data/template/ 0000755 0001750 0001750 00000000000 13225114407 016751 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/template/testresult_basic.txt 0000644 0001750 0001750 00000015210 12163313615 023072 0 ustar ilmari ilmari Schema:
Database:
Foo: bar
Hello: world
Table: Basic
==========================================================================
Fields
id
data_type: int
size: 10
is_nullable: 0
default_value:
is_primary_key: 1
is_unique: 0
is_auto_increment: 1
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 1
table: Basic
title
data_type: varchar
size: 100
is_nullable: 0
default_value: hello
is_primary_key: 0
is_unique: 1
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 2
table: Basic
description
data_type: text
size: 0
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 3
table: Basic
email
data_type: varchar
size: 500
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 1
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 4
table: Basic
explicitnulldef
data_type: varchar
size: 0
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 5
table: Basic
explicitemptystring
data_type: varchar
size: 0
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 6
table: Basic
emptytagdef
data_type: varchar
size: 0
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 7
table: Basic
another_id
data_type: int
size: 10
is_nullable: 1
default_value: 2
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 1
foreign_key_reference: Another
is_valid: 1
order: 8
table: Basic
timest
data_type: timestamp
size: 0
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 9
table: Basic
Indices
titleindex
table: Basic
fields: title
type: NORMAL
options:
is_valid: 1
Constraints
?
type: PRIMARY KEY
fields: id
expression:
match_type:
reference_fields:
reference_table:
deferrable: 1
on_delete:
on_update:
options:
is_valid: 1
emailuniqueindex
type: UNIQUE
fields: email
expression:
match_type:
reference_fields:
reference_table:
deferrable: 1
on_delete:
on_update:
options:
is_valid: 1
very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms
type: UNIQUE
fields: title
expression:
match_type:
reference_fields:
reference_table:
deferrable: 1
on_delete:
on_update:
options:
is_valid: 1
?
type: FOREIGN KEY
fields: another_id
expression:
match_type:
reference_fields: id
reference_table: Another
deferrable: 1
on_delete:
on_update:
options:
is_valid: 1
Table: Another
==========================================================================
Fields
id
data_type: int
size: 10
is_nullable: 0
default_value:
is_primary_key: 1
is_unique: 0
is_auto_increment: 1
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 1
table: Another
num
data_type: numeric
size: 10,2
is_nullable: 1
default_value:
is_primary_key: 0
is_unique: 0
is_auto_increment: 0
is_foreign_key: 0
foreign_key_reference:
is_valid: 1
order: 2
table: Another
Indices
Constraints
?
type: PRIMARY KEY
fields: id
expression:
match_type:
reference_fields:
reference_table:
deferrable: 1
on_delete:
on_update:
options:
is_valid: 1
SQL-Translator-0.11024/t/data/template/testresult_table.txt 0000644 0001750 0001750 00000000306 12163313615 023100 0 ustar ilmari ilmari Table: person
Primary Key: person_id
Foreign Keys:
Data Fields: name, age, weight, iq, description
Table: pet
Primary Key: pet_id, person_id
Foreign Keys:
Data Fields: name, age
SQL-Translator-0.11024/t/data/template/table.tt 0000644 0001750 0001750 00000000254 12163313615 020414 0 ustar ilmari ilmari Table: [% table %]
Primary Key: [% table.pkey_fields.join(", ") %]
Foreign Keys: [% table.key_fields.join(", ") %]
Data Fields: [% table.data_fields.join(", ") %]
SQL-Translator-0.11024/t/data/template/basic.tt 0000644 0001750 0001750 00000003752 12163313615 020414 0 ustar ilmari ilmari Schema: [% schema.name %]
Database: [% schema.database %]
Foo: [% foo %]
Hello: [% hello %]
[%- FOREACH table = schema.get_tables %]
Table: [% table %]
==========================================================================
Fields
[%- FOREACH field = table.get_fields %]
[% field %]
data_type: [% field.data_type %]
size: [% field.size.join(',') %]
is_nullable: [% field.is_nullable %]
default_value: [% field.default_value %]
is_primary_key: [% field.is_primary_key %]
is_unique: [% field.is_unique %]
is_auto_increment: [% field.is_auto_increment %]
is_foreign_key: [% field.is_foreign_key %]
foreign_key_reference: [% field.foreign_key_reference.reference_table %]
is_valid: [% field.is_valid %]
order: [% field.order %]
table: [% field.table %]
[% END %]
Indices
[%- FOREACH index = table.get_indices %]
[% index.name %]
table: [% index.table %]
fields: [% index.fields.join(', ') %]
type: [% index.type %]
options: [% index.options %]
is_valid: [% index.is_valid %]
[% END %]
Constraints
[%- FOREACH constraint = table.get_constraints %]
[% constraint.name OR "?" %]
type: [% constraint.type %]
fields: [% constraint.fields.join(', ') %]
expression: [% constraint.expression %]
match_type: [% constraint.match_type %]
reference_fields: [% constraint.reference_fields.join(', ') %]
reference_table: [% constraint.reference_table.join(', ') %]
deferrable: [% constraint.deferrable %]
on_delete: [% constraint.on_delete %]
on_update: [% constraint.on_update %]
options: [% constraint.options %]
is_valid: [% constraint.is_valid %]
[% END -%]
[% END %]
SQL-Translator-0.11024/t/data/sybase/ 0000755 0001750 0001750 00000000000 13225114407 016424 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/sybase/create.sql 0000644 0001750 0001750 00000153753 12163313615 020430 0 ustar ilmari ilmari /* Script generated by dbschema.pl(2.4.2) on Mon Aug 18 14:15:25 2003. */
/* Script extracted on a solaris system. */
use master
go
/* Groups... */
/* No groups found. */
/* Users... */
exec sp_adduser 'guest', 'guest'
exec sp_adduser 'probe', 'probe'
go
/* Aliases... */
/* No aliases found. */
/* Add user-defined data types: */
/* No user defined types found. */
/* Rules... */
/* No rules found. */
/* Defaults... */
/* No defaults found. */
/* Bind rules & defaults to user data types... */
/* No defaults to bind. */
/* No rules to bind. */
/* Start of description of table dbo.jdbc_function_escapes */
setuser 'dbo'
go
CREATE TABLE dbo.jdbc_function_escapes (
escape_name varchar(40) NOT NULL,
map_string varchar(40) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.jdbc_function_escapes') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.jdbc_function_escapes TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.jdbc_function_escapes */
/* Start of description of table dbo.spt_jdbc_conversion */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jdbc_conversion (
datatype int NOT NULL,
conversion char(20) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jdbc_conversion') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jdbc_conversion TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jdbc_conversion */
/* Start of description of table dbo.spt_jdbc_table_types */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jdbc_table_types (
TABLE_TYPE char(15) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jdbc_table_types') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jdbc_table_types TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jdbc_table_types */
/* Start of description of table dbo.spt_jtext */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jtext (
mdinfo varchar(30) NOT NULL,
value text NOT NULL,
UNIQUE (mdinfo)
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jtext') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jtext TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jtext */
/* Start of description of table dbo.spt_limit_types */
setuser 'dbo'
go
CREATE TABLE dbo.spt_limit_types (
name char(30) NOT NULL,
id smallint NOT NULL,
enforced tinyint NOT NULL,
object_type smallint NOT NULL,
scope smallint NOT NULL,
units char(60) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_limit_types') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_limit_types TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_limit_types */
/* Start of description of table dbo.spt_mda */
setuser 'dbo'
go
CREATE TABLE dbo.spt_mda (
mdinfo varchar(30) NOT NULL,
querytype tinyint NOT NULL,
query varchar(255) NULL,
mdaver_start tinyint NOT NULL,
mdaver_end tinyint NOT NULL,
srvver_start int NOT NULL,
srvver_end int NOT NULL
)
go
IF OBJECT_ID('dbo.spt_mda') IS NOT NULL
BEGIN
CREATE UNIQUE NONCLUSTERED INDEX spt_mda_ind
ON spt_mda (mdinfo, mdaver_end, srvver_end)
END
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_mda') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_mda TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_mda */
/* Start of description of table dbo.spt_monitor */
setuser 'dbo'
go
CREATE TABLE dbo.spt_monitor (
lastrun datetime NOT NULL,
cpu_busy int NOT NULL,
io_busy int NOT NULL,
idle int NOT NULL,
pack_received int NOT NULL,
pack_sent int NOT NULL,
connections int NOT NULL,
pack_errors int NOT NULL,
total_read int NOT NULL,
total_write int NOT NULL,
total_errors int NOT NULL
)
ON system
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_monitor') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_monitor TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_monitor */
/* Start of description of table dbo.spt_values */
setuser 'dbo'
go
CREATE TABLE dbo.spt_values (
name varchar(28) NULL,
number int NOT NULL,
type char(2) NOT NULL,
low int NULL,
high int NULL,
msgnum int NULL
)
ON system
go
IF OBJECT_ID('dbo.spt_values') IS NOT NULL
BEGIN
CREATE CLUSTERED INDEX spt_valuesclust
ON spt_values (number, type)
END
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_values') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_values TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_values */
/* Start of description of table dbo.syblicenseslog */
setuser 'dbo'
go
CREATE TABLE dbo.syblicenseslog (
status smallint NOT NULL,
logdate datetime NOT NULL,
maxlicenses int NOT NULL
)
go
/* Add permissions for table... */
/* Bind rules & defaults to columns... */
/* End of description of table dbo.syblicenseslog */
/* Now create the key definitions ...*/
setuser 'dbo'
go
/* Views... */
/* No views found. */
/* Procedures... */
/* Procedure sp_configure, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/configure */
/*
** Messages for "sp_configure" 17410
** Must use "langid" when referencing spt_values
**
** 17260, "Can't run %1! from within a transaction."
** 17410, "Configuration option doesn't exist."
** 17411, "Configuration option is not unique."
** 17413, "The value of the 'number of devices' must be greater than the highest VDEVNO, '%1!', defined in sysdevices."
** 17414, "You can't set the default language to a language ID that is not defined in Syslanguages."
** 17415, "Configuration option value is not legal."
** 17418, "'%1!' is an invalid file command. The valid commands are 'verify', 'read', 'write', and 'restore'."
** 17419, "Configuration option changed. The SQL Server need not be rebooted since the option is dynamic.
** 18123, "Configuration option changed. The SQL Server must be rebooted before the change in effect since the option is static."
** 18124, "No matching configuration options. Here is a listing of groups:"
** 18125, "Must provide the parameter 'filename'."
** 18133, "The character set, '%1!', is invalid since it is not defined in Syscharsets."
** 18134, "The sortorder, '%1!', is invalid since it is not defined in Syscharsets."
** 18549, "Invalid third argument supplied: '%1!'. Valid choices are
** 'with truncate' or 'default'."
*/
create procedure sp_configure
@configname varchar(80) = NULL, /* configure option name */
@configvalue int = NULL, /* configure value */
@configvalue2 varchar(255) = NULL, /* config file command/charset info */
@configvalue3 varchar(255) = NULL /* physical name of file */
as
declare @confignum int /* number of option to be configured */
declare @configcount int /* number of options like @configname */
declare @whichone int /* using english or default lang ? */
declare @cmd smallint /* configuration file command */
declare @status int /* return status for misc calls */
declare @children int /* number of children in a group */
declare @parent int /* config number of parent group */
declare @msg varchar(255) /* temp buffer for messages */
declare @sysconfig smallint /* contents of sysconfigures.config */
declare @sysname varchar(255) /* contents of sysconfigures.comment */
declare @sysparent smallint /* contents of sysconfigures.parent */
declare @sysstatus smallint /* contents of sysconfigures.status */
declare @value int /* default charset/sort order id */
declare @user_displaylevel int /* user display level */
declare @maxvdevno int /* highest number of vdevno */
declare @sortorder_id int /* current sortorder id */
declare @charset_id int /* current charset id */
declare @use_wildcard tinyint /* use wildcard to search option name or not */
declare @match_count int /* number of option found by name match */
declare @cache_part_temp int /* cache partition number */
declare @partition_number int /* cache partition number */
declare @cmpstate int /* Local NODE state in companionship */
declare @nocase tinyint /* case-sensitive sort order flag */
select @whichone = 0
select @status = 0
select @cmd = 1
select @value = NULL
select @user_displaylevel = NULL
select @sortorder_id =
value from master.dbo.syscurconfigs where config = 123
select @charset_id =
value from master.dbo.syscurconfigs where config = 131
select @use_wildcard = 1
/*
** Check if the default sort order is case-insensitive.
*/
if ("A" = "a")
select @nocase = 1
else
select @nocase = 0
/*
** Disallow running sp_configure within a transaction since it might make
** recovery impossible.
*/
if @@trancount > 0
begin
/*
** 17260, "Can't run %1! from within a transaction."
*/
raiserror 17260, "sp_configure"
return (1)
end
else
begin
set chained off
end
set transaction isolation level 1
set nocount on
/*
** If the "default sortorder" is case insensitive dictionary sort order,
** the procedure will just print out all the options and their values
** without grouping if no option name is given.
*/
if (@nocase = 1 and @configname is NULL)
begin
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue)))+
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), b.comment)))+
convert(varchar(11), b.comment)),
"Config Value" =convert(char(11), space(11-char_length(
isnull(a.value2, convert(char(32), a.value)))) +
isnull(a.value2, convert(char(32), a.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value)))
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
a.config *= b.config
and parent != 19
and a.config != 19
order by name
return (0)
end
/* Validate the configname if it not NULL */
if @configname is not NULL
begin
select @configcount = count(*)
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and parent != 19
/*
** If configure option is not unique and case-insensitive
** dictionary sort order is used, check if unique option found
** by exact name match, if so, then disable wildcard match
** for searching option name.
*/
if (@configcount > 1 and @nocase = 1)
begin
/* check if unique option found by exact name match */
select @match_count = count(*)
from master.dbo.sysconfigures
where name = @configname
and parent != 19
if @match_count =1
begin
select @use_wildcard = 0 /* don't use wildcard */
select @configcount = @match_count
end
end
/*
** If more than one option like @configname,
** show the duplicates and return.
*/
if @configcount > 1
begin
/*
** 17411, "Configuration option is not unique."
*/
raiserror 17411
print ""
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue)))+
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), b.comment)))+
convert(varchar(11), b.comment)),
"Config Value" =convert(char(11), space(11-char_length(
isnull(a.value2, convert(char(32), a.value)))) +
isnull(a.value2, convert(char(32), a.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value)))
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
a.config *= b.config
and name like "%" + @configname + "%"
and parent != 19
and a.config != 19
order by name
return (1)
end
/*
** if it is a valid option and the @configvalue is not NULL,
** set the option
*/
if (@configcount != 0) and (@configvalue is not NULL)
begin
/* set @confignum */
select @confignum = config,
@sysstatus = status
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and parent != 19
and config != 19
/*
** If @configvalue2 is "default",
** setting the value to default
*/
if (@configvalue2 = "default")
select @value = 1
else
select @value = 0
/*
** If the option name is "configuration file"
*/
if @confignum = 114
begin
/*
** if the file command is one of the valid
** commands.
*/
if ((@configvalue2 = "read") or
(@configvalue2 = "write") or
(@configvalue2 = "restore") or
(@configvalue2 = "verify"))
begin
/*
** if filename is NULL
*/
if (@configvalue3 is NULL)
begin
/* 18125, "Must provide the parameter 'filename'." */
raiserror 18125
return(1)
end
/*
** Must have sa_role to run these
** commands
*/
if (proc_role("sa_role") < 1)
begin
return(1)
end
else
begin
if (@configvalue2 = "verify")
select @cmd = 2
else
if (@configvalue2 = "read")
select @cmd = 3
else
if (@configvalue2 = "write")
select @cmd = 4
else
if (@configvalue2 = "restore")
select @cmd = 5
end
end
else
begin
/*
** print the message to show the valid
** file command
*/
raiserror 17418, @configvalue2
return(1)
end
select @status = config_admin(@cmd,0,0,0,NULL,
@configvalue3)
if (@status = 1)
begin
return(0)
end
else
begin
return (1)
end
end
if @confignum = 123
begin
/* get current default charset id */
select @value = value from
master.dbo.sysconfigures
where config = 131
if @configvalue2 is not NULL
begin
/* validate the charset id */
if not exists (select *
from master..syscharsets
where name = @configvalue2
and type between 1000 and 1999)
begin
/* 18133, "The character set, '%1!', is invalid since it
** is not defined in Syscharsets."
*/
raiserror 18133, @configvalue2
return (1)
end
/* get default charset id from name */
select @value = id
from master..syscharsets
where name = @configvalue2
and type between 1000 and 1999
end
end
if @confignum = 131
begin
/* get current default sortord id */
select @value = value from
master.dbo.sysconfigures
where config = 123
if @configvalue2 is not NULL
begin
/* validate the sortord id */
if not exists (select *
from master..syscharsets
where name = @configvalue2
and type between 2000 and 2999)
begin
/* 18134, "The sortorder, '%1!', is invalid since it
** is not defined in Syscharsets."
*/
raiserror 18134, @configvalue2
return (1)
end
/* get default sortorder id from name */
select @value = id
from master..syscharsets
where name = @configvalue2
and type between 2000 and 2999
end
end
/*
** If an attempt to enable a disk mirroring is made, and
** if this happens to be a server with HA services turned
** on, we disallow. Currently we do not support ASE HA
** services along with sybase mirroring.
*/
if (@confignum = 140 and @configvalue = 0)
begin
select @cmpstate = @@cmpstate
if @cmpstate >= 0
begin
/* 18816 Mirroring not allowed in ASE HA */
raiserror 18816
return(1)
end
end
/*
** If an attempt to disable disk mirroring is being made,
** ensure that there are no devices that are currently
** being mirrored.
*/
if (@confignum = 140 and @configvalue = 1)
begin
if (select count(*) from master.dbo.sysdevices
where status & 512 = 512) > 0
begin
/* 18750, Unable to disable disk mirroring
** because some devices are currently
** mirrored. Use 'disk unmirror' to
** unmirror these devices and then
** re-run this sp_configure command.
*/
raiserror 18570
return (1)
end
end
/*
** If this is the number of devices configuration
** parameter, we want to make sure that it's not being
** set to lower than the
** number of devices in sysdevices.
*/
if @confignum = 116
begin
/*
** Get the default value if trying to set the
** value to the default value
*/
if (@value = 1)
begin
select @configvalue = convert(int, defvalue)
from master.dbo.syscurconfigs
where config = 116
end
/*
** Get the max vdevno.
*/
select @maxvdevno = max(
convert(tinyint,
substring(convert(binary(4), d.low),
v.low, 1)))
from master.dbo.sysdevices d,
master.dbo.spt_values v
if (@configvalue <= @maxvdevno)
begin
/* 17413, "The value of the 'number of devices' must be
** greater than the highest VDEVNO, '%1!', defined
** in sysdevices."
*/
raiserror 17413, @maxvdevno
return (1)
end
end
/*
** If this is the number of default language, we want
** to make sure that the new value is a valid language
** id in Syslanguages.
*/
if @confignum = 124
begin
if not exists (select *
from master.dbo.syslanguages
where langid = @configvalue)
begin
/* 0 is default language, us_english */
if @configvalue != 0
begin
/* 17414, "You can't set the default language to a
** language ID that is not defined in Syslanguages."
*/
raiserror 17414
return (1)
end
end
end
/*
** If this is the number of current audit table we want
** to make sure that if "with truncate" opiton is not
** provided new table is empty other wise fail.
*/
if @confignum = 260
begin
if @configvalue2 is not NULL
begin
if (@configvalue2 not in ("with truncate",
"default"))
begin
/*
** 18549, "Invalid third argument
** supplied: '%1!'. Valid
** choices are 'with truncate'
** or 'default'."
*/
raiserror 18549, @configvalue2
return(1)
end
end
else
begin
select @value = 2
end
end
if @confignum = 337
begin
if @configvalue is not NULL
begin
if (@configvalue2 = "default")
begin
select @partition_number = 1
end
else
begin
select @partition_number =
@configvalue
end
if (@partition_number <= 0) OR
(@partition_number > 64)
begin
raiserror 18611
return(1)
end
select @cache_part_temp = 2
while @cache_part_temp < @partition_number
select @cache_part_temp =
@cache_part_temp * 2
if @partition_number != 1 AND
@cache_part_temp != @partition_number
begin
raiserror 18611
return(1)
end
end
end
/* call config_admin() to set the new value */
select @status = config_admin(@cmd, @confignum,
@configvalue, @value, NULL, @configvalue2)
/* if successful */
if (@status = 1)
begin
/* Display the new value */
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11),space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11),
space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where
b.config = @confignum and
b.config *= c.config
/*
** print reboot message if this option is not
** dynamic.
*/
select @sysstatus = @sysstatus & 8
if @sysstatus = 8
begin
exec sp_getmessage 17419, @msg output
print @msg
end
else
begin
exec sp_getmessage 18123, @msg output
print @msg
end
return(0)
end
else
return(1)
end
end
/*
** @configcount=0 implies @configname is not valid
** @configname=NULL implies displaying all the parameters except for
** the parameters with the config number equal to 19 or the parent equal
** to 19 since those parameters are displayed by sp_cacheconfig.
*/
if (@configcount =0)
begin
/* 18124, "No matching configuration options.
** Here is a listing of groups:"
*/
raiserror 18124
select convert(char(50), name)
from master.dbo.sysconfigures
where config < 100
and parent != 19
and config != 19
order by name
return(1)
end
else if (@configname is NULL)
select @configname = "Config"
/*
** retrieve the display level from sysattributes
*/
select @user_displaylevel = int_value from master.dbo.sysattributes where
class = 4 AND
attribute = 0 AND
object_type = 'L' AND
object = suser_id()
/*
** set the default display level to 10 if it is not defined in sysattributes
*/
if (@user_displaylevel = NULL)
select @user_displaylevel = 10
/*
** If @use_wildcard = 0 and the default sortorder is case-insensitive
** dictionary sort order, use exact match: name = @configname to get row,
** otherwise use wildcard match: name like "%" + @configname + "%".
*/
if (@use_wildcard = 0 and @nocase = 1)
begin
select @confignum = config,
@parent = config,
@sysname = name,
@sysstatus = status
from master.dbo.sysconfigures
where name = @configname
and config != 19
end
else
begin
select @confignum = config,
@parent = config,
@sysname = name,
@sysstatus = status
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and config != 19
end
select @children = count(*)
from master.dbo.sysconfigures
where parent = @confignum
if @children = 0
begin
/* @@nestlevel is problem area if a sproc calls sp_configure */
/* could pass in another param when recursing */
if @@nestlevel > 1
begin
/* reached a leaf, notify parent */
return(1)
end
else
begin
/* display the information of the config parameter */
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where
b.config *= c.config
and name like "%" + @configname + "%"
and b.config != 19
and parent != 19
end
end
else
begin
select @msg = "Group: " + @sysname
print ""
print @msg
print ""
/* this poor guy has kids, so recurse to leaves */
declare config_curs cursor for
select config, name, parent
from master.dbo.sysconfigures
where parent = @parent
order by name
open config_curs
fetch config_curs into @sysconfig, @sysname, @sysparent
while (@@sqlstatus = 0)
begin
execute @status = sp_configure @sysname
if (@status = 1)
begin
/*
** this guy has leaves as kids,
** so print out the leaves with
** display level <= @user_displaylevel
** Note: If a config parameter has more than one
** parent, the extra parents are stored in
** 'sysattribures'.
*/
create table #configure_temp (config int)
insert into #configure_temp
select a.config
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
display_level <= @user_displaylevel
and parent = @parent
and a.config != 19
and a.config = b.config
union
select config
from master.dbo.syscurconfigs,
master.dbo.sysattributes
where
display_level <= @user_displaylevel
and class = 4
and attribute = 1
and object_type = 'CP'
and int_value = @parent
and object = config
and config != 19
if exists (select * from #configure_temp)
begin
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11),space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where b.config in
(select config from #configure_temp)
and b.config = c.config
order by name
end
drop table #configure_temp
close config_curs
deallocate cursor config_curs
return(0)
end
else
begin
/*
** this lucky guy has grandkids, so, continue
*/
fetch config_curs into
@sysconfig, @sysname, @sysparent
end
end
close config_curs
deallocate cursor config_curs
return(0)
end
go
IF OBJECT_ID('dbo.sp_configure') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_configure TO public
END
go
/* Procedure sp_dboption, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/a_values */
/*
** Messages for "sp_dboption" 17420
** Use "langid" when looking at spt_values ???
**
** 17260, "Can't run %1! from within a transaction."
** 17420, "Settable database options."
** 17421, "No such database -- run sp_helpdb to list databases."
** 17422, "The 'master' database's options can not be changed."
** 17423, "Usage: sp_dboption [dbname, optname, {true | false}]"
** 17424, "Database option doesn't exist or can't be set by user."
** 17425, "Run sp_dboption with no parameters to see options."
** 17426, "Database option is not unique."
** 17428, "You must be in the 'master' database in order to change
** database options."
** 17429, "The database is currently in use -- 'read only' option
** disallowed."
** 17430, "Run the CHECKPOINT command in the database that was changed."
** 17431, "true"
** 17432, "false"
** 17433, "Database option '%1!' turned ON for database '%2!'."
** 17434, "Database option '%1!' turned OFF for database '%2!'."
** 17289, "Set your curwrite to the hurdle of current database."
** 17436, "The 'single user' option is not valid for the 'tempdb'
** database."
** 17439, "You cannot turn on ''%1!' for '%2!' because it is an HA server
** that has been configured with the proxy_db option."
*/
create procedure sp_dboption
@dbname varchar(30) = NULL, /* database name to change */
@optname varchar(20) = NULL, /* option name to turn on/off */
@optvalue varchar(10) = NULL /* true or false */
as
declare @dbid int /* dbid of the database */
declare @dbuid int /* id of the owner of the database */
declare @statvalue smallint, /* number of option */
@stattype char(2), /* status field flag */
@statopt smallint, /* option mask, part 1 */
@stat2opt smallint /* option mask, part 2 */
declare @optcount int /* number of options like @optname */
declare @success_msg varchar(255) /* success status message */
declare @msg varchar(250)
declare @sptlang int
declare @true varchar(10)
declare @false varchar(10)
declare @whichone int /* which language? */
declare @name varchar(30)
declare @optmsgnum int /* identify one msgnum to compare */
declare @msgcnt int /* count distinct dups */
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
select @sptlang = @@langid, @whichone = 0
if @@langid != 0
begin
if not exists (
select * from master.dbo.sysmessages where error
between 17050 and 17069
and langid = @@langid)
select @sptlang = 0
end
/*
** If no @dbname given, just list the possible dboptions.
** Only certain status bits may be set or cleared.
** settable not settable
** ------------------------------ --------------------------
** allow select into/bulkcopy (4) don't recover (32)
** read only (1024) not recovered (256)
** dbo use only (2048) dbname has changed (16384)
** single user (4096)
** truncate log on checkpoint (8)
** no checkpoint on recovery (16)
** allow null (8192)
** ddl in tran (512)
** ALL SETTABLE OPTIONS (15900)
** abort xact on log full (1, type='D2')
** no space accounting (2, type='D2')
** auto identity(4, type='D2')
** identity in nonunique index(8, type='D2')
** auto identity unique index(64, type='D2')
*/
/*
** Look for the "settable options" mask in spt_values
*/
select @statopt = number
from master.dbo.spt_values
where type = "D"
and name = "ALL SETTABLE OPTIONS"
select @stat2opt = number
from master.dbo.spt_values
where type = "D2"
and name = "ALL SETTABLE OPTIONS"
/*
** If we can't find the option masks, guess at them
*/
if @statopt is null
select @statopt = 4 | 8 | 16 | 512 | 1024 | 2048 | 4096 | 8192
if @stat2opt is null
select @stat2opt = 1 | 2 | 4 | 8 | 64
if @dbname is null
begin
/*
** 17420, "Settable database options."
*/
exec sp_getmessage 17420, @msg output
print @msg
if @sptlang = 0
select database_options = name
from master.dbo.spt_values
where ((type = "D"
and number & @statopt = number
and number & @statopt != @statopt)
or (type = "D2"
and number & @stat2opt = number
and number & @stat2opt != @stat2opt))
order by name
else
select database_options = name, convert(char(22), description)
from master.dbo.spt_values, master.dbo.sysmessages
where ((type = "D"
and number & @statopt = number
and number & @statopt != @statopt)
or (type = "D2"
and number & @stat2opt = number
and number & @stat2opt != @stat2opt))
and msgnum = error
and langid = @sptlang
order by name
return (0)
end
/*
** Verify the database name and get the @dbid and @dbuid
*/
select @dbid = dbid, @dbuid = suid
from master.dbo.sysdatabases
where name = @dbname
/*
** If @dbname not found, say so and list the databases.
*/
if @dbid is NULL
begin
/*
** 17421, "No such database -- run sp_helpdb to list databases."
*/
raiserror 17421
return (1)
end
/*
** Only the Database Owner (DBO) or
** Accounts with SA role can execute it.
** Call proc_role() with the required SA role.
*/
if ((suser_id() != @dbuid) and (proc_role("sa_role") < 1))
return(1)
/*
** You can not change any of the options in master. If the user tries to
** do so tell them they can't.
*/
if @dbid = 1
begin
/*
** 17422, "The 'master' database's options can not be changed."
*/
raiserror 17422
return (1)
end
/*
** Check remaining parameters.
*/
/* 17431, "true" */
exec sp_getmessage 17431, @true out
/* 17432, "false" */
exec sp_getmessage 17432, @false out
if @optname is NULL or lower(@optvalue) not in
("true", "false", @true, @false) or @optvalue is null
begin
/*
** 17423, "Usage: sp_dboption [dbname, optname, {true | false}]"
*/
raiserror 17423
return (1)
end
/*
** Use @optname and try to find the right option.
** If there isn't just one, print appropriate diagnostics and return.
*/
select @optcount = count(*)
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
/*
** If more than one option like @optname, make sure they are not the same
** option ("trunc" and "trunc.", for example)
*/
if @optcount > 1
begin
select @optmsgnum = msgnum
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
select @msgcnt = count(msgnum)
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum != @optmsgnum
/*
** msgcnt of 0 indicates we really have just 1 unique dboption,
** probably due to alternate spelling.
*/
if (@msgcnt = 0)
select @optcount = 1
end
/*
** If no option, and alternate language is set, use other language
*/
if @optcount = 0 and @sptlang != 0
begin
select @optcount = count(*)
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
select @whichone = 1
/*
** If more than one option like @optname, make sure they are not the same
** option ("trunc" and "trunc.", for example)
*/
if @optcount > 1
begin
select @optmsgnum = msgnum
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
select @msgcnt = count(msgnum)
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
and msgnum != @optmsgnum
/*
** msgcnt of 0 indicates we really have just 1 unique dboption,
** probably due to alternate spelling.
*/
if (@msgcnt = 0)
select @optcount = 1
end
end
/*
** If no option, show the user what the options are.
*/
if @optcount = 0
begin
/*
** 17424, "Database option doesn't exist or can't be set by user."
*/
raiserror 17424
/*
** 17425, "Run sp_dboption with no parameters to see options."
*/
exec sp_getmessage 17425, @msg output
print @msg
return (1)
end
/*
** If more than one option like @optname, show the duplicates and return.
*/
if @optcount > 1
begin
/*
** 17426, "Database option is not unique."
*/
raiserror 17426
if @sptlang = 0
select duplicate_options = name
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
else
select duplicate_options = name, convert(char(22), description)
from master.dbo.spt_values, master.dbo.sysmessages
where (name like "%" + @optname + "%"
or description like "%" + @optname + "%")
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
return (1)
end
if db_name() != "master"
begin
/*
** 17428, "You must be in the 'master' database in order to change database options."
*/
raiserror 17428
return (1)
end
/*
** User cannot set "tempdb" database in single user mode.
*/
select @statvalue = number
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
if (@dbid = 2) and (@statvalue = 4096)
begin
/*
** 17436, "The 'single user' option is not valid for the 'tempdb'
** database."
*/
raiserror 17436
return (1)
end
/*
** If we're in a transaction, disallow this since it might make recovery
** impossible.
*/
if @@trancount > 0
begin
/*
** 17260, "Can't run %1! from within a transaction."
*/
raiserror 17260, "sp_dboption"
return (1)
end
else
begin
set chained off
end
set transaction isolation level 1
/*
** Get the number which is the bit value to set
*/
if @whichone = 0
select @statvalue = number, @stattype = type, @success_msg = name
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
else
select @statvalue = number, @stattype = type, @success_msg = name
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
/*
** We do not allow 'sybsecurity' to be set to 'single user' since,
** if auditing is enabled and we try to set 'sybsecurity' database to
** 'single user' then, the audit process is killed because audit process
** tries to do 'usedb' and it fails (look at utils/auditing.c).
*/
if (@dbname = "sybsecurity") and (@statvalue = 4096)
begin
/*
** 17435, "The 'single user' option is not valid for the
** 'sybsecurity' database.
*/
raiserror 17435
return (1)
end
/*
** Now update sysdatabases.
*/
if lower(@optvalue) in ("true", @true)
begin
/*
** If this the option to make the database read only,
** we need to do some checking first.
** Unless it's the master db, no one can be using it.
** If it's the master db, only the SA may be using it.
*/
if (@statvalue = 1024) and (select count(*)
from master.dbo.sysprocesses
where dbid = @dbid) > 0
begin
/*
** 17429, "The database is currently in use -- 'read only' option disallowed."
*/
raiserror 17429
return (1)
end
/*
** If this is the option to set 'abort tran on log full' to
** true for sybsecurit database, then don't allow.
*/
if (db_name(@dbid) = "sybsecurity"
and @stattype = "D2" and @statvalue = 1)
begin
/*
** AUDIT_CHANGE: New error message needs to be reserved and
** the print statement needs to be removed.
*/
print "You cannot set 'abort tran on log full' to true for sybsecurity database."
return (1)
end
/*
** Disallow DDL IN TRAN
** if proxydb option is set (@@crthaproxy = 1)
** if this server is a HA server (@@cmpstate >= 0)
*/
if ((@statvalue = 512) and (@@crthaproxy = 1) and (@@cmpstate >= 0))
begin
/*
** Cannot set DDL_IN_TRAN option for HA servers
** configured with proxy_db option.
*/
select @name = db_name(@dbid)
exec sp_getmessage 17439, @msg output
print @msg, @success_msg, @name
return (1)
end
if (@stattype = "D")
update master.dbo.sysdatabases
set status = status | @statvalue
where dbid = @dbid
else
update master.dbo.sysdatabases
set status2 = status2 | @statvalue
where dbid = @dbid
/*
** 17433, "Database option %1! turned ON for database %2!."
*/
exec sp_getmessage 17433, @msg output
select @name = db_name(@dbid)
print @msg, @success_msg, @name
end
/*
** We want to turn it off.
*/
else
begin
if (@stattype = "D")
update master.dbo.sysdatabases
set status = status & ~@statvalue
where dbid = @dbid
else
update master.dbo.sysdatabases
set status2 = status2 & ~@statvalue
where dbid = @dbid
/*
** 17434, "Database option %1! turned OFF for database %2!."
*/
exec sp_getmessage 17434, @msg output
select @name = db_name(@dbid)
print @msg, @success_msg, @name
end
/*
** Advise the user to run the CHECKPOINT command in the database that
** was changed.
*/
/*
** 17430, "Run the CHECKPOINT command in the database that was changed."
*/
exec sp_getmessage 17430, @msg output
print @msg
return (0)
go
IF OBJECT_ID('dbo.sp_dboption') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_dboption TO public
END
go
/* Procedure sp_dbupgrade, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
create procedure sp_dbupgrade
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/*
** Do the sysindexes column names update which is part of the 38 upgrade.
** The sysgams updates have already been taken care of by pg_gamalloc.
*/
print "Upgrading Sysindexes columns in the database"
if not exists (select name from syscolumns where id = 2 and name = 'doampg')
begin
update syscolumns
set name = 'doampg'
where id = 2 and name = 'dpages'
update syscolumns
set name = 'ioampg'
where id = 2 and name = 'reserved'
update syscolumns
set name = 'spare1'
where id = 2 and name = 'used'
update syscolumns
set name = 'spare2'
where id = 2 and name = 'rows'
end
/* The following updates are part of the 42 upgrade. */
/*
** Tweak the Syscolumns entries for the Sysindexes table so that
** "soid" and "csid" replace half of "usagecnt".
*/
if not exists (select * from syscolumns where id = 2 and name = 'soid')
begin
begin transaction
update syscolumns
set type = 52, length = 2, usertype = 6, offset = 42
where id = 2 and colid = 13
insert into syscolumns
(id, number, colid, status, type, length, offset,
usertype, cdefault, domain, name, printfmt)
values (2, 0, 23, 0, 48, 1, 40, 5, 0, 0, 'soid', '')
insert into syscolumns
(id, number, colid, status, type, length, offset,
usertype, cdefault, domain, name, printfmt)
values (2, 0, 24, 0, 48, 1, 41, 5, 0, 0, 'csid', '')
commit transaction
end
print "Adding new datatypes to the database."
if exists (select * from systypes where name = 'text')
begin
delete systypes where name = 'text'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 19, 0, 1, 35, 16, 0, 0, 'text', null)
if exists (select * from systypes where name = 'image')
begin
delete systypes where name = 'image'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 20, 0, 1, 34, 16, 0, 0, 'image', null)
if exists (select * from systypes where name = 'timestamp')
begin
delete systypes where name = 'timestamp'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 80, 0, 1, 37, 8, 0, 0, 'timestamp', null)
if exists (select * from systypes where name = 'smallmoney')
begin
delete systypes where name = 'smallmoney'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 21, 0, 1, 122, 4, 0, 0, 'smallmoney', null)
if exists (select * from systypes where name = 'smalldatetime')
begin
delete systypes where name = 'smalldatetime'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 22, 0, 1, 58, 4, 0, 0, 'smalldatetime', null)
if exists (select * from systypes where name = 'real')
begin
delete systypes where name = 'real'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 23, 0, 1, 59, 4, 0, 0, 'real', null)
/* 4.9 user types for national character */
if exists (select * from systypes where name = 'nchar')
begin
delete systypes where name = 'nchar'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt )
values (1, 24, 0, 1, 47, 255, 0, 0, 'nchar', null)
if exists (select * from systypes where name = 'nvarchar')
begin
delete systypes where name = 'nvarchar'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 25, 1, 1, 39, 255, 0, 0, 'nvarchar', null)
if exists (select * from systypes where name = 'NULL')
begin
delete systypes where name = 'NULL'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 0, 0, 1, 0, 0, 0, 0, 'NULL', null)
/* 4.9 system table creation */
print "Creating system catalog: sysusermessages and its indexes."
if not exists (select * from sysobjects where name='sysusermessages')
begin
execute sp_configure 'allow updates', 1
reconfigure with override
dbcc traceon(3701)
begin
create table sysusermessages(error int,uid smallint,
description varchar(255), langid smallint null) lock allpages
create clustered index csysusermessages
on sysusermessages (error)
create unique nonclustered index ncsysusermessages
on sysusermessages (error, langid)
end
dbcc traceoff(3701)
execute sp_configure 'allow updates', 0
reconfigure with override
end
print "Shutting down SQL Server"
shutdown
return (0)
go
/* Procedure sp_getmessage, owner dbo */
setuser 'dbo'
go
/* generic/sproc/getmessage 14.2 4/25/91 */
/* Messages from sysmessages
** 17200, "Message number must be greater than or equal to 17000."
** 17201, "'%1!' is not an official language name from Syslanguages."
** 17202, "Message number %1! does not exist in the %2! language."
*/
create procedure sp_getmessage
@message_num int,
@result varchar(255) output,
@language varchar(30) = NULL
as
declare @lang_id smallint
declare @msg varchar(255)
declare @returncode smallint
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/*
** Use default language if none specified,
** and initialize result
*/
select @lang_id = @@langid, @result = NULL
/* Only retrieve external errors */
if @message_num < 17000
BEGIN
/* 17200 "Message number must be greater than or equal to 17000." */
select @msg = description from master.dbo.sysmessages
where error = 17200
print @msg
return (1)
END
/*
** Check that language is valid.
*/
if @language is not NULL
BEGIN
execute @returncode = sp_validlang @language
if @returncode != 0
begin
/* Us_english is always valid */
if @language != "us_english"
BEGIN
/*
** 17201, "'%1!' is not an official language
** name from Syslanguages."
*/
select @msg = description from master.dbo.sysmessages
where error = 17201
and langid = @@langid
/* Get english if the current language is missing */
if @msg is null
select @msg = description from master.dbo.sysmessages
where error = 17201
and langid is NULL
print @msg, @language
return @returncode
END
/* set to us_english */
select @lang_id = NULL
end
else
select @lang_id = langid from master.dbo.syslanguages
where @language = name
END
/* The langid is assigned 0 since it gets its value from @@langid. */
/* For us_english, we have to insert it as NULL and not 0, this is */
/* to maintain compatibility with the current conventions */
if @lang_id = 0
begin
select @lang_id = NULL
end
/* Get message from the proper place */
/* System messages */
if @message_num < 20000
BEGIN
select @result = description from master.dbo.sysmessages
where langid = @lang_id
and error = @message_num
/* Get english if the current language is missing */
if @result is null
select @result = description from master.dbo.sysmessages
where error = @message_num
and (langid is NULL or langid =0)
END
else
/* User messages */
BEGIN
/* There is no proper alternate language for user messages */
select @result = description from sysusermessages
where langid = @lang_id
and error = @message_num
/* this is in here for compatibility with older revs which */
/* by mistake used to add langid as 0 in sysusermessages */
if @result is null and @lang_id is NULL
select @result = description from sysusermessages
where (langid = 0 or langid is NULL)
and error = @message_num
END
/* Warn the user if the message can't be found */
if @result is null
begin
/* 17202, "Message number %1! does not exist in the %2! language." */
select @msg = description from master.dbo.sysmessages
where error = 17202
and langid = @@langid
if @language is null
select @language = @@language
if @msg is null
select @msg = "Message number %1! does not exist in the %2! language."
print @msg, @message_num, @language
return (1)
end
return (0)
go
IF OBJECT_ID('dbo.sp_getmessage') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_getmessage TO public
END
go
/* Procedure sp_loaddbupgrade, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
create procedure sp_loaddbupgrade
@databasename varchar(30),
@devname varchar(30)
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
dbcc traceon(3402)
/* The recovery which is part of load database will perform the upgrade */
load database @databasename from @devname
dbcc traceoff(3402)
return (0)
go
/* Procedure sp_procxmode, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
/*
** 17756, "The execution of the stored procedure '%1!' in database
** '%2!' was aborted because there was an error in writing the
** replication log record."
*/
create procedure sp_procxmode
@procname varchar(255) = null,
@tranmode varchar(30) = null
as
declare @uid smallint
declare @oid int
declare @msg varchar(250) /* message text */
declare @dbname varchar(30)
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/* If either parameter is null we will be joining with a temporary table
** to convert transaction mode numbers (0, 1, 2) to strings ("Unchained",
** "Chained", "Any Mode").
*/
if ((@procname is null) or (@tranmode is null))
begin
create table #tranmode (intval integer, charval varchar(15))
insert into #tranmode values(0, "Unchained")
insert into #tranmode values(1, "Chained")
insert into #tranmode values(2, "Any Mode")
end
/* If the first parameter is null, we're to report the transaction-modes
** of every stored procedure in the current database.
*/
if (@procname is null)
begin
select "procedure name" = o.name, "user name" = user_name(o.uid),
"transaction mode" = t.charval
from sysobjects o, #tranmode t
where ((o.type = "P") or (o.type = "XP")) and (t.intval = ((o.sysstat2 / 16) & 3))
order by o.name
return(0)
end
/* If only the second parameter is null, we're to report the
** transaction-mode of the specified stored procedure.
*/
if ((@procname is not null) and (@tranmode is null))
begin
if (not exists (select name from sysobjects
where ((type = "P") or (type = "XP")) and
(name = @procname)))
begin
/*
** Force an error message, since we haven't
** installed sp_getmessage yet.
*/
dbcc update_tmode(@procname, "Chained")
return (1)
end
select "procedure name" = o.name, "user name" = user_name(o.uid),
"transaction mode" = t.charval
from sysobjects o, #tranmode t
where ((o.type = "P") or (o.type = "XP")) and (@procname = o.name) and
(t.intval = ((o.sysstat2 / 16) & 3))
return(0)
end
/* If neither parameter is null, we're to set the transaction-mode
** of the specified procedure to the specified value.
*/
if ((@procname is not null) and (@tranmode is not null))
begin
/* Start the transaction to log the execution of this procedure.
**
** IMPORTANT: The name "rs_logexec is significant and is used by
** Replication Server
*/
begin transaction rs_logexec
/*
** Update transaction-mode in both sysobjects and DES.
*/
dbcc update_tmode(@procname, @tranmode)
/* If dbcc update_tmode returned an error, return
** an error now.
*/
if (@@error != 0)
begin
rollback transaction rs_logexec
return(1)
end
/*
** Write the log record to replicate this invocation
** of the stored procedure.
*/
if (logexec() != 1)
begin
/*
** 17756, "The execution of the stored procedure '%1!'
** in database '%2!' was aborted because there
** was an error in writing the replication log
** record."
*/
select @dbname = db_name()
raiserror 17756, "sp_procxmode", @dbname
rollback transaction rs_logexec
return(1)
end
commit transaction
end
go
IF OBJECT_ID('dbo.sp_procxmode') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_procxmode TO public
END
go
/* Procedure sp_prtsybsysmsgs, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/*
** This procedure is needed to extract messages for the batch that creates
** the sybsystemprocs database. When return parameters are used in an execute
** statement that is a part of a SQL batch, the return values are printed
** with a heading before subsequent statements in the batch are executed.
** These headings could be confusing to a user that is looking at the results
** of the batch. Hence we print the message in a stored procedure
*/
create procedure sp_prtsybsysmsgs
@i int, @size int = NULL, @size2 int = NULL
as
declare @msg varchar(250)
exec sp_getmessage @i, @msg out
print @msg, @size, @size2
go
/* Procedure sp_validlang, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/serveroption */
create procedure sp_validlang
@name varchar(30)
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/* Check to see if this language is in Syslanguages. */
if exists (select *
from master.dbo.syslanguages
where name = @name)
begin
return 0
end
return 1
go
IF OBJECT_ID('dbo.sp_validlang') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_validlang TO public
END
go
/* Triggers... */
/* No triggers found. */
SQL-Translator-0.11024/t/data/roundtrip.xml 0000644 0001750 0001750 00000012165 12573547220 017723 0 ustar ilmari ilmari
SELECT email FROM Basic WHERE (email IS NOT NULL)
update modified=timestamp();
update modified2=timestamp();
select timestamp();
select foo from bar
Go Sox!
SQL-Translator-0.11024/t/data/access/ 0000755 0001750 0001750 00000000000 13225114407 016377 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/access/gdpdm.ddl 0000644 0001750 0001750 00000015101 12163313615 020157 0 ustar ilmari ilmari DROP TABLE div_aa_annotation;
CREATE TABLE div_aa_annotation
(
div_aa_annotation_id Long Integer (4),
div_annotation_type_id Long Integer (4),
div_allele_assay_id Long Integer (4),
annotation_value Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_allele;
CREATE TABLE div_allele
(
div_allele_id Long Integer (4),
div_obs_unit_sample_id Long Integer (4),
div_allele_assay_id Long Integer (4),
allele_num Long Integer (4),
quality Long Integer (4),
value Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_allele_assay;
CREATE TABLE div_allele_assay
(
div_allele_assay_id Long Integer (4),
div_marker_id Long Integer (4),
div_poly_type_id Long Integer (4),
comments Text (50),
date DateTime (Short) (8),
name Text (50),
phase_determined Text (50),
producer Text (50),
position Text (50),
ref_seq Text (50),
div_ref_stock_id Long Integer (4),
source_assay Text (50),
length Long Integer (4)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_annotation_type;
CREATE TABLE div_annotation_type
(
div_annotation_type_id Long Integer (4),
anno_type Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_exp_entry;
CREATE TABLE div_exp_entry
(
div_exp_entry_id Long Integer (4),
div_experiment_id Long Integer (4),
div_obsunit_id Long Integer (4),
div_stock_id Long Integer (4),
plant Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_experiment;
CREATE TABLE div_experiment
(
div_experiment_id Long Integer (4),
name Text (50),
design Text (50),
originator Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_generation;
CREATE TABLE div_generation
(
div_generation_id Long Integer (4),
value Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_locality;
CREATE TABLE div_locality
(
div_locality_id Long Integer (4),
elevation Long Integer (4),
city Text (50),
country Text (50),
origcty Text (50),
latitude Long Integer (4),
longitude Long Integer (4),
locality_name Text (50),
state_province Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_locus;
CREATE TABLE div_locus
(
div_locus_id Long Integer (4),
chromosome_number Long Integer (4),
comments Text (50),
genetic_bin Text (50),
genetic_map Text (50),
genetic_position Long Integer (4),
locus_type Text (50),
name Text (50),
physical_position Long Integer (4)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_marker;
CREATE TABLE div_marker
(
div_marker_id Long Integer (4),
div_locus_id Long Integer (4),
name Text (50),
ref_seq Text (50),
div_ref_stock_id Long Integer (4)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_obs_unit;
CREATE TABLE div_obs_unit
(
div_obs_unit_id Long Integer (4),
div_experiment_id Long Integer (4),
div_stock_id Long Integer (4),
div_locality_id Long Integer (4),
name Text (50),
field_coord_x Long Integer (4),
field_coord_y Long Integer (4),
rep Long Integer (4),
block Long Integer (4),
plot Long Integer (4),
plant Text (50),
planting_date DateTime (Short) (8),
harvest_date DateTime (Short) (8),
summary Boolean
);
-- CREATE ANY INDEXES ...
DROP TABLE div_obs_unit_sample;
CREATE TABLE div_obs_unit_sample
(
div_obs_unit_sample_id Long Integer (4),
div_obs_unit_id Long Integer (4),
date DateTime (Short) (8),
name Text (50),
producer Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_passport;
CREATE TABLE div_passport
(
div_passport_id Long Integer (4),
div_locality_id Long Integer (4),
accename Text (50),
collnumb Long Integer (4),
collector Text (50),
remarks Text (50),
genus Text (50),
germplasm_type Text (50),
local_name Text (50),
population Text (50),
race_name Text (50),
reference Text (50),
secondary_source Text (50),
source Text (50),
species Text (50),
subspecies Text (50),
instcode Text (50),
accenumb Long Integer (4),
collcode Text (50),
spauthor Text (50),
subtaxa Text (50),
subtauthor Text (50),
cropname Text (50),
acqdate DateTime (Short) (8),
colldate DateTime (Short) (8),
bredcode Text (50),
sampstat Text (50),
collsrc Text (50),
donorcode Text (50),
donornumb Long Integer (4),
othernumb Long Integer (4),
duplsite Text (50),
storage Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_poly_type;
CREATE TABLE div_poly_type
(
div_poly_type_id Long Integer (4),
poly_type Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_statistic_type;
CREATE TABLE div_statistic_type
(
div_statistic_type_id Long Integer (4),
stat_type Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_stock;
CREATE TABLE div_stock
(
div_stock_id Long Integer (4),
div_generation_id Long Integer (4),
div_passport_id Long Integer (4),
seed_lot Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_stock_parent;
CREATE TABLE div_stock_parent
(
div_stock_parent_id Long Integer (4),
div_stock_id Long Integer (4),
div_parent_id Long Integer (4),
recurrent Boolean,
role Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_trait;
CREATE TABLE div_trait
(
div_trait_id Long Integer (4),
div_trait_uom_id Long Integer (4),
div_statistic_type_id Long Integer (4),
div_obs_unit_id Long Integer (4),
date DateTime (Short) (8),
value Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_trait_uom;
CREATE TABLE div_trait_uom
(
div_trait_uom_id Long Integer (4),
qtl_trait_ontology_id Long Integer (4),
div_unit_of_measure_id Long Integer (4),
local_trait_name Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_treatment;
CREATE TABLE div_treatment
(
div_treatment_id Long Integer (4),
div_treatment_uom_id Long Integer (4),
div_obs_unit_id Long Integer (4),
value Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_treatment_uom;
CREATE TABLE div_treatment_uom
(
div_treatment_uom_id Long Integer (4),
qtl_treatment_ontology_id Long Integer (4),
div_unit_of_measure_id Long Integer (4)
);
-- CREATE ANY INDEXES ...
DROP TABLE div_unit_of_measure;
CREATE TABLE div_unit_of_measure
(
div_unit_of_measure_id Long Integer (4),
unit_type Text (50)
);
-- CREATE ANY INDEXES ...
DROP TABLE qtl_trait_ontology;
CREATE TABLE qtl_trait_ontology
(
qtl_trait_ontology_id Long Integer (4)
);
-- CREATE ANY INDEXES ...
DROP TABLE qtl_treatment_ontology;
CREATE TABLE qtl_treatment_ontology
(
qtl_treatment_ontology_id Long Integer (4)
);
-- CREATE ANY INDEXES ...
-- CREATE ANY Relationships ...
SQL-Translator-0.11024/t/data/sqlserver/ 0000755 0001750 0001750 00000000000 13225114407 017164 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/sqlserver/create.sql 0000644 0001750 0001750 00000157422 12163313615 021165 0 ustar ilmari ilmari /** This part copied from Sybase test **/
/* Script generated by dbschema.pl(2.4.2) on Mon Aug 18 14:15:25 2003. */
/* Script extracted on a solaris system. */
use master
go
/* Groups... */
/* No groups found. */
/* Users... */
exec sp_adduser 'guest', 'guest'
exec sp_adduser 'probe', 'probe'
go
/* Aliases... */
/* No aliases found. */
/* Add user-defined data types: */
/* No user defined types found. */
/* Rules... */
/* No rules found. */
/* Defaults... */
/* No defaults found. */
/* Bind rules & defaults to user data types... */
/* No defaults to bind. */
/* No rules to bind. */
/* Start of description of table dbo.jdbc_function_escapes */
setuser 'dbo'
go
CREATE TABLE dbo.jdbc_function_escapes (
escape_name varchar(40) NOT NULL,
map_string varchar(40) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.jdbc_function_escapes') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.jdbc_function_escapes TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.jdbc_function_escapes */
/* Start of description of table dbo.spt_jdbc_conversion */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jdbc_conversion (
datatype int NOT NULL,
conversion char(20) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jdbc_conversion') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jdbc_conversion TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jdbc_conversion */
/* Start of description of table dbo.spt_jdbc_table_types */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jdbc_table_types (
TABLE_TYPE char(15) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jdbc_table_types') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jdbc_table_types TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jdbc_table_types */
/* Start of description of table dbo.spt_jtext */
setuser 'dbo'
go
CREATE TABLE dbo.spt_jtext (
mdinfo varchar(30) NOT NULL,
value text NOT NULL,
UNIQUE (mdinfo)
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_jtext') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_jtext TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_jtext */
/* Start of description of table dbo.spt_limit_types */
setuser 'dbo'
go
CREATE TABLE dbo.spt_limit_types (
name char(30) NOT NULL,
id smallint NOT NULL,
enforced tinyint NOT NULL,
object_type smallint NOT NULL,
scope smallint NOT NULL,
units char(60) NOT NULL
)
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_limit_types') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_limit_types TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_limit_types */
/* Start of description of table dbo.spt_mda */
setuser 'dbo'
go
CREATE TABLE dbo.spt_mda (
mdinfo varchar(30) NOT NULL,
querytype tinyint NOT NULL,
query varchar(255) NULL,
mdaver_start tinyint NOT NULL,
mdaver_end tinyint NOT NULL,
srvver_start int NOT NULL,
srvver_end int NOT NULL
)
go
IF OBJECT_ID('dbo.spt_mda') IS NOT NULL
BEGIN
CREATE UNIQUE NONCLUSTERED INDEX spt_mda_ind
ON spt_mda (mdinfo, mdaver_end, srvver_end)
END
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_mda') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_mda TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_mda */
/* Start of description of table dbo.spt_monitor */
setuser 'dbo'
go
CREATE TABLE dbo.spt_monitor (
lastrun datetime NOT NULL,
cpu_busy int NOT NULL,
io_busy int NOT NULL,
idle int NOT NULL,
pack_received int NOT NULL,
pack_sent int NOT NULL,
connections int NOT NULL,
pack_errors int NOT NULL,
total_read int NOT NULL,
total_write int NOT NULL,
total_errors int NOT NULL
)
ON system
go
/* Add permissions for table... */
IF OBJECT_ID('dbo.spt_monitor') IS NOT NULL
BEGIN
GRANT SELECT ON dbo.spt_monitor TO public
END
go
/* Bind rules & defaults to columns... */
/* End of description of table dbo.spt_monitor */
/* Start of description of table dbo.syblicenseslog */
setuser 'dbo'
go
CREATE TABLE dbo.syblicenseslog (
status smallint NOT NULL,
logdate datetime NOT NULL,
maxlicenses int NOT NULL
)
go
/* Add permissions for table... */
/* Bind rules & defaults to columns... */
/* End of description of table dbo.syblicenseslog */
/* Now create the key definitions ...*/
setuser 'dbo'
go
/* Views... */
/* No views found. */
/* Procedures... */
/* Procedure sp_configure, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/configure */
/*
** Messages for "sp_configure" 17410
** Must use "langid" when referencing spt_values
**
** 17260, "Can't run %1! from within a transaction."
** 17410, "Configuration option doesn't exist."
** 17411, "Configuration option is not unique."
** 17413, "The value of the 'number of devices' must be greater than the highest VDEVNO, '%1!', defined in sysdevices."
** 17414, "You can't set the default language to a language ID that is not defined in Syslanguages."
** 17415, "Configuration option value is not legal."
** 17418, "'%1!' is an invalid file command. The valid commands are 'verify', 'read', 'write', and 'restore'."
** 17419, "Configuration option changed. The SQL Server need not be rebooted since the option is dynamic.
** 18123, "Configuration option changed. The SQL Server must be rebooted before the change in effect since the option is static."
** 18124, "No matching configuration options. Here is a listing of groups:"
** 18125, "Must provide the parameter 'filename'."
** 18133, "The character set, '%1!', is invalid since it is not defined in Syscharsets."
** 18134, "The sortorder, '%1!', is invalid since it is not defined in Syscharsets."
** 18549, "Invalid third argument supplied: '%1!'. Valid choices are
** 'with truncate' or 'default'."
*/
create procedure sp_configure
@configname varchar(80) = NULL, /* configure option name */
@configvalue int = NULL, /* configure value */
@configvalue2 varchar(255) = NULL, /* config file command/charset info */
@configvalue3 varchar(255) = NULL /* physical name of file */
as
declare @confignum int /* number of option to be configured */
declare @configcount int /* number of options like @configname */
declare @whichone int /* using english or default lang ? */
declare @cmd smallint /* configuration file command */
declare @status int /* return status for misc calls */
declare @children int /* number of children in a group */
declare @parent int /* config number of parent group */
declare @msg varchar(255) /* temp buffer for messages */
declare @sysconfig smallint /* contents of sysconfigures.config */
declare @sysname varchar(255) /* contents of sysconfigures.comment */
declare @sysparent smallint /* contents of sysconfigures.parent */
declare @sysstatus smallint /* contents of sysconfigures.status */
declare @value int /* default charset/sort order id */
declare @user_displaylevel int /* user display level */
declare @maxvdevno int /* highest number of vdevno */
declare @sortorder_id int /* current sortorder id */
declare @charset_id int /* current charset id */
declare @use_wildcard tinyint /* use wildcard to search option name or not */
declare @match_count int /* number of option found by name match */
declare @cache_part_temp int /* cache partition number */
declare @partition_number int /* cache partition number */
declare @cmpstate int /* Local NODE state in companionship */
declare @nocase tinyint /* case-sensitive sort order flag */
select @whichone = 0
select @status = 0
select @cmd = 1
select @value = NULL
select @user_displaylevel = NULL
select @sortorder_id =
value from master.dbo.syscurconfigs where config = 123
select @charset_id =
value from master.dbo.syscurconfigs where config = 131
select @use_wildcard = 1
/*
** Check if the default sort order is case-insensitive.
*/
if ("A" = "a")
select @nocase = 1
else
select @nocase = 0
/*
** Disallow running sp_configure within a transaction since it might make
** recovery impossible.
*/
if @@trancount > 0
begin
/*
** 17260, "Can't run %1! from within a transaction."
*/
raiserror 17260, "sp_configure"
return (1)
end
else
begin
set chained off
end
set transaction isolation level 1
set nocount on
/*
** If the "default sortorder" is case insensitive dictionary sort order,
** the procedure will just print out all the options and their values
** without grouping if no option name is given.
*/
if (@nocase = 1 and @configname is NULL)
begin
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue)))+
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), b.comment)))+
convert(varchar(11), b.comment)),
"Config Value" =convert(char(11), space(11-char_length(
isnull(a.value2, convert(char(32), a.value)))) +
isnull(a.value2, convert(char(32), a.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value)))
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
a.config *= b.config
and parent != 19
and a.config != 19
order by name
return (0)
end
/* Validate the configname if it not NULL */
if @configname is not NULL
begin
select @configcount = count(*)
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and parent != 19
/*
** If configure option is not unique and case-insensitive
** dictionary sort order is used, check if unique option found
** by exact name match, if so, then disable wildcard match
** for searching option name.
*/
if (@configcount > 1 and @nocase = 1)
begin
/* check if unique option found by exact name match */
select @match_count = count(*)
from master.dbo.sysconfigures
where name = @configname
and parent != 19
if @match_count =1
begin
select @use_wildcard = 0 /* don't use wildcard */
select @configcount = @match_count
end
end
/*
** If more than one option like @configname,
** show the duplicates and return.
*/
if @configcount > 1
begin
/*
** 17411, "Configuration option is not unique."
*/
raiserror 17411
print ""
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue)))+
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), b.comment)))+
convert(varchar(11), b.comment)),
"Config Value" =convert(char(11), space(11-char_length(
isnull(a.value2, convert(char(32), a.value)))) +
isnull(a.value2, convert(char(32), a.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value)))
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
a.config *= b.config
and name like "%" + @configname + "%"
and parent != 19
and a.config != 19
order by name
return (1)
end
/*
** if it is a valid option and the @configvalue is not NULL,
** set the option
*/
if (@configcount != 0) and (@configvalue is not NULL)
begin
/* set @confignum */
select @confignum = config,
@sysstatus = status
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and parent != 19
and config != 19
/*
** If @configvalue2 is "default",
** setting the value to default
*/
if (@configvalue2 = "default")
select @value = 1
else
select @value = 0
/*
** If the option name is "configuration file"
*/
if @confignum = 114
begin
/*
** if the file command is one of the valid
** commands.
*/
if ((@configvalue2 = "read") or
(@configvalue2 = "write") or
(@configvalue2 = "restore") or
(@configvalue2 = "verify"))
begin
/*
** if filename is NULL
*/
if (@configvalue3 is NULL)
begin
/* 18125, "Must provide the parameter 'filename'." */
raiserror 18125
return(1)
end
/*
** Must have sa_role to run these
** commands
*/
if (proc_role("sa_role") < 1)
begin
return(1)
end
else
begin
if (@configvalue2 = "verify")
select @cmd = 2
else
if (@configvalue2 = "read")
select @cmd = 3
else
if (@configvalue2 = "write")
select @cmd = 4
else
if (@configvalue2 = "restore")
select @cmd = 5
end
end
else
begin
/*
** print the message to show the valid
** file command
*/
raiserror 17418, @configvalue2
return(1)
end
select @status = config_admin(@cmd,0,0,0,NULL,
@configvalue3)
if (@status = 1)
begin
return(0)
end
else
begin
return (1)
end
end
if @confignum = 123
begin
/* get current default charset id */
select @value = value from
master.dbo.sysconfigures
where config = 131
if @configvalue2 is not NULL
begin
/* validate the charset id */
if not exists (select *
from master..syscharsets
where name = @configvalue2
and type between 1000 and 1999)
begin
/* 18133, "The character set, '%1!', is invalid since it
** is not defined in Syscharsets."
*/
raiserror 18133, @configvalue2
return (1)
end
/* get default charset id from name */
select @value = id
from master..syscharsets
where name = @configvalue2
and type between 1000 and 1999
end
end
if @confignum = 131
begin
/* get current default sortord id */
select @value = value from
master.dbo.sysconfigures
where config = 123
if @configvalue2 is not NULL
begin
/* validate the sortord id */
if not exists (select *
from master..syscharsets
where name = @configvalue2
and type between 2000 and 2999)
begin
/* 18134, "The sortorder, '%1!', is invalid since it
** is not defined in Syscharsets."
*/
raiserror 18134, @configvalue2
return (1)
end
/* get default sortorder id from name */
select @value = id
from master..syscharsets
where name = @configvalue2
and type between 2000 and 2999
end
end
/*
** If an attempt to enable a disk mirroring is made, and
** if this happens to be a server with HA services turned
** on, we disallow. Currently we do not support ASE HA
** services along with sybase mirroring.
*/
if (@confignum = 140 and @configvalue = 0)
begin
select @cmpstate = @@cmpstate
if @cmpstate >= 0
begin
/* 18816 Mirroring not allowed in ASE HA */
raiserror 18816
return(1)
end
end
/*
** If an attempt to disable disk mirroring is being made,
** ensure that there are no devices that are currently
** being mirrored.
*/
if (@confignum = 140 and @configvalue = 1)
begin
if (select count(*) from master.dbo.sysdevices
where status & 512 = 512) > 0
begin
/* 18750, Unable to disable disk mirroring
** because some devices are currently
** mirrored. Use 'disk unmirror' to
** unmirror these devices and then
** re-run this sp_configure command.
*/
raiserror 18570
return (1)
end
end
/*
** If this is the number of devices configuration
** parameter, we want to make sure that it's not being
** set to lower than the
** number of devices in sysdevices.
*/
if @confignum = 116
begin
/*
** Get the default value if trying to set the
** value to the default value
*/
if (@value = 1)
begin
select @configvalue = convert(int, defvalue)
from master.dbo.syscurconfigs
where config = 116
end
/*
** Get the max vdevno.
*/
select @maxvdevno = max(
convert(tinyint,
substring(convert(binary(4), d.low),
v.low, 1)))
from master.dbo.sysdevices d,
master.dbo.spt_values v
if (@configvalue <= @maxvdevno)
begin
/* 17413, "The value of the 'number of devices' must be
** greater than the highest VDEVNO, '%1!', defined
** in sysdevices."
*/
raiserror 17413, @maxvdevno
return (1)
end
end
/*
** If this is the number of default language, we want
** to make sure that the new value is a valid language
** id in Syslanguages.
*/
if @confignum = 124
begin
if not exists (select *
from master.dbo.syslanguages
where langid = @configvalue)
begin
/* 0 is default language, us_english */
if @configvalue != 0
begin
/* 17414, "You can't set the default language to a
** language ID that is not defined in Syslanguages."
*/
raiserror 17414
return (1)
end
end
end
/*
** If this is the number of current audit table we want
** to make sure that if "with truncate" opiton is not
** provided new table is empty other wise fail.
*/
if @confignum = 260
begin
if @configvalue2 is not NULL
begin
if (@configvalue2 not in ("with truncate",
"default"))
begin
/*
** 18549, "Invalid third argument
** supplied: '%1!'. Valid
** choices are 'with truncate'
** or 'default'."
*/
raiserror 18549, @configvalue2
return(1)
end
end
else
begin
select @value = 2
end
end
if @confignum = 337
begin
if @configvalue is not NULL
begin
if (@configvalue2 = "default")
begin
select @partition_number = 1
end
else
begin
select @partition_number =
@configvalue
end
if (@partition_number <= 0) OR
(@partition_number > 64)
begin
raiserror 18611
return(1)
end
select @cache_part_temp = 2
while @cache_part_temp < @partition_number
select @cache_part_temp =
@cache_part_temp * 2
if @partition_number != 1 AND
@cache_part_temp != @partition_number
begin
raiserror 18611
return(1)
end
end
end
/* call config_admin() to set the new value */
select @status = config_admin(@cmd, @confignum,
@configvalue, @value, NULL, @configvalue2)
/* if successful */
if (@status = 1)
begin
/* Display the new value */
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11),space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11),
space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where
b.config = @confignum and
b.config *= c.config
/*
** print reboot message if this option is not
** dynamic.
*/
select @sysstatus = @sysstatus & 8
if @sysstatus = 8
begin
exec sp_getmessage 17419, @msg output
print @msg
end
else
begin
exec sp_getmessage 18123, @msg output
print @msg
end
return(0)
end
else
return(1)
end
end
/*
** @configcount=0 implies @configname is not valid
** @configname=NULL implies displaying all the parameters except for
** the parameters with the config number equal to 19 or the parent equal
** to 19 since those parameters are displayed by sp_cacheconfig.
*/
if (@configcount =0)
begin
/* 18124, "No matching configuration options.
** Here is a listing of groups:"
*/
raiserror 18124
select convert(char(50), name)
from master.dbo.sysconfigures
where config < 100
and parent != 19
and config != 19
order by name
return(1)
end
else if (@configname is NULL)
select @configname = "Config"
/*
** retrieve the display level from sysattributes
*/
select @user_displaylevel = int_value from master.dbo.sysattributes where
class = 4 AND
attribute = 0 AND
object_type = 'L' AND
object = suser_id()
/*
** set the default display level to 10 if it is not defined in sysattributes
*/
if (@user_displaylevel = NULL)
select @user_displaylevel = 10
/*
** If @use_wildcard = 0 and the default sortorder is case-insensitive
** dictionary sort order, use exact match: name = @configname to get row,
** otherwise use wildcard match: name like "%" + @configname + "%".
*/
if (@use_wildcard = 0 and @nocase = 1)
begin
select @confignum = config,
@parent = config,
@sysname = name,
@sysstatus = status
from master.dbo.sysconfigures
where name = @configname
and config != 19
end
else
begin
select @confignum = config,
@parent = config,
@sysname = name,
@sysstatus = status
from master.dbo.sysconfigures
where name like "%" + @configname + "%"
and config != 19
end
select @children = count(*)
from master.dbo.sysconfigures
where parent = @confignum
if @children = 0
begin
/* @@nestlevel is problem area if a sproc calls sp_configure */
/* could pass in another param when recursing */
if @@nestlevel > 1
begin
/* reached a leaf, notify parent */
return(1)
end
else
begin
/* display the information of the config parameter */
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11), space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where
b.config *= c.config
and name like "%" + @configname + "%"
and b.config != 19
and parent != 19
end
end
else
begin
select @msg = "Group: " + @sysname
print ""
print @msg
print ""
/* this poor guy has kids, so recurse to leaves */
declare config_curs cursor for
select config, name, parent
from master.dbo.sysconfigures
where parent = @parent
order by name
open config_curs
fetch config_curs into @sysconfig, @sysname, @sysparent
while (@@sqlstatus = 0)
begin
execute @status = sp_configure @sysname
if (@status = 1)
begin
/*
** this guy has leaves as kids,
** so print out the leaves with
** display level <= @user_displaylevel
** Note: If a config parameter has more than one
** parent, the extra parents are stored in
** 'sysattribures'.
*/
create table #configure_temp (config int)
insert into #configure_temp
select a.config
from master.dbo.sysconfigures a,
master.dbo.syscurconfigs b
where
display_level <= @user_displaylevel
and parent = @parent
and a.config != 19
and a.config = b.config
union
select config
from master.dbo.syscurconfigs,
master.dbo.sysattributes
where
display_level <= @user_displaylevel
and class = 4
and attribute = 1
and object_type = 'CP'
and int_value = @parent
and object = config
and config != 19
if exists (select * from #configure_temp)
begin
select "Parameter Name" = convert(char(30), name),
"Default" = convert(char(11), space(11-char_length(
convert(varchar(11), defvalue))) +
convert(varchar(11), defvalue)),
"Memory Used" = convert(char(11), space(11-char_length(
convert(varchar(11), c.comment))) +
convert(varchar(11), c.comment)),
"Config Value" = convert(char(11),space(11-char_length(
isnull(b.value2, convert(char(32), b.value)))) +
isnull(b.value2, convert(char(32), b.value))),
"Run Value" = convert(char(11), space(11-char_length(
isnull(c.value2, convert(char(32), c.value)))) +
isnull(c.value2, convert(char(32), c.value)))
from master.dbo.sysconfigures b,
master.dbo.syscurconfigs c
where b.config in
(select config from #configure_temp)
and b.config = c.config
order by name
end
drop table #configure_temp
close config_curs
deallocate cursor config_curs
return(0)
end
else
begin
/*
** this lucky guy has grandkids, so, continue
*/
fetch config_curs into
@sysconfig, @sysname, @sysparent
end
end
close config_curs
deallocate cursor config_curs
return(0)
end
go
IF OBJECT_ID('dbo.sp_configure') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_configure TO public
END
go
/* Procedure sp_dboption, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/a_values */
/*
** Messages for "sp_dboption" 17420
** Use "langid" when looking at spt_values ???
**
** 17260, "Can't run %1! from within a transaction."
** 17420, "Settable database options."
** 17421, "No such database -- run sp_helpdb to list databases."
** 17422, "The 'master' database's options can not be changed."
** 17423, "Usage: sp_dboption [dbname, optname, {true | false}]"
** 17424, "Database option doesn't exist or can't be set by user."
** 17425, "Run sp_dboption with no parameters to see options."
** 17426, "Database option is not unique."
** 17428, "You must be in the 'master' database in order to change
** database options."
** 17429, "The database is currently in use -- 'read only' option
** disallowed."
** 17430, "Run the CHECKPOINT command in the database that was changed."
** 17431, "true"
** 17432, "false"
** 17433, "Database option '%1!' turned ON for database '%2!'."
** 17434, "Database option '%1!' turned OFF for database '%2!'."
** 17289, "Set your curwrite to the hurdle of current database."
** 17436, "The 'single user' option is not valid for the 'tempdb'
** database."
** 17439, "You cannot turn on ''%1!' for '%2!' because it is an HA server
** that has been configured with the proxy_db option."
*/
create procedure sp_dboption
@dbname varchar(30) = NULL, /* database name to change */
@optname varchar(20) = NULL, /* option name to turn on/off */
@optvalue varchar(10) = NULL /* true or false */
as
declare @dbid int /* dbid of the database */
declare @dbuid int /* id of the owner of the database */
declare @statvalue smallint, /* number of option */
@stattype char(2), /* status field flag */
@statopt smallint, /* option mask, part 1 */
@stat2opt smallint /* option mask, part 2 */
declare @optcount int /* number of options like @optname */
declare @success_msg varchar(255) /* success status message */
declare @msg varchar(250)
declare @sptlang int
declare @true varchar(10)
declare @false varchar(10)
declare @whichone int /* which language? */
declare @name varchar(30)
declare @optmsgnum int /* identify one msgnum to compare */
declare @msgcnt int /* count distinct dups */
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
select @sptlang = @@langid, @whichone = 0
if @@langid != 0
begin
if not exists (
select * from master.dbo.sysmessages where error
between 17050 and 17069
and langid = @@langid)
select @sptlang = 0
end
/*
** If no @dbname given, just list the possible dboptions.
** Only certain status bits may be set or cleared.
** settable not settable
** ------------------------------ --------------------------
** allow select into/bulkcopy (4) don't recover (32)
** read only (1024) not recovered (256)
** dbo use only (2048) dbname has changed (16384)
** single user (4096)
** truncate log on checkpoint (8)
** no checkpoint on recovery (16)
** allow null (8192)
** ddl in tran (512)
** ALL SETTABLE OPTIONS (15900)
** abort xact on log full (1, type='D2')
** no space accounting (2, type='D2')
** auto identity(4, type='D2')
** identity in nonunique index(8, type='D2')
** auto identity unique index(64, type='D2')
*/
/*
** Look for the "settable options" mask in spt_values
*/
select @statopt = number
from master.dbo.spt_values
where type = "D"
and name = "ALL SETTABLE OPTIONS"
select @stat2opt = number
from master.dbo.spt_values
where type = "D2"
and name = "ALL SETTABLE OPTIONS"
/*
** If we can't find the option masks, guess at them
*/
if @statopt is null
select @statopt = 4 | 8 | 16 | 512 | 1024 | 2048 | 4096 | 8192
if @stat2opt is null
select @stat2opt = 1 | 2 | 4 | 8 | 64
if @dbname is null
begin
/*
** 17420, "Settable database options."
*/
exec sp_getmessage 17420, @msg output
print @msg
if @sptlang = 0
select database_options = name
from master.dbo.spt_values
where ((type = "D"
and number & @statopt = number
and number & @statopt != @statopt)
or (type = "D2"
and number & @stat2opt = number
and number & @stat2opt != @stat2opt))
order by name
else
select database_options = name, convert(char(22), description)
from master.dbo.spt_values, master.dbo.sysmessages
where ((type = "D"
and number & @statopt = number
and number & @statopt != @statopt)
or (type = "D2"
and number & @stat2opt = number
and number & @stat2opt != @stat2opt))
and msgnum = error
and langid = @sptlang
order by name
return (0)
end
/*
** Verify the database name and get the @dbid and @dbuid
*/
select @dbid = dbid, @dbuid = suid
from master.dbo.sysdatabases
where name = @dbname
/*
** If @dbname not found, say so and list the databases.
*/
if @dbid is NULL
begin
/*
** 17421, "No such database -- run sp_helpdb to list databases."
*/
raiserror 17421
return (1)
end
/*
** Only the Database Owner (DBO) or
** Accounts with SA role can execute it.
** Call proc_role() with the required SA role.
*/
if ((suser_id() != @dbuid) and (proc_role("sa_role") < 1))
return(1)
/*
** You can not change any of the options in master. If the user tries to
** do so tell them they can't.
*/
if @dbid = 1
begin
/*
** 17422, "The 'master' database's options can not be changed."
*/
raiserror 17422
return (1)
end
/*
** Check remaining parameters.
*/
/* 17431, "true" */
exec sp_getmessage 17431, @true out
/* 17432, "false" */
exec sp_getmessage 17432, @false out
if @optname is NULL or lower(@optvalue) not in
("true", "false", @true, @false) or @optvalue is null
begin
/*
** 17423, "Usage: sp_dboption [dbname, optname, {true | false}]"
*/
raiserror 17423
return (1)
end
/*
** Use @optname and try to find the right option.
** If there isn't just one, print appropriate diagnostics and return.
*/
select @optcount = count(*)
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
/*
** If more than one option like @optname, make sure they are not the same
** option ("trunc" and "trunc.", for example)
*/
if @optcount > 1
begin
select @optmsgnum = msgnum
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
select @msgcnt = count(msgnum)
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum != @optmsgnum
/*
** msgcnt of 0 indicates we really have just 1 unique dboption,
** probably due to alternate spelling.
*/
if (@msgcnt = 0)
select @optcount = 1
end
/*
** If no option, and alternate language is set, use other language
*/
if @optcount = 0 and @sptlang != 0
begin
select @optcount = count(*)
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
select @whichone = 1
/*
** If more than one option like @optname, make sure they are not the same
** option ("trunc" and "trunc.", for example)
*/
if @optcount > 1
begin
select @optmsgnum = msgnum
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
select @msgcnt = count(msgnum)
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
and msgnum != @optmsgnum
/*
** msgcnt of 0 indicates we really have just 1 unique dboption,
** probably due to alternate spelling.
*/
if (@msgcnt = 0)
select @optcount = 1
end
end
/*
** If no option, show the user what the options are.
*/
if @optcount = 0
begin
/*
** 17424, "Database option doesn't exist or can't be set by user."
*/
raiserror 17424
/*
** 17425, "Run sp_dboption with no parameters to see options."
*/
exec sp_getmessage 17425, @msg output
print @msg
return (1)
end
/*
** If more than one option like @optname, show the duplicates and return.
*/
if @optcount > 1
begin
/*
** 17426, "Database option is not unique."
*/
raiserror 17426
if @sptlang = 0
select duplicate_options = name
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
else
select duplicate_options = name, convert(char(22), description)
from master.dbo.spt_values, master.dbo.sysmessages
where (name like "%" + @optname + "%"
or description like "%" + @optname + "%")
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
return (1)
end
if db_name() != "master"
begin
/*
** 17428, "You must be in the 'master' database in order to change database options."
*/
raiserror 17428
return (1)
end
/*
** User cannot set "tempdb" database in single user mode.
*/
select @statvalue = number
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
if (@dbid = 2) and (@statvalue = 4096)
begin
/*
** 17436, "The 'single user' option is not valid for the 'tempdb'
** database."
*/
raiserror 17436
return (1)
end
/*
** If we're in a transaction, disallow this since it might make recovery
** impossible.
*/
if @@trancount > 0
begin
/*
** 17260, "Can't run %1! from within a transaction."
*/
raiserror 17260, "sp_dboption"
return (1)
end
else
begin
set chained off
end
set transaction isolation level 1
/*
** Get the number which is the bit value to set
*/
if @whichone = 0
select @statvalue = number, @stattype = type, @success_msg = name
from master.dbo.spt_values
where name like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
else
select @statvalue = number, @stattype = type, @success_msg = name
from master.dbo.spt_values, master.dbo.sysmessages
where description like "%" + @optname + "%"
and ((type = "D"
and number & @statopt = number)
or (type = "D2"
and number & @stat2opt = number))
and msgnum = error
and langid = @sptlang
/*
** We do not allow 'sybsecurity' to be set to 'single user' since,
** if auditing is enabled and we try to set 'sybsecurity' database to
** 'single user' then, the audit process is killed because audit process
** tries to do 'usedb' and it fails (look at utils/auditing.c).
*/
if (@dbname = "sybsecurity") and (@statvalue = 4096)
begin
/*
** 17435, "The 'single user' option is not valid for the
** 'sybsecurity' database.
*/
raiserror 17435
return (1)
end
/*
** Now update sysdatabases.
*/
if lower(@optvalue) in ("true", @true)
begin
/*
** If this the option to make the database read only,
** we need to do some checking first.
** Unless it's the master db, no one can be using it.
** If it's the master db, only the SA may be using it.
*/
if (@statvalue = 1024) and (select count(*)
from master.dbo.sysprocesses
where dbid = @dbid) > 0
begin
/*
** 17429, "The database is currently in use -- 'read only' option disallowed."
*/
raiserror 17429
return (1)
end
/*
** If this is the option to set 'abort tran on log full' to
** true for sybsecurit database, then don't allow.
*/
if (db_name(@dbid) = "sybsecurity"
and @stattype = "D2" and @statvalue = 1)
begin
/*
** AUDIT_CHANGE: New error message needs to be reserved and
** the print statement needs to be removed.
*/
print "You cannot set 'abort tran on log full' to true for sybsecurity database."
return (1)
end
/*
** Disallow DDL IN TRAN
** if proxydb option is set (@@crthaproxy = 1)
** if this server is a HA server (@@cmpstate >= 0)
*/
if ((@statvalue = 512) and (@@crthaproxy = 1) and (@@cmpstate >= 0))
begin
/*
** Cannot set DDL_IN_TRAN option for HA servers
** configured with proxy_db option.
*/
select @name = db_name(@dbid)
exec sp_getmessage 17439, @msg output
print @msg, @success_msg, @name
return (1)
end
if (@stattype = "D")
update master.dbo.sysdatabases
set status = status | @statvalue
where dbid = @dbid
else
update master.dbo.sysdatabases
set status2 = status2 | @statvalue
where dbid = @dbid
/*
** 17433, "Database option %1! turned ON for database %2!."
*/
exec sp_getmessage 17433, @msg output
select @name = db_name(@dbid)
print @msg, @success_msg, @name
end
/*
** We want to turn it off.
*/
else
begin
if (@stattype = "D")
update master.dbo.sysdatabases
set status = status & ~@statvalue
where dbid = @dbid
else
update master.dbo.sysdatabases
set status2 = status2 & ~@statvalue
where dbid = @dbid
/*
** 17434, "Database option %1! turned OFF for database %2!."
*/
exec sp_getmessage 17434, @msg output
select @name = db_name(@dbid)
print @msg, @success_msg, @name
end
/*
** Advise the user to run the CHECKPOINT command in the database that
** was changed.
*/
/*
** 17430, "Run the CHECKPOINT command in the database that was changed."
*/
exec sp_getmessage 17430, @msg output
print @msg
return (0)
go
IF OBJECT_ID('dbo.sp_dboption') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_dboption TO public
END
go
/* Procedure sp_dbupgrade, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
create procedure sp_dbupgrade
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/*
** Do the sysindexes column names update which is part of the 38 upgrade.
** The sysgams updates have already been taken care of by pg_gamalloc.
*/
print "Upgrading Sysindexes columns in the database"
if not exists (select name from syscolumns where id = 2 and name = 'doampg')
begin
update syscolumns
set name = 'doampg'
where id = 2 and name = 'dpages'
update syscolumns
set name = 'ioampg'
where id = 2 and name = 'reserved'
update syscolumns
set name = 'spare1'
where id = 2 and name = 'used'
update syscolumns
set name = 'spare2'
where id = 2 and name = 'rows'
end
/* The following updates are part of the 42 upgrade. */
/*
** Tweak the Syscolumns entries for the Sysindexes table so that
** "soid" and "csid" replace half of "usagecnt".
*/
if not exists (select * from syscolumns where id = 2 and name = 'soid')
begin
begin transaction
update syscolumns
set type = 52, length = 2, usertype = 6, offset = 42
where id = 2 and colid = 13
insert into syscolumns
(id, number, colid, status, type, length, offset,
usertype, cdefault, domain, name, printfmt)
values (2, 0, 23, 0, 48, 1, 40, 5, 0, 0, 'soid', '')
insert into syscolumns
(id, number, colid, status, type, length, offset,
usertype, cdefault, domain, name, printfmt)
values (2, 0, 24, 0, 48, 1, 41, 5, 0, 0, 'csid', '')
commit transaction
end
print "Adding new datatypes to the database."
if exists (select * from systypes where name = 'text')
begin
delete systypes where name = 'text'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 19, 0, 1, 35, 16, 0, 0, 'text', null)
if exists (select * from systypes where name = 'image')
begin
delete systypes where name = 'image'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 20, 0, 1, 34, 16, 0, 0, 'image', null)
if exists (select * from systypes where name = 'timestamp')
begin
delete systypes where name = 'timestamp'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 80, 0, 1, 37, 8, 0, 0, 'timestamp', null)
if exists (select * from systypes where name = 'smallmoney')
begin
delete systypes where name = 'smallmoney'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 21, 0, 1, 122, 4, 0, 0, 'smallmoney', null)
if exists (select * from systypes where name = 'smalldatetime')
begin
delete systypes where name = 'smalldatetime'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 22, 0, 1, 58, 4, 0, 0, 'smalldatetime', null)
if exists (select * from systypes where name = 'real')
begin
delete systypes where name = 'real'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 23, 0, 1, 59, 4, 0, 0, 'real', null)
/* 4.9 user types for national character */
if exists (select * from systypes where name = 'nchar')
begin
delete systypes where name = 'nchar'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt )
values (1, 24, 0, 1, 47, 255, 0, 0, 'nchar', null)
if exists (select * from systypes where name = 'nvarchar')
begin
delete systypes where name = 'nvarchar'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 25, 1, 1, 39, 255, 0, 0, 'nvarchar', null)
if exists (select * from systypes where name = 'NULL')
begin
delete systypes where name = 'NULL'
end
insert systypes (uid, usertype, variable, allownulls, type, length,
tdefault, domain, name, printfmt)
values (1, 0, 0, 1, 0, 0, 0, 0, 'NULL', null)
/* 4.9 system table creation */
print "Creating system catalog: sysusermessages and its indexes."
if not exists (select * from sysobjects where name='sysusermessages')
begin
execute sp_configure 'allow updates', 1
reconfigure with override
dbcc traceon(3701)
begin
create table sysusermessages(error int,uid smallint,
description varchar(255), langid smallint null) lock allpages
create clustered index csysusermessages
on sysusermessages (error)
create unique nonclustered index ncsysusermessages
on sysusermessages (error, langid)
end
dbcc traceoff(3701)
execute sp_configure 'allow updates', 0
reconfigure with override
end
print "Shutting down SQL Server"
shutdown
return (0)
go
/* Procedure sp_getmessage, owner dbo */
setuser 'dbo'
go
/* generic/sproc/getmessage 14.2 4/25/91 */
/* Messages from sysmessages
** 17200, "Message number must be greater than or equal to 17000."
** 17201, "'%1!' is not an official language name from Syslanguages."
** 17202, "Message number %1! does not exist in the %2! language."
*/
create procedure sp_getmessage
@message_num int,
@result varchar(255) output,
@language varchar(30) = NULL
as
declare @lang_id smallint
declare @msg varchar(255)
declare @returncode smallint
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/*
** Use default language if none specified,
** and initialize result
*/
select @lang_id = @@langid, @result = NULL
/* Only retrieve external errors */
if @message_num < 17000
BEGIN
/* 17200 "Message number must be greater than or equal to 17000." */
select @msg = description from master.dbo.sysmessages
where error = 17200
print @msg
return (1)
END
/*
** Check that language is valid.
*/
if @language is not NULL
BEGIN
execute @returncode = sp_validlang @language
if @returncode != 0
begin
/* Us_english is always valid */
if @language != "us_english"
BEGIN
/*
** 17201, "'%1!' is not an official language
** name from Syslanguages."
*/
select @msg = description from master.dbo.sysmessages
where error = 17201
and langid = @@langid
/* Get english if the current language is missing */
if @msg is null
select @msg = description from master.dbo.sysmessages
where error = 17201
and langid is NULL
print @msg, @language
return @returncode
END
/* set to us_english */
select @lang_id = NULL
end
else
select @lang_id = langid from master.dbo.syslanguages
where @language = name
END
/* The langid is assigned 0 since it gets its value from @@langid. */
/* For us_english, we have to insert it as NULL and not 0, this is */
/* to maintain compatibility with the current conventions */
if @lang_id = 0
begin
select @lang_id = NULL
end
/* Get message from the proper place */
/* System messages */
if @message_num < 20000
BEGIN
select @result = description from master.dbo.sysmessages
where langid = @lang_id
and error = @message_num
/* Get english if the current language is missing */
if @result is null
select @result = description from master.dbo.sysmessages
where error = @message_num
and (langid is NULL or langid =0)
END
else
/* User messages */
BEGIN
/* There is no proper alternate language for user messages */
select @result = description from sysusermessages
where langid = @lang_id
and error = @message_num
/* this is in here for compatibility with older revs which */
/* by mistake used to add langid as 0 in sysusermessages */
if @result is null and @lang_id is NULL
select @result = description from sysusermessages
where (langid = 0 or langid is NULL)
and error = @message_num
END
/* Warn the user if the message can't be found */
if @result is null
begin
/* 17202, "Message number %1! does not exist in the %2! language." */
select @msg = description from master.dbo.sysmessages
where error = 17202
and langid = @@langid
if @language is null
select @language = @@language
if @msg is null
select @msg = "Message number %1! does not exist in the %2! language."
print @msg, @message_num, @language
return (1)
end
return (0)
go
IF OBJECT_ID('dbo.sp_getmessage') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_getmessage TO public
END
go
/* Procedure sp_loaddbupgrade, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
create procedure sp_loaddbupgrade
@databasename varchar(30),
@devname varchar(30)
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
dbcc traceon(3402)
/* The recovery which is part of load database will perform the upgrade */
load database @databasename from @devname
dbcc traceoff(3402)
return (0)
go
/* Procedure sp_procxmode, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
/*
** 17756, "The execution of the stored procedure '%1!' in database
** '%2!' was aborted because there was an error in writing the
** replication log record."
*/
create procedure sp_procxmode
@procname varchar(255) = null,
@tranmode varchar(30) = null
as
declare @uid smallint
declare @oid int
declare @msg varchar(250) /* message text */
declare @dbname varchar(30)
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/* If either parameter is null we will be joining with a temporary table
** to convert transaction mode numbers (0, 1, 2) to strings ("Unchained",
** "Chained", "Any Mode").
*/
if ((@procname is null) or (@tranmode is null))
begin
create table #tranmode (intval integer, charval varchar(15))
insert into #tranmode values(0, "Unchained")
insert into #tranmode values(1, "Chained")
insert into #tranmode values(2, "Any Mode")
end
/* If the first parameter is null, we're to report the transaction-modes
** of every stored procedure in the current database.
*/
if (@procname is null)
begin
select "procedure name" = o.name, "user name" = user_name(o.uid),
"transaction mode" = t.charval
from sysobjects o, #tranmode t
where ((o.type = "P") or (o.type = "XP")) and (t.intval = ((o.sysstat2 / 16) & 3))
order by o.name
return(0)
end
/* If only the second parameter is null, we're to report the
** transaction-mode of the specified stored procedure.
*/
if ((@procname is not null) and (@tranmode is null))
begin
if (not exists (select name from sysobjects
where ((type = "P") or (type = "XP")) and
(name = @procname)))
begin
/*
** Force an error message, since we haven't
** installed sp_getmessage yet.
*/
dbcc update_tmode(@procname, "Chained")
return (1)
end
select "procedure name" = o.name, "user name" = user_name(o.uid),
"transaction mode" = t.charval
from sysobjects o, #tranmode t
where ((o.type = "P") or (o.type = "XP")) and (@procname = o.name) and
(t.intval = ((o.sysstat2 / 16) & 3))
return(0)
end
/* If neither parameter is null, we're to set the transaction-mode
** of the specified procedure to the specified value.
*/
if ((@procname is not null) and (@tranmode is not null))
begin
/* Start the transaction to log the execution of this procedure.
**
** IMPORTANT: The name "rs_logexec is significant and is used by
** Replication Server
*/
begin transaction rs_logexec
/*
** Update transaction-mode in both sysobjects and DES.
*/
dbcc update_tmode(@procname, @tranmode)
/* If dbcc update_tmode returned an error, return
** an error now.
*/
if (@@error != 0)
begin
rollback transaction rs_logexec
return(1)
end
/*
** Write the log record to replicate this invocation
** of the stored procedure.
*/
if (logexec() != 1)
begin
/*
** 17756, "The execution of the stored procedure '%1!'
** in database '%2!' was aborted because there
** was an error in writing the replication log
** record."
*/
select @dbname = db_name()
raiserror 17756, "sp_procxmode", @dbname
rollback transaction rs_logexec
return(1)
end
commit transaction
end
go
IF OBJECT_ID('dbo.sp_procxmode') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_procxmode TO public
END
go
/* Procedure sp_prtsybsysmsgs, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/%M% %I% %G%" */
/*
** This procedure is needed to extract messages for the batch that creates
** the sybsystemprocs database. When return parameters are used in an execute
** statement that is a part of a SQL batch, the return values are printed
** with a heading before subsequent statements in the batch are executed.
** These headings could be confusing to a user that is looking at the results
** of the batch. Hence we print the message in a stored procedure
*/
create procedure sp_prtsybsysmsgs
@i int, @size int = NULL, @size2 int = NULL
as
declare @msg varchar(250)
exec sp_getmessage @i, @msg out
print @msg, @size, @size2
go
/* Procedure sp_validlang, owner dbo */
setuser 'dbo'
go
/* Sccsid = "%Z% generic/sproc/src/%M% %I% %G%" */
/* 4.8 1.1 06/14/90 sproc/src/serveroption */
create procedure sp_validlang
@name varchar(30)
as
if @@trancount = 0
begin
set chained off
end
set transaction isolation level 1
/* Check to see if this language is in Syslanguages. */
if exists (select *
from master.dbo.syslanguages
where name = @name)
begin
return 0
end
return 1
go
IF OBJECT_ID('dbo.sp_validlang') IS NOT NULL
BEGIN
GRANT EXECUTE ON dbo.sp_validlang TO public
END
go
/* Triggers... */
/* No triggers found. */
/** New testing for views and procedures **/
--
-- View: vs_xdp_data
--
CREATE VIEW vs_xdp_data
AS SELECT
d.id AS device_id,
x.discoveryProtocol AS discovery_protocol,
dbo.inet_ntoa( remoteIpAddr ) AS remote_ip_address,
x.remoteSysDescr AS remote_sys_descr,
x.remoteSysName AS remote_sys_name,
x.remoteInterfaceName AS remote_interface_name,
x.remotePlatform AS remote_platform,
x.localInterfaceName AS local_interface_name,
x.class_name AS category,
e.dateSeen AS date_seen,
m.user_id AS user_access
FROM
xdp_cache x,
discovery_event e,
device d,
asset ast,
M_ACCESS_CONTROL m
WHERE
x.discoveryEvent_id = e.id AND
e.adminIpAddr = d.ipaddr AND
ast.foreign_asset_id2 = d.device_id AND
ast.acl_id = m.acl_id
GO
--
-- Procedure: Tx_B_Get_Vlan
--
create procedure Tx_B_Get_Vlan
(
@Device_Id bigint,
@User_Access int,
@Managed_Element_Id bigint
)
AS
Begin
SELECT VlanName, VlanNumber, VlanStatus
from nim_vlan V
JOIN Device D on V.fk_device = D.Id
JOIN Asset A on A.foreign_asset_id2 = D.device_id
JOIN M_Access_Control MA on MA.acl_id = A.Acl_id
where D.Id = @Device_Id and V.fk_managed_element = @Managed_Element_Id and MA.User_Id = @User_Access
return 0
end
GO
--
-- Function: inet_ntoa
--
CREATE FUNCTION [dbo].inet_ntoa
(
@ipLong BIGINT
)
RETURNS CHAR(15)
AS
BEGIN
DECLARE
@octet1 BIGINT,
@octet2 BIGINT,
@octet3 BIGINT,
@octet4 BIGINT,
@rv CHAR(15)
SELECT
@octet1 = ( @ipLong / 16777216 ) & 255,
@octet2 = ( @ipLong / 65536 ) & 255,
@octet3 = ( @ipLong / 256 ) & 255,
@octet4 = @ipLong & 255
SELECT
@rv =
CONVERT( VARCHAR(5), @octet1 ) +
'.' +
CONVERT( VARCHAR(5), @octet2 ) +
'.' +
CONVERT( VARCHAR(5), @octet3 ) +
'.' +
CONVERT( VARCHAR(5), @octet4 )
return @rv
END
GO
SQL-Translator-0.11024/t/data/oracle/ 0000755 0001750 0001750 00000000000 13225114407 016403 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/oracle/schema_diff_c.yaml 0000644 0001750 0001750 00000002631 12163313615 022025 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
d_operator:
constraints:
- deferrable: 1
expression: ''
fields:
- id_operator
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
id_operator:
data_type: integer
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id_operator
order: 58
size:
- 0
name:
data_type: nvarchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: name
order: 59
size:
- 10
foo:
data_type: nvarchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: foo
order: 60
size:
- 10
other:
data_type: nvarchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: other
order: 61
size:
- 10
name: d_operator
order: 11
SQL-Translator-0.11024/t/data/oracle/schema_diff_a.yaml 0000644 0001750 0001750 00000002247 12163313615 022026 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
d_operator:
constraints:
- deferrable: 1
expression: ''
fields:
- id_operator
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
id_operator:
data_type: integer
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id_operator
order: 58
size:
- 0
name:
data_type: varchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: name
order: 59
size:
- 10
other:
data_type: varchar2
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: other
order: 60
size:
- 10
name: d_operator
order: 11
SQL-Translator-0.11024/t/data/oracle/create.sql 0000644 0001750 0001750 00000000525 12163313615 020373 0 ustar ilmari ilmari CREATE TABLE USER1.TABLE1
( FIELD_ID NUMBER(19,0) NOT NULL ENABLE,
OTHERFIELD NUMBER(19,0) NOT NULL ENABLE,
CONSTRAINT FK20072D375BA3E34A FOREIGN KEY (OTHERFIELD)
REFERENCES USER1.TABLE2 (ID) ON DELETE CASCADE ENABLE,
CONSTRAINT FK_FIELD_ID FOREIGN KEY (FIELD_ID)
REFERENCES USER1.TABLE3 (ID) ON DELETE CASCADE ENABLE
) ;
SQL-Translator-0.11024/t/data/oracle/create2.sql 0000644 0001750 0001750 00000000520 12163313615 020450 0 ustar ilmari ilmari CREATE TABLE USER1.TABLE1
( FIELD_ID NUMBER(19,0) NOT NULL ENABLE,
OTHERFIELD NUMBER(19,0) NOT NULL ENABLE,
CONSTRAINT FK_OTHERFIELD FOREIGN KEY (OTHERFIELD)
REFERENCES USER1.TABLE2 (ID) ON DELETE CASCADE ENABLE,
CONSTRAINT FK_FIELD_ID FOREIGN KEY (FIELD_ID)
REFERENCES USER1.TABLE3 (ID) ON DELETE CASCADE ENABLE
) ;
SQL-Translator-0.11024/t/data/oracle/schema_with_options.yaml 0000644 0001750 0001750 00000002167 12163313615 023345 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
d_operator:
constraints:
- deferrable: 1
expression: ''
fields:
- id_operator
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
id_operator:
data_type: integer
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id_operator
order: 58
size:
- 0
name:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: name
order: 59
size:
- 0
indices:
- fields:
- name
name: operator_name
options:
- TABLESPACE: INDX
type: NORMAL
name: d_operator
options:
- TABLESPACE: DATA
order: 11
SQL-Translator-0.11024/t/data/oracle/schema_diff_b.yaml 0000644 0001750 0001750 00000002251 12163313615 022022 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
d_operator:
constraints:
- deferrable: 1
expression: ''
fields:
- id_operator
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
id_operator:
data_type: integer
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: id_operator
order: 58
size:
- 0
name:
data_type: nvarchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: name
order: 59
size:
- 10
other:
data_type: nvarchar2
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: other
order: 60
size:
- 10
name: d_operator
order: 11
SQL-Translator-0.11024/t/data/mysql/ 0000755 0001750 0001750 00000000000 13225114407 016303 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/mysql/entire_syntax.sql 0000644 0001750 0001750 00000040035 12163313615 021724 0 ustar ilmari ilmari -- $Header: /home/faga/work/sqlfairy_svn/sqlfairy-cvsbackup/sqlfairy/t/data/mysql/entire_syntax.sql,v 1.2 2003-08-17 01:41:48 rossta Exp $
-- all data types
DROP TABLE IF EXISTS t01;
CREATE TABLE t01 (
i01 TINYINT,
i02 SMALLINT,
i03 MEDIUMINT,
i04 INT,
i05 INTEGER,
i06 BIGINT,
r01 REAL,
r02 DOUBLE,
r03 DOUBLE PRECISION,
r04 FLOAT,
n01 DECIMAL,
n02 NUMERIC,
c01 CHAR(10),
c02 VARCHAR(10),
c03 CHAR(10) BINARY,
c04 VARCHAR(10) BINARY,
-- c05 NATIONAL CHAR(10),
-- c06 NATIONAL VARCHAR(10),
-- c07 NATIONAL CHAR(10) BINARY,
-- c08 NATIONAL VARCHAR(10) BINARY,
d01 DATE,
d02 TIME,
d03 TIMESTAMP,
d04 DATETIME,
d05 YEAR,
b01 TINYBLOB,
b02 BLOB,
b03 MEDIUMBLOB,
b04 LONGBLOB,
t01 TINYTEXT,
t02 TEXT,
t03 MEDIUMTEXT,
t04 LONGTEXT,
e01 ENUM('value1','value2'),
-- s01 SET('value1','value2'), -- not supported
i11 TINYINT(1),
i12 SMALLINT(1),
i13 MEDIUMINT(1),
i14 INT(1),
i15 INTEGER(1),
i16 BIGINT(1),
r11 REAL(2,1),
r12 DOUBLE(2,1),
r13 DOUBLE PRECISION(2,1),
r14 FLOAT(1),
r15 FLOAT(2,1),
n11 DECIMAL(1),
n12 DECIMAL(2,1),
n13 NUMERIC(2),
n14 NUMERIC(2,1),
d11 TIMESTAMP(2),
d12 YEAR(2)
);
-- all data types, NOT NULL
DROP TABLE IF EXISTS t02;
CREATE TABLE t02 (
i01 TINYINT NOT NULL,
i02 SMALLINT NOT NULL,
i03 MEDIUMINT NOT NULL,
i04 INT NOT NULL,
i05 INTEGER NOT NULL,
i06 BIGINT NOT NULL,
r01 REAL NOT NULL,
r02 DOUBLE NOT NULL,
r03 DOUBLE PRECISION NOT NULL,
r04 FLOAT NOT NULL,
n01 DECIMAL NOT NULL,
n02 NUMERIC NOT NULL,
c01 CHAR(10) NOT NULL,
c02 VARCHAR(10) NOT NULL,
c03 CHAR(10) BINARY NOT NULL,
c04 VARCHAR(10) BINARY NOT NULL,
-- c05 NATIONAL CHAR(10) NOT NULL,
-- c06 NATIONAL VARCHAR(10) NOT NULL,
-- c07 NATIONAL CHAR(10) BINARY NOT NULL,
-- c08 NATIONAL VARCHAR(10) BINARY NOT NULL,
d01 DATE NOT NULL,
d02 TIME NOT NULL,
d03 TIMESTAMP NOT NULL,
d04 DATETIME NOT NULL,
d05 YEAR NOT NULL,
b01 TINYBLOB NOT NULL,
b02 BLOB NOT NULL,
b03 MEDIUMBLOB NOT NULL,
b04 LONGBLOB NOT NULL,
t01 TINYTEXT NOT NULL,
t02 TEXT NOT NULL,
t03 MEDIUMTEXT NOT NULL,
t04 LONGTEXT NOT NULL,
e01 ENUM('value1','value2') NOT NULL,
-- s01 SET('value1','value2'), -- not supported
i11 TINYINT(1) NOT NULL,
i12 SMALLINT(1) NOT NULL,
i13 MEDIUMINT(1) NOT NULL,
i14 INT(1) NOT NULL,
i15 INTEGER(1) NOT NULL,
i16 BIGINT(1) NOT NULL,
r11 REAL(2,1) NOT NULL,
r12 DOUBLE(2,1) NOT NULL,
r13 DOUBLE PRECISION(2,1) NOT NULL,
r14 FLOAT(1) NOT NULL,
r15 FLOAT(2,1) NOT NULL,
n11 DECIMAL(1) NOT NULL,
n12 DECIMAL(2,1) NOT NULL,
n13 NUMERIC(2) NOT NULL,
n14 NUMERIC(2,1) NOT NULL,
d11 TIMESTAMP(2) NOT NULL,
d12 YEAR(2) NOT NULL
);
-- all data types, DEFAULT
DROP TABLE IF EXISTS t03;
CREATE TABLE t03 (
i01 TINYINT DEFAULT 0,
i02 SMALLINT DEFAULT 0,
i03 MEDIUMINT DEFAULT 0,
i04 INT DEFAULT 0,
i05 INTEGER DEFAULT 0,
i06 BIGINT DEFAULT 0,
r01 REAL DEFAULT 0,
r02 DOUBLE DEFAULT 0,
r03 DOUBLE PRECISION DEFAULT 0,
r04 FLOAT DEFAULT 0,
n01 DECIMAL DEFAULT 0,
n02 NUMERIC DEFAULT 0,
c01 CHAR(10) DEFAULT '',
c02 VARCHAR(10) DEFAULT '',
c03 CHAR(10) BINARY DEFAULT '',
c04 VARCHAR(10) BINARY DEFAULT '',
-- c05 NATIONAL CHAR(10) DEFAULT '',
-- c06 NATIONAL VARCHAR(10) DEFAULT '',
-- c07 NATIONAL CHAR(10) BINARY DEFAULT '',
-- c08 NATIONAL VARCHAR(10) BINARY DEFAULT '',
d01 DATE DEFAULT 0,
d02 TIME DEFAULT 0,
d03 TIMESTAMP DEFAULT 0,
d04 DATETIME DEFAULT 0,
d05 YEAR DEFAULT 0,
b01 TINYBLOB DEFAULT '',
b02 BLOB DEFAULT '',
b03 MEDIUMBLOB DEFAULT '',
b04 LONGBLOB DEFAULT '',
t01 TINYTEXT DEFAULT '',
t02 TEXT DEFAULT '',
t03 MEDIUMTEXT DEFAULT '',
t04 LONGTEXT DEFAULT '',
e01 ENUM('value1','value2') DEFAULT 'value1',
-- s01 SET('value1','value2'), -- not supported
i11 TINYINT(1) DEFAULT 0,
i12 SMALLINT(1) DEFAULT 0,
i13 MEDIUMINT(1) DEFAULT 0,
i14 INT(1) DEFAULT 0,
i15 INTEGER(1) DEFAULT 0,
i16 BIGINT(1) DEFAULT 0,
r11 REAL(2,1) DEFAULT 0,
r12 DOUBLE(2,1) DEFAULT 0,
r13 DOUBLE PRECISION(2,1) DEFAULT 0,
r14 FLOAT(1) DEFAULT 0,
r15 FLOAT(2,1) DEFAULT 0,
n11 DECIMAL(1) DEFAULT 0,
n12 DECIMAL(2,1) DEFAULT 0,
n13 NUMERIC(2) DEFAULT 0,
n14 NUMERIC(2,1) DEFAULT 0,
d11 TIMESTAMP(2) DEFAULT 0,
d12 YEAR(2) DEFAULT 0
);
-- all data types, NOT NULL DEFAULT
DROP TABLE IF EXISTS t04;
CREATE TABLE t04 (
i01 TINYINT NOT NULL DEFAULT 0,
i02 SMALLINT NOT NULL DEFAULT 0,
i03 MEDIUMINT NOT NULL DEFAULT 0,
i04 INT NOT NULL DEFAULT 0,
i05 INTEGER NOT NULL DEFAULT 0,
i06 BIGINT NOT NULL DEFAULT 0,
r01 REAL NOT NULL DEFAULT 0,
r02 DOUBLE NOT NULL DEFAULT 0,
r03 DOUBLE PRECISION NOT NULL DEFAULT 0,
r04 FLOAT NOT NULL DEFAULT 0,
n01 DECIMAL NOT NULL DEFAULT 0,
n02 NUMERIC NOT NULL DEFAULT 0,
c01 CHAR(10) NOT NULL DEFAULT '',
c02 VARCHAR(10) NOT NULL DEFAULT '',
c03 CHAR(10) BINARY NOT NULL DEFAULT '',
c04 VARCHAR(10) BINARY NOT NULL DEFAULT '',
-- c05 NATIONAL CHAR(10) NOT NULL DEFAULT '',
-- c06 NATIONAL VARCHAR(10) NOT NULL DEFAULT '',
-- c07 NATIONAL CHAR(10) BINARY NOT NULL DEFAULT '',
-- c08 NATIONAL VARCHAR(10) BINARY NOT NULL DEFAULT '',
d01 DATE NOT NULL DEFAULT 0,
d02 TIME NOT NULL DEFAULT 0,
d03 TIMESTAMP NOT NULL DEFAULT 0,
d04 DATETIME NOT NULL DEFAULT 0,
d05 YEAR NOT NULL DEFAULT 0,
b01 TINYBLOB NOT NULL DEFAULT '',
b02 BLOB NOT NULL DEFAULT '',
b03 MEDIUMBLOB NOT NULL DEFAULT '',
b04 LONGBLOB NOT NULL DEFAULT '',
t01 TINYTEXT NOT NULL DEFAULT '',
t02 TEXT NOT NULL DEFAULT '',
t03 MEDIUMTEXT NOT NULL DEFAULT '',
t04 LONGTEXT NOT NULL DEFAULT '',
e01 ENUM('value1','value2') NOT NULL DEFAULT 'value1',
-- s01 SET('value1','value2'), -- not supported
i11 TINYINT(1) NOT NULL DEFAULT 0,
i12 SMALLINT(1) NOT NULL DEFAULT 0,
i13 MEDIUMINT(1) NOT NULL DEFAULT 0,
i14 INT(1) NOT NULL DEFAULT 0,
i15 INTEGER(1) NOT NULL DEFAULT 0,
i16 BIGINT(1) NOT NULL DEFAULT 0,
r11 REAL(2,1) NOT NULL DEFAULT 0,
r12 DOUBLE(2,1) NOT NULL DEFAULT 0,
r13 DOUBLE PRECISION(2,1) NOT NULL DEFAULT 0,
r14 FLOAT(1) NOT NULL DEFAULT 0,
r15 FLOAT(2,1) NOT NULL DEFAULT 0,
n11 DECIMAL(1) NOT NULL DEFAULT 0,
n12 DECIMAL(2,1) NOT NULL DEFAULT 0,
n13 NUMERIC(2) NOT NULL DEFAULT 0,
n14 NUMERIC(2,1) NOT NULL DEFAULT 0,
d11 TIMESTAMP(2) NOT NULL DEFAULT 0,
d12 YEAR(2) NOT NULL DEFAULT 0
);
-- /*
-- /*-- all data types, NULL
-- /*DROP TABLE IF EXISTS t05;
-- /*CREATE TABLE t05 (
-- /* i01 TINYINT NULL,
-- /* i02 SMALLINT NULL,
-- /* i03 MEDIUMINT NULL,
-- /* i04 INT NULL,
-- /* i05 INTEGER NULL,
-- /* i06 BIGINT NULL,
-- /* r01 REAL NULL,
-- /* r02 DOUBLE NULL,
-- /* r03 DOUBLE PRECISION NULL,
-- /* r04 FLOAT NULL,
-- /* n01 DECIMAL NULL,
-- /* n02 NUMERIC NULL,
-- /* c01 CHAR(10) NULL,
-- /* c02 VARCHAR(10) NULL,
-- /* c03 CHAR(10) BINARY NULL,
-- /* c04 VARCHAR(10) BINARY NULL,
-- /*-- c05 NATIONAL CHAR(10) NULL,
-- /*-- c06 NATIONAL VARCHAR(10) NULL,
-- /*-- c07 NATIONAL CHAR(10) BINARY NULL,
-- /*-- c08 NATIONAL VARCHAR(10) BINARY NULL,
-- /* d01 DATE NULL,
-- /* d02 TIME NULL,
-- /* d03 TIMESTAMP NULL,
-- /* d04 DATETIME NULL,
-- /* d05 YEAR NULL,
-- /* b01 TINYBLOB NULL,
-- /* b02 BLOB NULL,
-- /* b03 MEDIUMBLOB NULL,
-- /* b04 LONGBLOB NULL,
-- /* t01 TINYTEXT NULL,
-- /* t02 TEXT NULL,
-- /* t03 MEDIUMTEXT NULL,
-- /* t04 LONGTEXT NULL,
-- /*
-- /* e01 ENUM('value1','value2') NULL,
-- /*-- s01 SET('value1','value2'), -- supported
-- /*
-- /* i11 TINYINT(1) NULL,
-- /* i12 SMALLINT(1) NULL,
-- /* i13 MEDIUMINT(1) NULL,
-- /* i14 INT(1) NULL,
-- /* i15 INTEGER(1) NULL,
-- /* i16 BIGINT(1) NULL,
-- /* r11 REAL(2,1) NULL,
-- /* r12 DOUBLE(2,1) NULL,
-- /* r13 DOUBLE PRECISION(2,1) NULL,
-- /* r14 FLOAT(1) NULL,
-- /* r15 FLOAT(2,1) NULL,
-- /* n11 DECIMAL(1) NULL,
-- /* n12 DECIMAL(2,1) NULL,
-- /* n13 NUMERIC(2) NULL,
-- /* n14 NUMERIC(2,1) NULL,
-- /* d11 TIMESTAMP(2) NULL,
-- /* d12 YEAR(2) NULL
-- /*);
-- /*
-- /*-- all data types, NULL DEFAULT
-- /*DROP TABLE IF EXISTS t06;
-- /*CREATE TABLE t06 (
-- /* i01 TINYINT NULL DEFAULT 0,
-- /* i02 SMALLINT NULL DEFAULT 0,
-- /* i03 MEDIUMINT NULL DEFAULT 0,
-- /* i04 INT NULL DEFAULT 0,
-- /* i05 INTEGER NULL DEFAULT 0,
-- /* i06 BIGINT NULL DEFAULT 0,
-- /* r01 REAL NULL DEFAULT 0,
-- /* r02 DOUBLE NULL DEFAULT 0,
-- /* r03 DOUBLE PRECISION NULL DEFAULT 0,
-- /* r04 FLOAT NULL DEFAULT 0,
-- /* n01 DECIMAL NULL DEFAULT 0,
-- /* n02 NUMERIC NULL DEFAULT 0,
-- /* c01 CHAR(10) NULL DEFAULT '',
-- /* c02 VARCHAR(10) NULL DEFAULT '',
-- /* c03 CHAR(10) BINARY NULL DEFAULT '',
-- /* c04 VARCHAR(10) BINARY NULL DEFAULT '',
-- /*-- c05 NATIONAL CHAR(10) NULL DEFAULT '',
-- /*-- c06 NATIONAL VARCHAR(10) NULL DEFAULT '',
-- /*-- c07 NATIONAL CHAR(10) BINARY NULL DEFAULT '',
-- /*-- c08 NATIONAL VARCHAR(10) BINARY NULL DEFAULT '',
-- /* d01 DATE NULL DEFAULT 0,
-- /* d02 TIME NULL DEFAULT 0,
-- /* d03 TIMESTAMP NULL DEFAULT 0,
-- /* d04 DATETIME NULL DEFAULT 0,
-- /* d05 YEAR NULL DEFAULT 0,
-- /* b01 TINYBLOB NULL DEFAULT '',
-- /* b02 BLOB NULL DEFAULT '',
-- /* b03 MEDIUMBLOB NULL DEFAULT '',
-- /* b04 LONGBLOB NULL DEFAULT '',
-- /* t01 TINYTEXT NULL DEFAULT '',
-- /* t02 TEXT NULL DEFAULT '',
-- /* t03 MEDIUMTEXT NULL DEFAULT '',
-- /* t04 LONGTEXT NULL DEFAULT '',
-- /*
-- /* e01 ENUM('value1','value2') NULL DEFAULT 'value1',
-- /*-- s01 SET('value1','value2'), -- supported
-- /*
-- /* i11 TINYINT(1) NULL DEFAULT 0,
-- /* i12 SMALLINT(1) NULL DEFAULT 0,
-- /* i13 MEDIUMINT(1) NULL DEFAULT 0,
-- /* i14 INT(1) NULL DEFAULT 0,
-- /* i15 INTEGER(1) NULL DEFAULT 0,
-- /* i16 BIGINT(1) NULL DEFAULT 0,
-- /* r11 REAL(2,1) NULL DEFAULT 0,
-- /* r12 DOUBLE(2,1) NULL DEFAULT 0,
-- /* r13 DOUBLE PRECISION(2,1) NULL DEFAULT 0,
-- /* r14 FLOAT(1) NULL DEFAULT 0,
-- /* r15 FLOAT(2,1) NULL DEFAULT 0,
-- /* n11 DECIMAL(1) NULL DEFAULT 0,
-- /* n12 DECIMAL(2,1) NULL DEFAULT 0,
-- /* n13 NUMERIC(2) NULL DEFAULT 0,
-- /* n14 NUMERIC(2,1) NULL DEFAULT 0,
-- /* d11 TIMESTAMP(2) NULL DEFAULT 0,
-- /* d12 YEAR(2) NULL DEFAULT 0
-- /*);
-- /**/
-- all data types, UNSIGNED
DROP TABLE IF EXISTS t11;
CREATE TABLE t11 (
i01 TINYINT UNSIGNED NOT NULL DEFAULT 0,
i02 SMALLINT UNSIGNED NOT NULL DEFAULT 0,
i03 MEDIUMINT UNSIGNED NOT NULL DEFAULT 0,
i04 INT UNSIGNED NOT NULL DEFAULT 0,
i05 INTEGER UNSIGNED NOT NULL DEFAULT 0,
i06 BIGINT UNSIGNED NOT NULL DEFAULT 0,
r01 REAL UNSIGNED NOT NULL DEFAULT 0,
r02 DOUBLE UNSIGNED NOT NULL DEFAULT 0,
r03 DOUBLE PRECISION UNSIGNED NOT NULL DEFAULT 0,
r04 FLOAT UNSIGNED NOT NULL DEFAULT 0,
n01 DECIMAL UNSIGNED NOT NULL DEFAULT 0,
n02 NUMERIC UNSIGNED NOT NULL DEFAULT 0,
i11 TINYINT(1) UNSIGNED NOT NULL DEFAULT 0,
i12 SMALLINT(1) UNSIGNED NOT NULL DEFAULT 0,
i13 MEDIUMINT(1) UNSIGNED NOT NULL DEFAULT 0,
i14 INT(1) UNSIGNED NOT NULL DEFAULT 0,
i15 INTEGER(1) UNSIGNED NOT NULL DEFAULT 0,
i16 BIGINT(1) UNSIGNED NOT NULL DEFAULT 0,
r11 REAL(2,1) UNSIGNED NOT NULL DEFAULT 0,
r12 DOUBLE(2,1) UNSIGNED NOT NULL DEFAULT 0,
r13 DOUBLE PRECISION(2,1) UNSIGNED NOT NULL DEFAULT 0,
r14 FLOAT(1) UNSIGNED NOT NULL DEFAULT 0,
r15 FLOAT(2,1) UNSIGNED NOT NULL DEFAULT 0,
n11 DECIMAL(1) UNSIGNED NOT NULL DEFAULT 0,
n12 DECIMAL(2,1) UNSIGNED NOT NULL DEFAULT 0,
n13 NUMERIC(2) UNSIGNED NOT NULL DEFAULT 0,
n14 NUMERIC(2,1) UNSIGNED NOT NULL DEFAULT 0
);
-- all data types, ZEROFILL
DROP TABLE IF EXISTS t12;
CREATE TABLE t12 (
i01 TINYINT ZEROFILL NOT NULL DEFAULT 0,
i02 SMALLINT ZEROFILL NOT NULL DEFAULT 0,
i03 MEDIUMINT ZEROFILL NOT NULL DEFAULT 0,
i04 INT ZEROFILL NOT NULL DEFAULT 0,
i05 INTEGER ZEROFILL NOT NULL DEFAULT 0,
i06 BIGINT ZEROFILL NOT NULL DEFAULT 0,
r01 REAL ZEROFILL NOT NULL DEFAULT 0,
r02 DOUBLE ZEROFILL NOT NULL DEFAULT 0,
r03 DOUBLE PRECISION ZEROFILL NOT NULL DEFAULT 0,
r04 FLOAT ZEROFILL NOT NULL DEFAULT 0,
n01 DECIMAL ZEROFILL NOT NULL DEFAULT 0,
n02 NUMERIC ZEROFILL NOT NULL DEFAULT 0,
i11 TINYINT(1) ZEROFILL NOT NULL DEFAULT 0,
i12 SMALLINT(1) ZEROFILL NOT NULL DEFAULT 0,
i13 MEDIUMINT(1) ZEROFILL NOT NULL DEFAULT 0,
i14 INT(1) ZEROFILL NOT NULL DEFAULT 0,
i15 INTEGER(1) ZEROFILL NOT NULL DEFAULT 0,
i16 BIGINT(1) ZEROFILL NOT NULL DEFAULT 0,
r11 REAL(2,1) ZEROFILL NOT NULL DEFAULT 0,
r12 DOUBLE(2,1) ZEROFILL NOT NULL DEFAULT 0,
r13 DOUBLE PRECISION(2,1) ZEROFILL NOT NULL DEFAULT 0,
r14 FLOAT(1) ZEROFILL NOT NULL DEFAULT 0,
r15 FLOAT(2,1) ZEROFILL NOT NULL DEFAULT 0,
n11 DECIMAL(1) ZEROFILL NOT NULL DEFAULT 0,
n12 DECIMAL(2,1) ZEROFILL NOT NULL DEFAULT 0,
n13 NUMERIC(2,1) ZEROFILL NOT NULL DEFAULT 0,
n14 NUMERIC(2,1) ZEROFILL NOT NULL DEFAULT 0
);
-- all data types, UNSIGNED ZEROFILL
DROP TABLE IF EXISTS t13;
CREATE TABLE t13 (
i01 TINYINT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i02 SMALLINT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i03 MEDIUMINT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i04 INT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i05 INTEGER UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i06 BIGINT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r01 REAL UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r02 DOUBLE UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r03 DOUBLE PRECISION UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r04 FLOAT UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n01 DECIMAL UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n02 NUMERIC UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i11 TINYINT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i12 SMALLINT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i13 MEDIUMINT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i14 INT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i15 INTEGER(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
i16 BIGINT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r11 REAL(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r12 DOUBLE(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r13 DOUBLE PRECISION(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r14 FLOAT(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
r15 FLOAT(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n11 DECIMAL(1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n12 DECIMAL(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n13 NUMERIC(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0,
n14 NUMERIC(2,1) UNSIGNED ZEROFILL NOT NULL DEFAULT 0
);
-- all keys
DROP TABLE IF EXISTS t21;
CREATE TABLE t21 (
c01 CHAR(10) NOT NULL,
c02 VARCHAR(10) NOT NULL,
KEY k01 (c01),
KEY k02 (c01(1)),
INDEX k03 (c01),
INDEX k04 (c01(1)),
UNIQUE k05 (c01),
UNIQUE k06 (c01(1)),
UNIQUE INDEX k07 (c01),
UNIQUE INDEX k08 (c01(1)),
FULLTEXT k09 (c01),
FULLTEXT INDEX k10 (c01),
KEY k11 (c01, c02),
KEY k12 (c01(1), c02),
INDEX k13 (c01, c02),
INDEX k14 (c01(1), c02),
UNIQUE k15 (c01, c02),
UNIQUE k16 (c01(1), c02),
UNIQUE INDEX k17 (c01, c02),
UNIQUE INDEX k18 (c01(1), c02),
FULLTEXT k19 (c01, c02),
FULLTEXT INDEX k20 (c01, c02),
PRIMARY KEY (c01)
);
-- multi-field primary key
DROP TABLE IF EXISTS t22;
CREATE TABLE t22 (
c01 VARCHAR(10) NOT NULL,
c02 VARCHAR(10) NOT NULL,
PRIMARY KEY (c01, c02)
);
-- multi-field primary key with length
DROP TABLE IF EXISTS t23;
CREATE TABLE t23 (
c01 VARCHAR(255) NOT NULL,
c02 VARCHAR(255) NOT NULL,
PRIMARY KEY (c01(10), c02(10))
);
-- primary key 2nd syntax
DROP TABLE IF EXISTS t24;
CREATE TABLE t24 (
c01 VARCHAR(255) NOT NULL PRIMARY KEY,
c02 VARCHAR(255) NOT NULL
);
-- all data types, AUTO_INCREMENT
DROP TABLE IF EXISTS k01;
CREATE TABLE k01 (
i01 TINYINT UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k02;
CREATE TABLE k02 (
i02 SMALLINT UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k03;
CREATE TABLE k03 (
i03 MEDIUMINT UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k04;
CREATE TABLE k04 (
i04 INT UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k05;
CREATE TABLE k05 (
i05 INTEGER UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k06;
CREATE TABLE k06 (
i06 BIGINT UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k11;
CREATE TABLE k11 (
i11 TINYINT(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k12;
CREATE TABLE k12 (
i12 SMALLINT(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k13;
CREATE TABLE k13 (
i13 MEDIUMINT(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k14;
CREATE TABLE k14 (
i14 INT(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k15;
CREATE TABLE k15 (
i15 INTEGER(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
DROP TABLE IF EXISTS k16;
CREATE TABLE k16 (
i16 BIGINT(1) UNSIGNED NOT NULL DEFAULT 0 AUTO_INCREMENT PRIMARY KEY
);
SQL-Translator-0.11024/t/data/mysql/create.sql 0000644 0001750 0001750 00000001040 12163313615 020264 0 ustar ilmari ilmari create table person (
person_id INTEGER PRIMARY KEY,
name varchar(20),
age integer,
weight double(11,2),
iq tinyint default '0',
description text,
UNIQUE KEY UC_age_name (age)
) ENGINE=MyISAM;
create unique index u_name on person (name);
create table employee (
position varchar(50),
employee_id integer,
job_title varchar(255),
CONSTRAINT FK5302D47D93FE702E FOREIGN KEY (employee_id) REFERENCES person (person_id),
PRIMARY KEY (position, employee_id) USING BTREE
) ENGINE=InnoDB;
create table deleted (
id integer
);
SQL-Translator-0.11024/t/data/mysql/cashmusic_db.sql 0000644 0001750 0001750 00000023273 12163313615 021461 0 ustar ilmari ilmari SET FOREIGN_KEY_CHECKS = 0;
DROP TABLE IF EXISTS `asst_assets`;
CREATE TABLE `asst_assets` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`user_id` int(11) DEFAULT NULL,
`parent_id` int(11) DEFAULT NULL,
`location` text,
`settings_id` int(11) DEFAULT NULL,
`title` text,
`description` text,
`public_status` bit(1) DEFAULT b'0',
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`),
KEY `asst_asets_parent_id` (`parent_id`),
KEY `asst_assets_user_id` (`user_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `asst_licenses`;
CREATE TABLE `asst_licenses` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`name` text NOT NULL,
`description` text NOT NULL,
`fulltext` blob NOT NULL,
`uri` text NOT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `cmrc_products`;
CREATE TABLE `cmrc_products` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`sku` varchar(20) DEFAULT NULL,
`title` varchar(100) DEFAULT NULL,
`price` decimal(9,2) DEFAULT NULL,
`type` varchar(100) DEFAULT NULL,
`beneficiary` varchar(50) DEFAULT NULL,
`sub_term_seconds` int(11) DEFAULT NULL,
`qty_total` int(11) NOT NULL DEFAULT '0',
`creation_date` int(11) NOT NULL DEFAULT '0',
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `cmrc_transactions`;
CREATE TABLE `cmrc_transactions` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`order_timestamp` varchar(24) NOT NULL DEFAULT '',
`payer_email` varchar(75) NOT NULL DEFAULT '',
`payer_id` varchar(60) NOT NULL DEFAULT '',
`payer_firstname` varchar(127) NOT NULL DEFAULT '',
`payer_lastname` varchar(127) NOT NULL DEFAULT '',
`country` varchar(8) NOT NULL DEFAULT '',
`product_sku` varchar(48) NOT NULL DEFAULT '',
`product_name` varchar(255) NOT NULL DEFAULT '',
`transaction_id` varchar(24) NOT NULL DEFAULT '',
`transaction_status` varchar(32) NOT NULL DEFAULT '',
`transaction_currency` varchar(8) NOT NULL DEFAULT '',
`transaction_amount` int(11) NOT NULL DEFAULT '0',
`transaction_fee` decimal(9,2) NOT NULL DEFAULT '0.00',
`is_fulfilled` smallint(1) NOT NULL DEFAULT '0',
`referral_code` varchar(191) DEFAULT NULL,
`nvp_request_json` text,
`nvp_response_json` text,
`nvp_details_json` text,
`creation_date` int(11) NOT NULL DEFAULT '0',
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `live_events`;
CREATE TABLE `live_events` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`date` int(11) DEFAULT NULL,
`user_id` int(11) DEFAULT NULL,
`venue_id` int(11) DEFAULT NULL,
`publish` tinyint(1) DEFAULT NULL,
`cancelled` tinyint(1) DEFAULT NULL,
`comments` text,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `live_events_user_id` (`user_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `live_venues`;
CREATE TABLE `live_venues` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`name` text NOT NULL,
`address1` text,
`address2` text,
`city` text,
`region` text,
`country` text,
`postalcode` text,
`latitude` float DEFAULT NULL,
`longitude` float DEFAULT NULL,
`website` text,
`phone` text,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `lock_codes`;
CREATE TABLE `lock_codes` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`uid` tinytext,
`element_id` int(11) DEFAULT NULL,
`claim_date` int(11) DEFAULT NULL,
`creation_date` int(11) DEFAULT '0',
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `lock_codes_element_id` (`element_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `lock_passwords`;
CREATE TABLE `lock_passwords` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`password` text,
`element_id` int(11) DEFAULT NULL,
`creation_date` int(11) DEFAULT '0',
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `lock_passwords_element_id` (`element_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `asst_analytics`;
CREATE TABLE `asst_analytics` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`asset_id` int(11) NOT NULL DEFAULT '0',
`element_id` int(11) DEFAULT NULL,
`access_time` int(11) NOT NULL,
`client_ip` varchar(39) NOT NULL,
`client_proxy` varchar(39) NOT NULL,
`cash_session_id` varchar(24) NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`),
KEY `asst_analytics_asset_id` (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `lock_permissions`;
CREATE TABLE `lock_permissions` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`user_id` int(11) NOT NULL,
`user_list_id` int(11) NOT NULL DEFAULT '0',
`element_id` int(11) NOT NULL DEFAULT '0',
`allowed_logins` int(11) NOT NULL DEFAULT '-1',
`total_logins` int(11) NOT NULL DEFAULT '0',
`date_expires` int(11) NOT NULL DEFAULT '-1',
`element_password` tinytext,
`added_by` int(11) NOT NULL DEFAULT '0',
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `lock_permissions_login_id` (`user_list_id`,`element_id`),
KEY `lock_permissions_element_id` (`element_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `user_users`;
CREATE TABLE `user_users` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`email_address` varchar(255) CHARACTER SET utf8 COLLATE utf8_bin NOT NULL DEFAULT '',
`password` char(64) CHARACTER SET utf8 COLLATE utf8_bin NOT NULL DEFAULT '',
`username` varchar(32) NOT NULL DEFAULT '',
`display_name` tinytext,
`first_name` tinytext,
`last_name` tinytext,
`organization` tinytext,
`address_line1` tinytext,
`address_line2` tinytext,
`address_city` tinytext,
`address_region` tinytext,
`address_postalcode` tinytext,
`address_country` tinytext,
`is_admin` bit(1) NOT NULL DEFAULT b'0',
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `email` (`email_address`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `user_lists`;
CREATE TABLE `user_lists` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`name` varchar(128) NOT NULL DEFAULT '',
`description` text,
`user_id` int(11) NOT NULL,
`settings_id` int(11) NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `user_resetpassword`;
CREATE TABLE `user_resetpassword` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`time_requested` int(11) NOT NULL DEFAULT '0',
`random_key` tinytext NOT NULL,
`user_id` int(11) NOT NULL DEFAULT '0',
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `elmt_elements`;
CREATE TABLE `elmt_elements` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`user_id` int(11) DEFAULT NULL,
`name` text,
`type` text NOT NULL,
`options` text,
`license_id` int(11) DEFAULT '0',
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `elmt_analytics`;
CREATE TABLE `elmt_analytics` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`element_id` int(11) NOT NULL,
`access_method` varchar(24) NOT NULL,
`access_location` text NOT NULL,
`lock_method_table` varchar(24) NOT NULL,
`lock_method_id` int(11) NOT NULL,
`access_time` int(11) NOT NULL,
`client_ip` varchar(39) NOT NULL,
`client_proxy` varchar(39) NOT NULL,
`cash_session_id` varchar(24) NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`),
KEY `elmt_analytics_element_id` (`element_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `base_settings`;
CREATE TABLE `base_settings` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`name` text,
`type` text NOT NULL,
`data` text NOT NULL,
`user_id` int(11) NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `user_lists_members`;
CREATE TABLE `user_lists_members` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`user_id` int(11) NOT NULL,
`list_id` int(11) NOT NULL,
`verification_code` text NOT NULL,
`verified` bit(1) NOT NULL,
`initial_comment` text NOT NULL,
`additional_data` text NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`),
KEY `user_lists_members_user_id` (`user_id`),
KEY `user_lists_members_list_id` (`list_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `live_guestlist`;
CREATE TABLE `live_guestlist` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`event_id` int(128) NOT NULL,
`guest_name` text,
`total_attendees` int(11) NOT NULL DEFAULT '1',
`comment` text NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT '0',
PRIMARY KEY (`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
DROP TABLE IF EXISTS `base_metadata`;
CREATE TABLE `base_metadata` (
`id` int(11) NOT NULL AUTO_INCREMENT,
`scope_table_alias` varchar(64) NOT NULL DEFAULT '',
`scope_table_id` int(11) NOT NULL DEFAULT '0',
`user_id` int(11) NOT NULL DEFAULT '0',
`type` text,
`value` text NOT NULL,
`creation_date` int(11) DEFAULT NULL,
`modification_date` int(11) DEFAULT NULL,
PRIMARY KEY (`id`),
KEY `base_metadata_scope_table` (`scope_table_alias`,`scope_table_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
SET FOREIGN_KEY_CHECKS = 1;
SQL-Translator-0.11024/t/data/mysql/BGEP-RE-create.sql 0000644 0001750 0001750 00000006510 12163313615 021312 0 ustar ilmari ilmari CREATE TABLE ad (
id varchar(32) NOT NULL DEFAULT '',
vendor_id varchar(32) NOT NULL DEFAULT '',
realtor_id int(11) NOT NULL DEFAULT 0,
location_id int(11) NOT NULL DEFAULT 0,
origin_id int(11) NOT NULL DEFAULT 0,
style_id int(11) NOT NULL DEFAULT 0,
style varchar(42) NOT NULL DEFAULT '',
media_code_id int(11) NOT NULL DEFAULT 0,
priority int(11) NOT NULL DEFAULT 1,
listing_date date,
price int(11) NOT NULL DEFAULT 0,
rooms int(11) NOT NULL DEFAULT 0,
bedrooms int(11) NOT NULL DEFAULT 0,
fullbaths int(11) NOT NULL DEFAULT 0,
halfbaths int(11) NOT NULL DEFAULT 0,
amenities varchar(255) NOT NULL DEFAULT '',
lotsize int(11) NOT NULL DEFAULT 0,
openhouse tinyint(4) NOT NULL DEFAULT 0,
street varchar(255) NOT NULL DEFAULT '',
no_units tinyint NOT NULL DEFAULT 1,
ad_text text,
original_ad_text text,
photo varchar(255) NOT NULL DEFAULT '',
thumbnail varchar(255) NOT NULL DEFAULT '',
PRIMARY KEY (id),
KEY vendor_id_idx (vendor_id),
KEY amenities_idx (amenities),
KEY listing_date_idx (listing_date)
);
CREATE TABLE ad_to_amenity (
id int(11) NOT NULL auto_increment,
ad_id char(32) NOT NULL DEFAULT '',
amenity_id int(11) NOT NULL DEFAULT 0,
PRIMARY KEY (id),
KEY ad_id_idx (ad_id)
);
CREATE TABLE amenity (
id int(11) NOT NULL auto_increment,
amenity varchar(42) NOT NULL DEFAULT '',
abbrev varchar(4) NOT NULL DEFAULT '',
PRIMARY KEY (id)
);
CREATE TABLE email (
id int(11) NOT NULL auto_increment,
realtor_id int(11) NOT NULL DEFAULT 0,
property_id int(11) NOT NULL DEFAULT 0,
firstname varchar(42) NOT NULL DEFAULT '',
lastname varchar(42) NOT NULL DEFAULT '',
phone varchar(10) NOT NULL DEFAULT '',
timeframe varchar(255) NOT NULL DEFAULT '',
schedule_appt tinyint(4) NOT NULL DEFAULT 0,
date_sent timestamp(14),
comments text,
PRIMARY KEY (id)
);
CREATE TABLE history (
id int(11) NOT NULL auto_increment,
type varchar(42) NOT NULL DEFAULT '',
value varchar(255) NOT NULL DEFAULT '',
ts timestamp(14),
PRIMARY KEY (id)
);
CREATE TABLE location (
id int(11) NOT NULL auto_increment,
abbrev varchar(4) NOT NULL DEFAULT '',
city varchar(42) NOT NULL DEFAULT '',
state char(2) NOT NULL DEFAULT 'MA',
fullstate varchar(42) NOT NULL DEFAULT 'Massachusetts',
PRIMARY KEY (id),
KEY city_idx (city),
KEY abbrev_idx (abbrev),
KEY state_idx (state)
);
CREATE TABLE mediacode (
media_code int(11) NOT NULL DEFAULT 700,
classification varchar(42) NOT NULL DEFAULT '',
PRIMARY KEY (media_code)
);
CREATE TABLE origin (
id int(11) NOT NULL auto_increment,
origin varchar(24) NOT NULL DEFAULT '',
display varchar(42) NOT NULL DEFAULT '',
PRIMARY KEY (id)
);
CREATE TABLE realtor (
id int(11) NOT NULL auto_increment,
vendor_id varchar(6) NOT NULL DEFAULT '',
name varchar(255) NOT NULL DEFAULT '',
phone varchar(24) NOT NULL DEFAULT '',
location_id int(11) NOT NULL DEFAULT 0,
email varchar(255) NOT NULL DEFAULT '',
url varchar(255) NOT NULL DEFAULT '',
tagline text,
logo_url varchar(255) NOT NULL DEFAULT '',
upsell tinyint(4) DEFAULT 0,
start_date date,
end_date date,
PRIMARY KEY (id),
KEY name_idx (name),
KEY phone_idx (phone)
);
CREATE TABLE style (
id int(11) NOT NULL auto_increment,
style varchar(42) NOT NULL DEFAULT '',
abbrev varchar(42) NOT NULL DEFAULT '',
PRIMARY KEY (id),
KEY style_idx (style)
);
SQL-Translator-0.11024/t/data/mysql/create2.sql 0000644 0001750 0001750 00000001176 12163313615 020360 0 ustar ilmari ilmari create table person (
person_id INTEGER PRIMARY KEY AUTO_INCREMENT,
name varchar(20) not null,
age integer default '18',
weight double(11,2),
iq int default '0',
is_rock_star tinyint default '1',
physical_description text,
UNIQUE KEY UC_person_id (person_id),
UNIQUE KEY UC_age_name (age, name)
) ENGINE=InnoDB;
create unique index unique_name on person (name);
create table employee (
position varchar(50),
employee_id INTEGER,
CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id) REFERENCES person (person_id),
PRIMARY KEY (employee_id, position)
) ENGINE=InnoDB;
create table added (
id integer
);
SQL-Translator-0.11024/t/data/mysql/sqlfxml-producer-basic.sql 0000644 0001750 0001750 00000000636 12163313615 023421 0 ustar ilmari ilmari --
-- Created by SQL::Translator::Producer::MySQL
-- Created on Thu Aug 7 16:28:01 2003
--
-- SET foreign_key_checks=0;
--
-- Table: Basic
--
CREATE TABLE Basic (
-- comment on id field
id integer(10) NOT NULL auto_increment
,title varchar(100) NOT NULL DEFAULT 'hello'
,description text DEFAULT ''
,email varchar(255)
,INDEX titleindex (title)
,PRIMARY KEY (id)
,UNIQUE (email)
);
SQL-Translator-0.11024/t/data/mysql/Apache-Session-MySQL.sql 0000644 0001750 0001750 00000000201 12163313615 022564 0 ustar ilmari ilmari CREATE TABLE random (
id int auto_increment PRIMARY KEY,
foo varchar(255) not null default '',
updated timestamp
);
SQL-Translator-0.11024/t/data/sqlite/ 0000755 0001750 0001750 00000000000 13225114407 016437 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/sqlite/create.sql 0000644 0001750 0001750 00000001304 12573614255 020434 0 ustar ilmari ilmari create table person (
-- field comment 1
-- field comment 2
person_id INTEGER PRIMARY KEY AUTOINCREMENT,
'name' varchar(20) not null,
'age' integer,
weight double(11,2),
iq tinyint default '0',
description text
);
create unique index u_name on person (name);
create table pet (
"pet_id" int,
"person_id" int references person (person_id),
"name" varchar(30),
"age" int,
check ( age < 100 ),
primary key (pet_id, person_id)
);
create trigger pet_trig after insert on pet
begin
update pet set name=name;
end
;
create view person_pet as
select pr.person_id, pr.name as person_name, pt.name as pet_name
from person pr, pet pt
where person.person_id=pet.pet_id
;
SQL-Translator-0.11024/t/data/sqlite/create2.sql 0000644 0001750 0001750 00000001171 12163313615 020507 0 ustar ilmari ilmari create table person (
person_id INTEGER PRIMARY KEY,
name varchar(20) not null,
age integer,
weight double(11,2),
iq int default '0',
is_rock_star tinyint default '1',
description text
);
create unique index u_name on person (name);
create table pet (
pet_id int,
person_id int,
name varchar(30),
age int,
check ( age < 100 ),
primary key (pet_id, person_id)
);
create trigger after insert on pet
begin
update pet set name=name;
end
;
create view person_pet as
select pr.person_id, pr.name as person_name, pt.name as pet_name
from person pr, pet pt
where person.person_id=pet.pet_id
;
SQL-Translator-0.11024/t/data/sqlite/named.sql 0000644 0001750 0001750 00000000773 12163313615 020255 0 ustar ilmari ilmari create table pet (
"pet_id" int,
"person_id" int
constraint fk_person_id references person(person_id) on update CASCADE on delete RESTRICT,
"person_id_2" int
constraint fk_person_id_2 references person(person_id) on update SET NULL on delete SET DEFAULT,
"person_id_3" int
constraint fk_person_id_3 references person(person_id) on update NO ACTION,
"name" varchar(30),
"age" int,
constraint age_under_100 check ( age < 100 ),
constraint pk_pet primary key (pet_id, person_id)
);
SQL-Translator-0.11024/t/data/diff/ 0000755 0001750 0001750 00000000000 13225114407 016046 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/diff/pgsql/ 0000755 0001750 0001750 00000000000 13225114407 017174 5 ustar ilmari ilmari SQL-Translator-0.11024/t/data/diff/pgsql/create1.yml 0000644 0001750 0001750 00000012775 12163313615 021261 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
deleted:
constraints:
- fields: id
name: 'fk_fake'
reference_fields:
- fk_id
reference_table: fake
type: FOREIGN KEY
- fields:
- id
name: pk_id
type: UNIQUE
fields:
id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: id
order: 10
size:
- 11
indices: []
name: deleted
options: []
order: 3
employee:
constraints:
- deferrable: 1
expression: ''
fields:
- employee_id
match_type: ''
name: FK5302D47D93FE702E
on_delete: ''
on_update: ''
options: []
reference_fields:
- person_id
reference_table: person
type: FOREIGN KEY
- deferrable: 1
expression: ''
fields:
- position
- employee_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
employee_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: employee_id
order: 8
size:
- 11
job_title:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: job_title
order: 9
size:
- 255
position:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: position
order: 7
size:
- 50
indices: []
name: employee
order: 2
old_name:
name: old_name
fields:
pk:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: pk
order: 1
order: 4
person:
constraints:
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
- deferrable: 1
expression: ''
fields:
- age
match_type: ''
name: UC_age_name
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
fields:
age:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 1
name: age
order: 3
size:
- 11
description:
data_type: text
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: description
order: 6
size:
- 65535
iq:
data_type: smallint
default_value: 0
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: iq
order: 5
size:
- 4
name:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: name
order: 2
size:
- 20
person_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: person_id
order: 1
size:
- 11
weight:
data_type: numeric
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: weight
order: 4
size:
- 11
- 2
nickname:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: nickname
order: 8
size:
- 20
indices:
- fields:
- name
name: u_name
options: []
type: UNIQUE
name: person
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: t/data/pgsql/create.sql
no_comments: 0
parser_args:
db_password: ~
db_user: ~
dsn: ~
field_separator: ~
mysql_parser_version: ~
record_separator: ~
scan_fields: 1
trim_fields: 1
parser_type: SQL::Translator::Parser::PostgreSQL
producer_args:
add_prefix: ~
add_truncate: ~
db_password: ~
db_user: ~
dsn: ~
imap_file: ~
imap_url: ~
indent: ~
newlines: ~
package_name: ~
prefix: ~
pretty: ~
skip: ~
skiplike: ~
title: ~
tt_conf: {}
tt_vars: {}
ttfile: ~
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
version: 0.0899_01
SQL-Translator-0.11024/t/data/diff/pgsql/create2.yml 0000644 0001750 0001750 00000013463 12163313615 021255 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
added:
constraints: []
fields:
id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: id
order: 10
size:
- 11
indices: []
name: added
options: []
order: 3
employee:
constraints:
- deferrable: 1
expression: ''
fields:
- employee_id
match_type: ''
name: FK5302D47D93FE702E_diff
on_delete: ''
on_update: ''
options: []
reference_fields:
- person_id
reference_table: person
type: FOREIGN KEY
- deferrable: 1
expression: ''
fields:
- employee_id
- position
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
employee_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 1
is_unique: 0
name: employee_id
order: 9
size:
- 11
position:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: position
order: 8
size:
- 50
indices: []
name: employee
order: 2
new_name:
name: new_name
extra:
renamed_from: old_name
fields:
pk:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: pk
order: 1
other:
data_type: int
name: new_field
order: 2
order: 4
person:
constraints:
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: UC_person_id
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
- deferrable: 1
expression: ''
fields:
- age
- name
match_type: ''
name: UC_age_name
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
fields:
age:
data_type: int
default_value: 18
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 1
name: age
order: 3
size:
- 11
iq:
data_type: int
default_value: 0
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: iq
order: 5
size:
- 11
is_rock_star:
data_type: smallint
default_value: 1
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: is_rock_star
order: 6
size:
- 4
name:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 1
name: name
order: 2
size:
- 20
person_id:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: person_id
order: 1
size:
- 11
physical_description:
data_type: text
default_value: ~
extra:
renamed_from: 'description'
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: physical_description
order: 7
size:
- 65535
weight:
data_type: numeric
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: weight
order: 4
size:
- 11
- 2
nickname:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 0
name: nickname
order: 8
size:
- 24
indices:
- fields:
- name
name: unique_name
options: []
type: UNIQUE
name: person
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: t/data/pgsql/create2.sql
no_comments: 0
parser_args:
db_password: ~
db_user: ~
dsn: ~
field_separator: ~
mysql_parser_version: ~
record_separator: ~
scan_fields: 1
trim_fields: 1
parser_type: SQL::Translator::Parser::PostgreSQL
producer_args:
add_prefix: ~
add_truncate: ~
db_password: ~
db_user: ~
dsn: ~
imap_file: ~
imap_url: ~
indent: ~
newlines: ~
package_name: ~
prefix: ~
pretty: ~
skip: ~
skiplike: ~
title: ~
tt_conf: {}
tt_vars: {}
ttfile: ~
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
version: 0.0899_01
SQL-Translator-0.11024/t/data/diff/create1.yml 0000644 0001750 0001750 00000013141 12372440725 020124 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
deleted:
constraints:
- fields: id
name: 'fk_fake'
reference_fields:
- fk_id
reference_table: fake
type: FOREIGN KEY
- fields:
- id
name: pk_id
type: UNIQUE
fields:
id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: id
order: 1
size:
- 11
indices: []
name: deleted
options: []
order: 3
employee:
constraints:
- deferrable: 1
expression: ''
fields:
- employee_id
match_type: ''
name: FK5302D47D93FE702E
on_delete: ''
on_update: ''
options: []
reference_fields:
- person_id
reference_table: person
type: FOREIGN KEY
- deferrable: 1
expression: ''
fields:
- position
- employee_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
employee_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: employee_id
order: 2
size:
- 11
job_title:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: job_title
order: 3
size:
- 255
position:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: position
order: 1
size:
- 50
indices: []
name: employee
options:
- ENGINE: InnoDB
order: 2
old_name:
name: old_name
fields:
pk:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: pk
order: 1
order: 4
person:
constraints:
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
- deferrable: 1
expression: ''
fields:
- age
match_type: ''
name: UC_age_name
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
fields:
age:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 1
name: age
order: 3
size:
- 11
description:
data_type: text
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: description
order: 6
size:
- 65535
iq:
data_type: tinyint
default_value: 0
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: iq
order: 5
size:
- 4
name:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: name
order: 2
size:
- 20
person_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: person_id
order: 1
size:
- 11
weight:
data_type: double
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: weight
order: 4
size:
- 11
- 2
value:
data_type: double
default_value: 0
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: value
order: 7
size:
- 8
- 2
indices:
- fields:
- name
name: u_name
options: []
type: UNIQUE
name: person
options:
- ENGINE: MyISAM
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: t/data/mysql/create.sql
no_comments: 0
parser_args:
db_password: ~
db_user: ~
dsn: ~
field_separator: ~
mysql_parser_version: ~
record_separator: ~
scan_fields: 1
trim_fields: 1
parser_type: SQL::Translator::Parser::MySQL
producer_args:
add_prefix: ~
add_truncate: ~
db_password: ~
db_user: ~
dsn: ~
imap_file: ~
imap_url: ~
indent: ~
newlines: ~
package_name: ~
prefix: ~
pretty: ~
skip: ~
skiplike: ~
title: ~
tt_conf: {}
tt_vars: {}
ttfile: ~
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
version: 0.0899_01
SQL-Translator-0.11024/t/data/diff/create2.yml 0000644 0001750 0001750 00000013632 12372440725 020132 0 ustar ilmari ilmari ---
schema:
procedures: {}
tables:
added:
constraints: []
fields:
id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: id
order: 1
size:
- 11
indices: []
name: added
options: []
order: 3
employee:
constraints:
- deferrable: 1
expression: ''
fields:
- employee_id
match_type: ''
name: FK5302D47D93FE702E_diff
on_delete: ''
on_update: ''
options: []
reference_fields:
- person_id
reference_table: person
type: FOREIGN KEY
- deferrable: 1
expression: ''
fields:
- employee_id
- position
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
fields:
employee_id:
data_type: int
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 1
is_unique: 0
name: employee_id
order: 2
size:
- 11
position:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 1
is_unique: 0
name: position
order: 1
size:
- 50
indices: []
name: employee
options:
- ENGINE: InnoDB
order: 2
new_name:
name: new_name
extra:
renamed_from: old_name
fields:
pk:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: pk
order: 1
other:
data_type: int
name: new_field
order: 2
order: 4
person:
constraints:
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: ''
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: PRIMARY KEY
- deferrable: 1
expression: ''
fields:
- person_id
match_type: ''
name: UC_person_id
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
- deferrable: 1
expression: ''
fields:
- age
- name
match_type: ''
name: UC_age_name
on_delete: ''
on_update: ''
options: []
reference_fields: []
reference_table: ''
type: UNIQUE
fields:
age:
data_type: int
default_value: 18
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 1
name: age
order: 3
size:
- 11
iq:
data_type: int
default_value: 0
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: iq
order: 5
size:
- 11
is_rock_star:
data_type: tinyint
default_value: 1
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: is_rock_star
order: 6
size:
- 4
name:
data_type: varchar
default_value: ~
extra: {}
is_nullable: 0
is_primary_key: 0
is_unique: 1
name: name
order: 2
size:
- 20
person_id:
data_type: int
default_value: ~
extra: {}
is_auto_increment: 1
is_nullable: 0
is_primary_key: 1
is_unique: 1
name: person_id
order: 1
size:
- 11
physical_description:
data_type: text
default_value: ~
extra:
renamed_from: 'description'
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: physical_description
order: 8
size:
- 65535
weight:
data_type: double
default_value: ~
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: weight
order: 4
size:
- 11
- 2
value:
data_type: double
default_value: 0.00
extra: {}
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: value
order: 7
size:
- 8
- 2
indices:
- fields:
- name
name: unique_name
options: []
type: UNIQUE
name: person
options:
- ENGINE: InnoDB
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: t/data/mysql/create2.sql
no_comments: 0
parser_args:
db_password: ~
db_user: ~
dsn: ~
field_separator: ~
mysql_parser_version: ~
record_separator: ~
scan_fields: 1
trim_fields: 1
parser_type: SQL::Translator::Parser::MySQL
producer_args:
add_prefix: ~
add_truncate: ~
db_password: ~
db_user: ~
dsn: ~
imap_file: ~
imap_url: ~
indent: ~
newlines: ~
package_name: ~
prefix: ~
pretty: ~
skip: ~
skiplike: ~
title: ~
tt_conf: {}
tt_vars: {}
ttfile: ~
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
version: 0.0899_01
SQL-Translator-0.11024/t/02mysql-parser.t 0000644 0001750 0001750 00000115463 12573614233 017234 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
use strict;
use Test::More;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw//;
use Test::SQL::Translator qw(maybe_plan);
use FindBin qw/$Bin/;
BEGIN {
maybe_plan(undef, "SQL::Translator::Parser::MySQL");
SQL::Translator::Parser::MySQL->import('parse');
}
{
my $tr = SQL::Translator->new;
my $data = q|create table "sessions" (
id char(32) not null default '0' primary key,
a_session text,
ssn varchar(12) unique key,
age int key,
fulltext key `session_fulltext` (a_session)
);|;
my $val = parse($tr, $data);
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'sessions', 'Found "sessions" table' );
my @fields = $table->get_fields;
is( scalar @fields, 4, 'Right number of fields (4)' );
my $f1 = shift @fields;
my $f2 = shift @fields;
is( $f1->name, 'id', 'First field name is "id"' );
is( $f1->data_type, 'char', 'Type is "char"' );
is( $f1->size, 32, 'Size is "32"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, '0', 'Default value is "0"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f2->name, 'a_session', 'Second field name is "a_session"' );
is( $f2->data_type, 'text', 'Type is "text"' );
is( $f2->size, 65_535, 'Size is "65,535"' );
is( $f2->is_nullable, 1, 'Field can be null' );
is( $f2->default_value, undef, 'Default value is undefined' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my @indices = $table->get_indices;
is( scalar @indices, 2, 'Right number of indices (2)' );
my $i = pop @indices;
is( $i->type, 'FULLTEXT', 'Found fulltext' );
my @constraints = $table->get_constraints;
is( scalar @constraints, 2, 'Right number of constraints (2)' );
my $c = shift @constraints;
is( $c->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $c->fields), 'id', 'Constraint is on "id"' );
my $c2 = shift @constraints;
is( $c2->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $c2->fields), 'ssn', 'Constraint is on "ssn"' );
}
{
my $tr = SQL::Translator->new;
my $data = parse($tr,
q[
CREATE TABLE `check` (
check_id int(7) unsigned zerofill NOT NULL default '0000000'
auto_increment primary key,
successful date NOT NULL default '0000-00-00',
unsuccessful date default '0000-00-00',
i1 int(11) default '0' not null,
s1 set('a','b','c') default 'b',
e1 enum("a","b","c") default "c",
name varchar(30) default NULL,
foo_type enum('vk','c''k') NOT NULL default 'vk',
date timestamp,
time_stamp2 timestamp,
foo_enabled bit(1) default b'0',
bar_enabled bit(1) default b"1",
long_foo_enabled bit(10) default b'1010101',
KEY (i1),
UNIQUE (date, i1) USING BTREE,
KEY date_idx (date),
KEY name_idx (name(10))
) TYPE=MyISAM PACK_KEYS=1;
]
);
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'check', 'Found "check" table' );
my @fields = $table->get_fields;
is( scalar @fields, 13, 'Right number of fields (13)' );
my $f1 = shift @fields;
is( $f1->name, 'check_id', 'First field name is "check_id"' );
is( $f1->data_type, 'int', 'Type is "int"' );
is( $f1->size, 7, 'Size is "7"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, '0000000', 'Default value is "0000000"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f1->is_auto_increment, 1, 'Field is auto inc' );
my %extra = $f1->extra;
ok( defined $extra{'unsigned'}, 'Field is unsigned' );
ok( defined $extra{'zerofill'}, 'Field is zerofill' );
my $f2 = shift @fields;
is( $f2->name, 'successful', 'Second field name is "successful"' );
is( $f2->data_type, 'date', 'Type is "date"' );
is( $f2->size, 0, 'Size is "0"' );
is( $f2->is_nullable, 0, 'Field cannot be null' );
is( $f2->default_value, '0000-00-00', 'Default value is "0000-00-00"' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my $f3 = shift @fields;
is( $f3->name, 'unsuccessful', 'Third field name is "unsuccessful"' );
is( $f3->data_type, 'date', 'Type is "date"' );
is( $f3->size, 0, 'Size is "0"' );
is( $f3->is_nullable, 1, 'Field can be null' );
is( $f3->default_value, '0000-00-00', 'Default value is "0000-00-00"' );
is( $f3->is_primary_key, 0, 'Field is not PK' );
my $f4 = shift @fields;
is( $f4->name, 'i1', 'Fourth field name is "i1"' );
is( $f4->data_type, 'int', 'Type is "int"' );
is( $f4->size, 11, 'Size is "11"' );
is( $f4->is_nullable, 0, 'Field cannot be null' );
is( $f4->default_value, '0', 'Default value is "0"' );
is( $f4->is_primary_key, 0, 'Field is not PK' );
my $f5 = shift @fields;
is( $f5->name, 's1', 'Fifth field name is "s1"' );
is( $f5->data_type, 'set', 'Type is "set"' );
is( $f5->size, 1, 'Size is "1"' );
is( $f5->is_nullable, 1, 'Field can be null' );
is( $f5->default_value, 'b', 'Default value is "b"' );
is( $f5->is_primary_key, 0, 'Field is not PK' );
my %f5extra = $f5->extra;
is( join(',', @{ $f5extra{'list'} || [] }), 'a,b,c', 'List is "a,b,c"' );
my $f6 = shift @fields;
is( $f6->name, 'e1', 'Sixth field name is "e1"' );
is( $f6->data_type, 'enum', 'Type is "enum"' );
is( $f6->size, 1, 'Size is "1"' );
is( $f6->is_nullable, 1, 'Field can be null' );
is( $f6->default_value, 'c', 'Default value is "c"' );
is( $f6->is_primary_key, 0, 'Field is not PK' );
my %f6extra = $f6->extra;
is( join(',', @{ $f6extra{'list'} || [] }), 'a,b,c', 'List is "a,b,c"' );
my $f7 = shift @fields;
is( $f7->name, 'name', 'Seventh field name is "name"' );
is( $f7->data_type, 'varchar', 'Type is "varchar"' );
is( $f7->size, 30, 'Size is "30"' );
is( $f7->is_nullable, 1, 'Field can be null' );
is( $f7->default_value, 'NULL', 'Default value is "NULL"' );
is( $f7->is_primary_key, 0, 'Field is not PK' );
my $f8 = shift @fields;
is( $f8->name, 'foo_type', 'Eighth field name is "foo_type"' );
is( $f8->data_type, 'enum', 'Type is "enum"' );
is( $f8->size, 3, 'Size is "2"' );
is( $f8->is_nullable, 0, 'Field cannot be null' );
is( $f8->default_value, 'vk', 'Default value is "vk"' );
is( $f8->is_primary_key, 0, 'Field is not PK' );
my %f8extra = $f8->extra;
is( join(',', @{ $f8extra{'list'} || [] }), 'vk,c\'k', 'List is "vk,c\'k"' );
my $f9 = shift @fields;
is( $f9->name, 'date', 'Ninth field name is "date"' );
is( $f9->data_type, 'timestamp', 'Type is "timestamp"' );
is( $f9->size, 0, 'Size is "0"' );
is( $f9->is_nullable, 1, 'Field can be null' );
is( $f9->default_value, undef, 'Default value is undefined' );
is( $f9->is_primary_key, 0, 'Field is not PK' );
my $f10 = shift @fields;
is( $f10->name, 'time_stamp2', 'Tenth field name is "time_stamp2"' );
is( $f10->data_type, 'timestamp', 'Type is "timestamp"' );
is( $f10->size, 0, 'Size is "0"' );
is( $f10->is_nullable, 1, 'Field can be null' );
is( $f10->default_value, undef, 'Default value is undefined' );
is( $f10->is_primary_key, 0, 'Field is not PK' );
my $f11 = shift @fields;
is( $f11->name, 'foo_enabled', 'Eleventh field name is "foo_enabled"' );
is( $f11->data_type, 'bit', 'Type is "bit"' );
is( $f11->size, 1, 'Size is "1"' );
is( $f11->is_nullable, 1, 'Field can be null' );
is( $f11->default_value, '0', 'Default value is 0' );
is( $f11->is_primary_key, 0, 'Field is not PK' );
my $f12 = shift @fields;
is( $f12->name, 'bar_enabled', 'Twelveth field name is "bar_enabled"' );
is( $f12->data_type, 'bit', 'Type is "bit"' );
is( $f12->size, 1, 'Size is "1"' );
is( $f12->is_nullable, 1, 'Field can be null' );
is( $f12->default_value, '1', 'Default value is 1' );
is( $f12->is_primary_key, 0, 'Field is not PK' );
my $f13 = shift @fields;
is( $f13->name, 'long_foo_enabled', 'Thirteenth field name is "long_foo_enabled"' );
is( $f13->data_type, 'bit', 'Type is "bit"' );
is( $f13->size, 10, 'Size is "10"' );
is( $f13->is_nullable, 1, 'Field can be null' );
is( $f13->default_value, '1010101', 'Default value is 1010101' );
is( $f13->is_primary_key, 0, 'Field is not PK' );
my @indices = $table->get_indices;
is( scalar @indices, 3, 'Right number of indices (3)' );
my $i1 = shift @indices;
is( $i1->name, '', 'No name on index' );
is( $i1->type, NORMAL, 'Normal index' );
is( join(',', $i1->fields ), 'i1', 'Index is on field "i1"' );
my $i2 = shift @indices;
is( $i2->name, 'date_idx', 'Name is "date_idx"' );
is( $i2->type, NORMAL, 'Normal index' );
is( join(',', $i2->fields ), 'date', 'Index is on field "date"' );
my $i3 = shift @indices;
is( $i3->name, 'name_idx', 'Name is "name_idx"' );
is( $i3->type, NORMAL, 'Normal index' );
is( join(',', $i3->fields ), 'name(10)', 'Index is on field "name(10)"' );
my @constraints = $table->get_constraints;
is( scalar @constraints, 2, 'Right number of constraints (2)' );
my $c1 = shift @constraints;
is( $c1->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $c1->fields), 'check_id', 'Constraint is on "check_id"' );
my $c2 = shift @constraints;
is( $c2->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $c2->fields), 'date,i1', 'Constraint is on "date, i1"' );
}
{
my $tr = SQL::Translator->new;
my $data = parse($tr,
q[
CREATE TABLE orders (
order_id integer NOT NULL comment ' ' auto_increment,
member_id varchar(255) comment 'fk to ''member''',
billing_address_id int,
shipping_address_id int,
credit_card_id int,
status smallint NOT NULL,
store_id varchar(255) NOT NULL REFERENCES store,
tax decimal(8,2),
shipping_charge decimal(8,2),
price_paid decimal(8,2),
PRIMARY KEY (order_id) USING BTREE,
KEY (status) USING BTREE,
KEY USING BTREE (billing_address_id),
KEY (shipping_address_id),
KEY (member_id, store_id),
FOREIGN KEY (status) REFERENCES order_status(id) MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE,
FOREIGN KEY (billing_address_id) REFERENCES address(address_id),
FOREIGN KEY (shipping_address_id) REFERENCES address(address_id)
) TYPE=INNODB COMMENT = 'orders table comment';
CREATE TABLE address (
address_id int NOT NULL auto_increment,
recipient varchar(255) NOT NULL,
address1 varchar(255) NOT NULL,
address2 varchar(255),
city varchar(255) NOT NULL,
state varchar(255) NOT NULL,
postal_code varchar(255) NOT NULL,
phone varchar(255),
PRIMARY KEY (address_id)
) TYPE=INNODB;
]
) or die $tr->error;
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 2, 'Right number of tables (2)' );
my $t1 = shift @tables;
is( $t1->name, 'orders', 'Found "orders" table' );
is( $t1->comments, 'orders table comment', 'Table comment OK' );
my @fields = $t1->get_fields;
is( scalar @fields, 10, 'Right number of fields (10)' );
my $f1 = shift @fields;
is( $f1->name, 'order_id', 'First field name is "order_id"' );
is( $f1->data_type, 'int', 'Type is "int"' );
is( $f1->size, 11, 'Size is "11"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, undef, 'Default value is undefined' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f1->is_auto_increment, 1, 'Field is auto inc' );
is_deeply( [$f1->comments],[' '], 'Field comment OK' );
my $f2 = shift @fields;
is( $f2->name, 'member_id', 'Second field name is "member_id"' );
is( $f2->data_type, 'varchar', 'Type is "varchar"' );
is( $f2->size, 255, 'Size is "255"' );
is( $f2->is_nullable, 1, 'Field can be null' );
is( $f2->comments, 'fk to \'member\'', 'Field comment OK' );
is( $f2->default_value, undef, 'Default value is undefined' );
my $f3 = shift @fields;
is( $f3->name, 'billing_address_id',
'Third field name is "billing_address_id"' );
is( $f3->data_type, 'int', 'Type is "int"' );
is( $f3->size, 11, 'Size is "11"' );
my $f4 = shift @fields;
is( $f4->name, 'shipping_address_id',
'Fourth field name is "shipping_address_id"' );
is( $f4->data_type, 'int', 'Type is "int"' );
is( $f4->size, 11, 'Size is "11"' );
my $f5 = shift @fields;
is( $f5->name, 'credit_card_id', 'Fifth field name is "credit_card_id"' );
is( $f5->data_type, 'int', 'Type is "int"' );
is( $f5->size, 11, 'Size is "11"' );
my $f6 = shift @fields;
is( $f6->name, 'status', 'Sixth field name is "status"' );
is( $f6->data_type, 'smallint', 'Type is "smallint"' );
is( $f6->size, 6, 'Size is "6"' );
is( $f6->is_nullable, 0, 'Field cannot be null' );
my $f7 = shift @fields;
is( $f7->name, 'store_id', 'Seventh field name is "store_id"' );
is( $f7->data_type, 'varchar', 'Type is "varchar"' );
is( $f7->size, 255, 'Size is "255"' );
is( $f7->is_nullable, 0, 'Field cannot be null' );
is( $f7->is_foreign_key, 1, 'Field is a FK' );
my $fk_ref = $f7->foreign_key_reference;
isa_ok( $fk_ref, 'SQL::Translator::Schema::Constraint', 'FK' );
is( $fk_ref->reference_table, 'store', 'FK is to "store" table' );
my $f8 = shift @fields;
is( $f8->name, 'tax', 'Eighth field name is "tax"' );
is( $f8->data_type, 'decimal', 'Type is "decimal"' );
is( $f8->size, '8,2', 'Size is "8,2"' );
my $f9 = shift @fields;
is( $f9->name, 'shipping_charge', 'Ninth field name is "shipping_charge"' );
is( $f9->data_type, 'decimal', 'Type is "decimal"' );
is( $f9->size, '8,2', 'Size is "8,2"' );
my $f10 = shift @fields;
is( $f10->name, 'price_paid', 'Tenth field name is "price_paid"' );
is( $f10->data_type, 'decimal', 'Type is "decimal"' );
is( $f10->size, '8,2', 'Size is "8,2"' );
my @indices = $t1->get_indices;
is( scalar @indices, 4, 'Right number of indices (4)' );
my $i1 = shift @indices;
is( $i1->type, NORMAL, 'First index is normal' );
is( join(',', $i1->fields), 'status', 'Index is on "status"' );
my $i2 = shift @indices;
is( $i2->type, NORMAL, 'Second index is normal' );
is( join(',', $i2->fields), 'billing_address_id',
'Index is on "billing_address_id"' );
my $i3 = shift @indices;
is( $i3->type, NORMAL, 'Third index is normal' );
is( join(',', $i3->fields), 'shipping_address_id',
'Index is on "shipping_address_id"' );
my $i4 = shift @indices;
is( $i4->type, NORMAL, 'Third index is normal' );
is( join(',', $i4->fields), 'member_id,store_id',
'Index is on "member_id,store_id"' );
my @constraints = $t1->get_constraints;
is( scalar @constraints, 5, 'Right number of constraints (5)' );
my $c1 = shift @constraints;
is( $c1->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $c1->fields), 'order_id', 'Constraint is on "order_id"' );
my $c2 = shift @constraints;
is( $c2->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $c2->fields), 'status', 'Constraint is on "status"' );
is( $c2->reference_table, 'order_status', 'To table "order_status"' );
is( join(',', $c2->reference_fields), 'id', 'To field "id"' );
my $c3 = shift @constraints;
is( $c3->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $c3->fields), 'billing_address_id',
'Constraint is on "billing_address_id"' );
is( $c3->reference_table, 'address', 'To table "address"' );
is( join(',', $c3->reference_fields), 'address_id',
'To field "address_id"' );
my $c4 = shift @constraints;
is( $c4->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $c4->fields), 'shipping_address_id',
'Constraint is on "shipping_address_id"' );
is( $c4->reference_table, 'address', 'To table "address"' );
is( join(',', $c4->reference_fields), 'address_id',
'To field "address_id"' );
my $c5 = shift @constraints;
is( $c5->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $c5->fields), 'store_id', 'Constraint is on "store_id"' );
is( $c5->reference_table, 'store', 'To table "store"' );
is( join(',', map { $_ || '' } $c5->reference_fields), '',
'No reference fields defined' );
my $t2 = shift @tables;
is( $t2->name, 'address', 'Found "address" table' );
my @t2_fields = $t2->get_fields;
is( scalar @t2_fields, 8, 'Right number of fields (8)' );
}
# djh Tests for:
# USE database ;
# ALTER TABLE ADD FOREIGN KEY
# trailing comma on last create definition
# Ignoring INSERT statements
#
{
my $tr = SQL::Translator->new;
my $data = parse($tr,
q[
USE database_name;
CREATE TABLE one (
id integer NOT NULL auto_increment,
two_id integer NOT NULL auto_increment,
some_data text,
PRIMARY KEY (id),
INDEX (two_id),
) TYPE=INNODB;
CREATE TABLE two (
id int NOT NULL auto_increment,
one_id int NOT NULL auto_increment,
some_data text,
PRIMARY KEY (id),
INDEX (one_id),
FOREIGN KEY (one_id) REFERENCES one (id),
) TYPE=INNODB;
ALTER TABLE one ADD FOREIGN KEY (two_id) REFERENCES two (id);
INSERT absolutely *#! any old $£ ? rubbish, even "quoted; semi-what""sits";
]
) or die $tr->error;
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my $db_name = $schema->name;
is( $db_name, 'database_name', 'Database name extracted from USE' );
my @tables = $schema->get_tables;
is( scalar @tables, 2, 'Right number of tables (2)' );
my $table1 = shift @tables;
is( $table1->name, 'one', 'Found "one" table' );
my $table2 = shift @tables;
is( $table2->name, 'two', 'Found "two" table' );
my @constraints = $table1->get_constraints;
is(scalar @constraints, 2, 'Right number of constraints (2) on table one');
my $t1c1 = shift @constraints;
is( $t1c1->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $t1c1->fields), 'id', 'Constraint is on "id"' );
my $t1c2 = shift @constraints;
is( $t1c2->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $t1c2->fields), 'two_id', 'Constraint is on "two_id"' );
is( $t1c2->reference_table, 'two', 'To table "two"' );
is( join(',', $t1c2->reference_fields), 'id', 'To field "id"' );
@constraints = $table2->get_constraints;
is(scalar @constraints, 2, 'Right number of constraints (2) on table two');
my $t2c1 = shift @constraints;
is( $t2c1->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $t2c1->fields), 'id', 'Constraint is on "id"' );
my $t2c2 = shift @constraints;
is( $t2c2->type, FOREIGN_KEY, 'Constraint is a FK' );
is( join(',', $t2c2->fields), 'one_id', 'Constraint is on "one_id"' );
is( $t2c2->reference_table, 'one', 'To table "one"' );
is( join(',', $t2c2->reference_fields), 'id', 'To field "id"' );
}
# cch Tests for:
# comments like: /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
# char fields with character set and collate qualifiers
# timestamp fields with on update qualifier
# charset table option
#
{
my $tr = SQL::Translator->new(parser_args => {mysql_parser_version => 50013});
my $data = parse($tr,
q[
DELIMITER ;;
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;;
/*!50003 CREATE */ /*!50017 DEFINER=`cmdomain`@`localhost` */
/*!50003 TRIGGER `acl_entry_insert` BEFORE INSERT ON `acl_entry`
FOR EACH ROW SET NEW.dateCreated = CONVERT_TZ(SYSDATE(),'SYSTEM','+0:00'),
NEW.dateModified = CONVERT_TZ(SYSDATE(),'SYSTEM','+0:00') */;;
DELIMITER ;
CREATE TABLE one (
`op` varchar(255) character set latin1 collate latin1_bin default NULL,
`last_modified` timestamp NOT NULL default Current_Timestamp on update CURRENT_TIMESTAMP,
`created_at` datetime NOT NULL Default CURRENT_TIMESTAMP(),
) TYPE=INNODB DEFAULT CHARSET=latin1;
/*!50001 CREATE ALGORITHM=UNDEFINED */
/*!50013 DEFINER=`cmdomain`@`localhost` SQL SECURITY DEFINER */
/*!50014 DEFINER=`BOGUS` */
/*! VIEW `vs_asset` AS
select `a`.`asset_id` AS `asset_id`,`a`.`fq_name` AS `fq_name`,
`cfgmgmt_mig`.`ap_extract_folder`(`a`.`fq_name`) AS `folder_name`,
`cfgmgmt_mig`.`ap_extract_asset`(`a`.`fq_name`) AS `asset_name`,
`a`.`annotation` AS `annotation`,`a`.`asset_type` AS `asset_type`,
`a`.`foreign_asset_id` AS `foreign_asset_id`,
`a`.`foreign_asset_id2` AS `foreign_asset_id2`,`a`.`dateCreated` AS `date_created`,
`a`.`dateModified` AS `date_modified`,`a`.`container_id` AS `container_id`,
`a`.`creator_id` AS `creator_id`,`a`.`modifier_id` AS `modifier_id`,
`m`.`user_id` AS `user_access`
from (`asset` `a` join `M_ACCESS_CONTROL` `m` on((`a`.`acl_id` = `m`.`acl_id`))) */;
DELIMITER ;;
/*!50001 CREATE */
/*! VIEW `vs_asset2` AS
select `a`.`asset_id` AS `asset_id`,`a`.`fq_name` AS `fq_name`,
`cfgmgmt_mig`.`ap_extract_folder`(`a`.`fq_name`) AS `folder_name`,
`cfgmgmt_mig`.`ap_extract_asset`(`a`.`fq_name`) AS `asset_name`,
`a`.`annotation` AS `annotation`,`a`.`asset_type` AS `asset_type`,
`a`.`foreign_asset_id` AS `foreign_asset_id`,
`a`.`foreign_asset_id2` AS `foreign_asset_id2`,`a`.`dateCreated` AS `date_created`,
`a`.`dateModified` AS `date_modified`,`a`.`container_id` AS `container_id`,
`a`.`creator_id` AS `creator_id`,`a`.`modifier_id` AS `modifier_id`,
`m`.`user_id` AS `user_access`
from (`asset` `a` join `M_ACCESS_CONTROL` `m` on((`a`.`acl_id` = `m`.`acl_id`))) */;
DELIMITER ;;
/*!50001 CREATE OR REPLACE */
/*! VIEW `vs_asset3` AS
select `a`.`asset_id` AS `asset_id`,`a`.`fq_name` AS `fq_name`,
`cfgmgmt_mig`.`ap_extract_folder`(`a`.`fq_name`) AS `folder_name`,
`cfgmgmt_mig`.`ap_extract_asset`(`a`.`fq_name`) AS `asset_name`,
`a`.`annotation` AS `annotation`,`a`.`asset_type` AS `asset_type`,
`a`.`foreign_asset_id` AS `foreign_asset_id`,
`a`.`foreign_asset_id2` AS `foreign_asset_id2`,`a`.`dateCreated` AS `date_created`,
`a`.`dateModified` AS `date_modified`,`a`.`container_id` AS `container_id`,
`a`.`creator_id` AS `creator_id`,`a`.`modifier_id` AS `modifier_id`,
`m`.`user_id` AS `user_access`
from (`asset` `a` join `M_ACCESS_CONTROL` `m` on((`a`.`acl_id` = `m`.`acl_id`))) */;
DELIMITER ;;
/*!50003 CREATE*/ /*!50020 DEFINER=`cmdomain`@`localhost`*/ /*!50003 FUNCTION `ap_from_millitime_nullable`( millis_since_1970 BIGINT ) RETURNS timestamp
DETERMINISTIC
BEGIN
DECLARE rval TIMESTAMP;
IF ( millis_since_1970 = 0 )
THEN
SET rval = NULL;
ELSE
SET rval = FROM_UNIXTIME( millis_since_1970 / 1000 );
END IF;
RETURN rval;
END */;;
/*!50003 CREATE*/ /*!50020 DEFINER=`cmdomain`@`localhost`*/ /*!50003 PROCEDURE `sp_update_security_acl`(IN t_acl_id INTEGER)
BEGIN
DECLARE hasMoreRows BOOL DEFAULT TRUE;
DECLARE t_group_id INT;
DECLARE t_user_id INT ;
DECLARE t_user_name VARCHAR (512) ;
DECLARE t_message VARCHAR (512) ;
DROP TABLE IF EXISTS group_acl;
DROP TABLE IF EXISTS user_group;
DELETE FROM M_ACCESS_CONTROL WHERE acl_id = t_acl_id;
CREATE TEMPORARY TABLE group_acl SELECT DISTINCT p.id group_id, d.acl_id acl_id
FROM asset d, acl_entry e, alterpoint_principal p
WHERE d.acl_id = e.acl
AND p.id = e.principal AND d.acl_id = t_acl_id;
CREATE TEMPORARY TABLE user_group SELECT a.id user_id, a.name user_name, c.id group_id
FROM alterpoint_principal a, groups_for_user b, alterpoint_principal c
WHERE a.id = b.user_ref AND b.elt = c.id;
INSERT INTO M_ACCESS_CONTROL SELECT DISTINCT group_acl.group_id, group_acl.acl_id, user_group.user_id, user_group.user_name
FROM group_acl, user_group
WHERE group_acl.group_id = user_group.group_id ;
END */;;
]
) or die $tr->error;
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table1 = shift @tables;
is( $table1->name, 'one', 'Found "one" table' );
my @fields = $table1->get_fields;
is(scalar @fields, 3, 'Right number of fields (3) on table one');
my $tableTypeFound = 0;
my $charsetFound = 0;
for my $t1_option_ref ( $table1->options ) {
my($key, $value) = %{$t1_option_ref};
if ( $key eq 'TYPE' ) {
is($value, 'INNODB', 'Table has right table type option' );
$tableTypeFound = 1;
} elsif ( $key eq 'CHARACTER SET' ) {
is($value, 'latin1', 'Table has right character set option' );
$charsetFound = 1;
}
}
fail('Table did not have a type option') unless $tableTypeFound;
fail('Table did not have a character set option') unless $charsetFound;
my $t1f1 = shift @fields;
is( $t1f1->data_type, 'varchar', 'Field is a varchar' );
is( $t1f1->size, 255, 'Field is right size' );
is( $t1f1->extra('character set'), 'latin1', 'Field has right character set qualifier' );
is( $t1f1->extra('collate'), 'latin1_bin', 'Field has right collate qualifier' );
is( $t1f1->default_value, 'NULL', 'Field has right default value' );
my $t1f2 = shift @fields;
is( $t1f2->data_type, 'timestamp', 'Field is a timestamp' );
ok( !$t1f2->is_nullable, 'Field is not nullable' );
is_deeply(
$t1f2->default_value,
\'CURRENT_TIMESTAMP',
'Field has right default value'
);
is_deeply( $t1f2->extra('on update'), \'CURRENT_TIMESTAMP', 'Field has right on update qualifier' );
my $t1f3 = shift @fields;
is( $t1f3->data_type, 'datetime', 'Field is a datetime' );
ok( !$t1f3->is_nullable, 'Field is not nullable' );
is_deeply(
$t1f3->default_value,
\'CURRENT_TIMESTAMP',
'Field has right default value'
);
my @views = $schema->get_views;
is( scalar @views, 3, 'Right number of views (3)' );
my ($view1, $view2, $view3) = @views;
is( $view1->name, 'vs_asset', 'Found "vs_asset" view' );
is( $view2->name, 'vs_asset2', 'Found "vs_asset2" view' );
is( $view3->name, 'vs_asset3', 'Found "vs_asset3" view' );
like($view1->sql, qr/vs_asset/, "Detected view vs_asset");
# KYC - commenting this out as I don't understand why this string
# should /not/ be detected when it is in the SQL - 2/28/12
# like($view1->sql, qr/cfgmgmt_mig/, "Did not detect cfgmgmt_mig");
is( join(',', $view1->fields),
join(',', qw[ asset_id fq_name folder_name asset_name annotation
asset_type foreign_asset_id foreign_asset_id2 date_created
date_modified container_id creator_id modifier_id user_access
] ),
'First view has correct fields'
);
my @options = $view1->options;
is_deeply(
\@options,
[
'ALGORITHM=UNDEFINED',
'DEFINER=`cmdomain`@`localhost`',
'SQL SECURITY DEFINER',
],
'Only version 50013 options parsed',
);
my @procs = $schema->get_procedures;
is( scalar @procs, 2, 'Right number of procedures (2)' );
my $proc1 = shift @procs;
is( $proc1->name, 'ap_from_millitime_nullable', 'Found "ap_from_millitime_nullable" procedure' );
like($proc1->sql, qr/CREATE FUNCTION ap_from_millitime_nullable/, "Detected procedure ap_from_millitime_nullable");
my $proc2 = shift @procs;
is( $proc2->name, 'sp_update_security_acl', 'Found "sp_update_security_acl" procedure' );
like($proc2->sql, qr/CREATE PROCEDURE sp_update_security_acl/, "Detected procedure sp_update_security_acl");
}
# Tests for collate table option
{
my $tr = SQL::Translator->new(parser_args => {mysql_parser_version => 50003});
my $data = parse($tr,
q[
CREATE TABLE test ( id int ) DEFAULT CHARACTER SET latin1 COLLATE latin1_bin;
] );
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table1 = shift @tables;
is( $table1->name, 'test', 'Found "test" table' );
my $collate = "Not found!";
my $charset = "Not found!";
for my $t1_option_ref ( $table1->options ) {
my($key, $value) = %{$t1_option_ref};
$collate = $value if $key eq 'COLLATE';
$charset = $value if $key eq 'CHARACTER SET';
}
is($collate, 'latin1_bin', "Collate found");
is($charset, 'latin1', "Character set found");
}
# Test the mysql version parser (probably needs to migrate to t/utils.t)
my $parse_as = {
perl => {
'3.23.2' => 3.023002,
'4' => 4.000000,
'50003' => 5.000003,
'5.01.0' => 5.001000,
'5.1' => 5.001000,
},
mysql => {
'3.23.2' => 32302,
'4' => 40000,
'50003' => 50003,
'5.01.0' => 50100,
'5.1' => 50100,
},
};
for my $target (keys %$parse_as) {
for my $str (keys %{$parse_as->{$target}}) {
cmp_ok (
SQL::Translator::Utils::parse_mysql_version ($str, $target),
'==',
$parse_as->{$target}{$str},
"'$str' parsed as $target version '$parse_as->{$target}{$str}'",
);
}
}
eval { SQL::Translator::Utils::parse_mysql_version ('bogus5.1') };
ok ($@, 'Exception thrown on invalid version string');
{
my $tr = SQL::Translator->new;
my $data = q|create table merge_example (
id int(11) NOT NULL auto_increment,
shape_field geometry NOT NULL,
PRIMARY KEY (id),
SPATIAL KEY shape_field (shape_field)
) ENGINE=MRG_MyISAM UNION=(`sometable_0`,`sometable_1`,`sometable_2`);|;
my $val = parse($tr, $data);
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'merge_example', 'Found "merge_example" table' );
my $tableTypeFound = 0;
my $unionFound = 0;
for my $t_option_ref ( $table->options ) {
my($key, $value) = %{$t_option_ref};
if ( $key eq 'ENGINE' ) {
is($value, 'MRG_MyISAM', 'Table has right table engine option' );
$tableTypeFound = 1;
} elsif ( $key eq 'UNION' ) {
is_deeply($value, [ 'sometable_0','sometable_1','sometable_2' ],
"UNION option has correct set");
$unionFound = 1;
}
}
fail('Table did not have a type option') unless $tableTypeFound;
fail('Table did not have a union option') unless $unionFound;
my @fields = $table->get_fields;
is( scalar @fields, 2, 'Right number of fields (2)' );
my $f1 = shift @fields;
my $f2 = shift @fields;
is( $f1->name, 'id', 'First field name is "id"' );
is( $f1->data_type, 'int', 'Type is "int"' );
is( $f1->size, 11, 'Size is "11"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f2->name, 'shape_field', 'Second field name is "shape_field"' );
is( $f2->data_type, 'geometry', 'Type is "geometry"' );
is( $f2->is_nullable, 0, 'Field cannot be null' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my @indices = $table->get_indices;
is( scalar @indices, 1, 'Right number of indices (1)' );
my $i1 = shift @indices;
is( $i1->name, 'shape_field', 'No name on index' );
is( $i1->type, SPATIAL, 'Spatial index' );
my @constraints = $table->get_constraints;
is( scalar @constraints, 1, 'Right number of constraints (1)' );
my $c = shift @constraints;
is( $c->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $c->fields), 'id', 'Constraint is on "id"' );
}
{
my @data = (
q|create table quote (
id int(11) NOT NULL auto_increment,
PRIMARY KEY (id)
) ENGINE="innodb";|,
q|create table quote (
id int(11) NOT NULL auto_increment,
PRIMARY KEY (id)
) ENGINE='innodb';|,
q|create table quote (
id int(11) NOT NULL auto_increment,
PRIMARY KEY (id)
) ENGINE=innodb;|,
);
for my $data (@data) {
my $tr = SQL::Translator->new;
my $val = parse($tr, $data);
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'quote', 'Found "quote" table' );
my $tableTypeFound = 0;
for my $t_option_ref ( $table->options ) {
my($key, $value) = %{$t_option_ref};
if ( $key eq 'ENGINE' ) {
is($value, 'innodb', 'Table has right table engine option' );
$tableTypeFound = 1;
}
}
fail('Table did not have a type option') unless $tableTypeFound;
my @fields = $table->get_fields;
my $f1 = shift @fields;
is( $f1->name, 'id', 'First field name is "id"' );
is( $f1->data_type, 'int', 'Type is "int"' );
is( $f1->size, 11, 'Size is "11"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->is_primary_key, 1, 'Field is PK' );
}
}
{
my $tr = SQL::Translator->new;
my $data = q|create table "sessions" (
id char(32) not null default '0' primary key,
ssn varchar(12) NOT NULL default 'test single quotes like in you''re',
user varchar(20) NOT NULL default 'test single quotes escaped like you\'re',
key using btree (ssn)
);|;
my $val = parse($tr, $data);
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Right number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'sessions', 'Found "sessions" table' );
my @fields = $table->get_fields;
is( scalar @fields, 3, 'Right number of fields (3)' );
my $f1 = shift @fields;
my $f2 = shift @fields;
my $f3 = shift @fields;
is( $f1->name, 'id', 'First field name is "id"' );
is( $f1->data_type, 'char', 'Type is "char"' );
is( $f1->size, 32, 'Size is "32"' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->default_value, '0', 'Default value is "0"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f2->name, 'ssn', 'Second field name is "ssn"' );
is( $f2->data_type, 'varchar', 'Type is "varchar"' );
is( $f2->size, 12, 'Size is "12"' );
is( $f2->is_nullable, 0, 'Field can not be null' );
is( $f2->default_value, "test single quotes like in you're", "Single quote in default value is unescaped properly" );
is( $f2->is_primary_key, 0, 'Field is not PK' );
# this is more of a sanity test because the original sqlt regex for default looked for an escaped quote represented as \'
# however in mysql 5.x (and probably other previous versions) still actually outputs that as ''
is( $f3->name, 'user', 'Second field name is "user"' );
is( $f3->data_type, 'varchar', 'Type is "varchar"' );
is( $f3->size, 20, 'Size is "20"' );
is( $f3->is_nullable, 0, 'Field can not be null' );
is( $f3->default_value, "test single quotes escaped like you're", "Single quote in default value is unescaped properly" );
is( $f3->is_primary_key, 0, 'Field is not PK' );
}
{
# silence PR::D from spewing on STDERR
local $::RD_ERRORS = 0;
local $::RD_WARN = 0;
local $::RD_HINT = 0;
my $tr = SQL::Translator->new;
my $data = q|create table "sessions" (
id char(32) not null default,
ssn varchar(12) NOT NULL default 'test single quotes like in you''re',
user varchar(20) NOT NULL default 'test single quotes escaped like you\'re',
key using btree (ssn)
);|;
my $val= parse($tr,$data);
ok ($tr->error =~ /Parse failed\./, 'Parse failed error without default value');
}
{
# make sure empty string default value still works
my $tr = SQL::Translator->new;
my $data = q|create table "sessions" (
id char(32) not null DEFAULT '',
ssn varchar(12) NOT NULL default "",
key using btree (ssn)
);|;
my $val= parse($tr,$data);
my @fields = $tr->schema->get_table('sessions')->get_fields;
is (scalar @fields, 2, 'Both fields parsed correctly');
for (@fields) {
my $def = $_->default_value;
ok( (defined $def and $def eq ''), "Defaults on field $_ correct" );
}
}
{
# test rt70437 and rt71468
my $file = "$Bin/data/mysql/cashmusic_db.sql";
ok (-f $file,"File exists");
my $tr = SQL::Translator->new( parser => 'MySQL');
ok ($tr->translate($file),'File translated');
ok (!$tr->error, 'no error');
ok (my $schema = $tr->schema, 'got schema');
}
done_testing;
SQL-Translator-0.11024/t/05bgep-re.t 0000644 0001750 0001750 00000002443 12421750467 016114 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
use strict;
use File::Spec::Functions qw(catfile tmpdir);
use File::Temp qw(tempfile);
use FindBin qw($Bin);
use SQL::Translator;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
# This aggravates me; XML::Writer produces tons of warnings.
local $SIG{__WARN__} = sub {
CORE::warn(@_)
unless $_[0] =~ m#XML/Writer#;
};
BEGIN {
maybe_plan(2,
'SQL::Translator::Parser::MySQL',
'SQL::Translator::Producer::XML::SQLFairy');
}
my @data = qw(data mysql BGEP-RE-create.sql);
my $test_data = (-d "t")
? catfile($Bin, @data)
: catfile($Bin, "t", @data);
my $tr = SQL::Translator->new(
parser => 'MySQL',
producer => 'XML-SQLFairy',
filename => $test_data
);
my $data = $tr->translate;
ok($data, "MySQL->XML-SQLFairy");
SKIP: {
eval {
require XML::Parser;
};
if ($@) {
skip "Can't load XML::Parser" => 1;
}
# Can't get XML::Parser::parsestring to do Useful Things
my ($fh, $fname) = tempfile('sqlfXXXX',
UNLINK => 1,
SUFFIX => '.xml',
DIR => tmpdir);
print $fh $data;
close $fh;
ok(XML::Parser->new->parsefile($fname),
"Successfully parsed output");
}
SQL-Translator-0.11024/t/10excel.t 0000644 0001750 0001750 00000005043 12163313615 015657 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use Test::More;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(31, 'SQL::Translator::Parser::Excel');
SQL::Translator::Parser::Excel->import('parse');
}
my $tr = SQL::Translator->new(parser => "Excel");
my $t = $tr->translate(filename => "t/data/Excel/t.xls");
my $schema = $tr->schema;
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Parsed 1 table' );
my $table = shift @tables;
is( $table->name, 'Sheet1', 'Table name is "Sheet1"' );
my @fields = $table->get_fields;
is( scalar @fields, 7, 'Table has 7 fields' );
my $f1 = shift @fields;
is( $f1->name, 'ID', 'First field name is "ID"' );
is( lc $f1->data_type, 'integer', 'Data type is "integer"' );
is( $f1->size, 5, 'Size is "5"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
my $f2 = shift @fields;
is( $f2->name, 'text', 'Second field name is "text"' );
is( lc $f2->data_type, 'char', 'Data type is "char"' );
is( $f2->size, 7, 'Size is "7"' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my $f3 = shift @fields;
is( $f3->name, 'number', 'Third field name is "number"' );
is( lc $f3->data_type, 'integer', 'Data type is "integer"' );
is( $f3->size, 1, 'Size is "1"' );
is( $f3->is_primary_key, 0, 'Field is not PK' );
my $f4 = shift @fields;
TODO: {
eval { require Spreadsheet::ParseExcel };
todo_skip "Bug in Spreadsheet::ParseExcel, http://rt.cpan.org/Public/Bug/Display.html?id=39892", 4
if ( $Spreadsheet::ParseExcel::VERSION > 0.32 and $Spreadsheet::ParseExcel::VERSION < 0.41 );
is( $f4->name, 'math', 'Fourth field name is "math"' );
is( lc $f4->data_type, 'float', 'Data type is "float"' );
is( $f4->size, '3,1', 'Size is "3,1"' );
is( $f4->is_primary_key, 0, 'Field is not PK' );
}
my $f5 = shift @fields;
is( $f5->name, 'bitmap', 'Fifth field name is "bitmap"' );
is( lc $f5->data_type, 'char', 'Data type is "char"' );
is( $f5->size, 1, 'Size is "1"' );
is( $f5->is_primary_key, 0, 'Field is not PK' );
my $f6 = shift @fields;
is( $f6->name, 'today', 'Sixth field name is "today"' );
is( lc $f6->data_type, 'char', 'Data type is "CHAR"' );
is( $f6->size, 10, 'Size is "10"' );
is( $f6->is_primary_key, 0, 'Field is not PK' );
my $f7 = shift @fields;
is( $f7->name, 'silly_field_with_random_characters',
'Seventh field name is "silly_field_with_random_characters"' );
is( lc $f7->data_type, 'char', 'Data type is "CHAR"' );
is( $f7->size, 11, 'Size is "11"' );
is( $f7->is_primary_key, 0, 'Field is not PK' );
SQL-Translator-0.11024/t/17sqlfxml-producer.t 0000644 0001750 0001750 00000026003 13070420670 020072 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
local $^W = 0;
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
my %opt;
BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; }
use constant DEBUG => (exists $opt{d} ? 1 : 0);
use constant TRACE => (exists $opt{t} ? 1 : 0);
use FindBin qw/$Bin/;
my $file = "$Bin/data/mysql/sqlfxml-producer-basic.sql";
local $SIG{__WARN__} = sub {
CORE::warn(@_)
unless $_[0] =~ m!XML/Writer!;
};
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(14,
'XML::Writer',
'Test::Differences',
'SQL::Translator::Producer::XML::SQLFairy');
}
use Test::Differences;
use SQL::Translator;
use SQL::Translator::Producer::XML::SQLFairy;
# Due to formatters being able to change style, e.g. by entries in .rc files
# in $HOME, the layout and or indent might differ slightly. As leading white
# is not important in XML, strip it when comparing
sub xml_equals
{
my ($got, $expect, $msg) = (@_, "XML looks right");
$got =~ s/^ +//gm;
$expect =~ s/^ +//gm;
eq_or_diff $got, $expect, $msg;
}
#
# basic stuff
#
{
my ($obj,$ans,$xml);
$ans = <
EOXML
$obj = SQL::Translator->new(
debug => DEBUG,
trace => TRACE,
show_warnings => 1,
add_drop_table => 1,
from => "MySQL",
to => "XML-SQLFairy",
);
$xml = $obj->translate($file) or die $obj->error;
ok("$xml" ne "" ,"Produced something!");
print "XML:\n$xml" if DEBUG;
# Strip sqlf header with its variable date so we diff safely
$xml =~ s/^([^\n]*\n){7}//m;
xml_equals $xml, $ans;
} # end basic stuff
#
# View
#
# Thanks to Ken for the schema setup lifted from 13schema.t
{
my ($obj,$ans,$xml);
$ans = <
select name, age from person
EOXML
$obj = SQL::Translator->new(
debug => DEBUG,
trace => TRACE,
show_warnings => 1,
add_drop_table => 1,
from => "MySQL",
to => "XML-SQLFairy",
);
my $s = $obj->schema;
my $name = 'foo_view';
my $sql = 'select name, age from person';
my $fields = 'name, age';
my $v = $s->add_view(
name => $name,
sql => $sql,
fields => $fields,
extra => { hello => "world" },
schema => $s,
) or die $s->error;
# As we have created a Schema we give translate a dummy string so that
# it will run the produce.
lives_ok {$xml =$obj->translate("FOO");} "Translate (View) ran";
ok("$xml" ne "" ,"Produced something!");
print "XML attrib_values=>1:\n$xml" if DEBUG;
# Strip sqlf header with its variable date so we diff safely
$xml =~ s/^([^\n]*\n){7}//m;
xml_equals $xml, $ans;
} # end View
#
# Trigger
#
# Thanks to Ken for the schema setup lifted from 13schema.t
{
my ($obj,$ans,$xml);
$ans = <
update modified=timestamp();
EOXML
$obj = SQL::Translator->new(
debug => DEBUG,
trace => TRACE,
show_warnings => 1,
add_drop_table => 1,
from => "MySQL",
to => "XML-SQLFairy",
);
my $s = $obj->schema;
my $name = 'foo_trigger';
my $perform_action_when = 'after';
my $database_event = 'insert';
my $action = 'update modified=timestamp();';
my $table = $s->add_table( name => "Basic" ) or die $s->error;
my $t = $s->add_trigger(
name => $name,
perform_action_when => $perform_action_when,
database_events => [$database_event],
table => $table,
action => $action,
scope => 'row',
extra => { hello => "world" },
) or die $s->error;
# As we have created a Schema we give translate a dummy string so that
# it will run the produce.
lives_ok {$xml =$obj->translate("FOO");} "Translate (Trigger) ran";
ok("$xml" ne "" ,"Produced something!");
print "XML attrib_values=>1:\n$xml" if DEBUG;
# Strip sqlf header with its variable date so we diff safely
$xml =~ s/^([^\n]*\n){7}//m;
xml_equals $xml, $ans;
} # end Trigger
#
# Procedure
#
# Thanks to Ken for the schema setup lifted from 13schema.t
{
my ($obj,$ans,$xml);
$ans = <
select foo from bar
Go Sox!
EOXML
$obj = SQL::Translator->new(
debug => DEBUG,
trace => TRACE,
show_warnings => 1,
add_drop_table => 1,
from => "MySQL",
to => "XML-SQLFairy",
);
my $s = $obj->schema;
my $name = 'foo_proc';
my $sql = 'select foo from bar';
my $parameters = 'foo, bar';
my $owner = 'Nomar';
my $comments = 'Go Sox!';
my $p = $s->add_procedure(
name => $name,
sql => $sql,
parameters => $parameters,
owner => $owner,
comments => $comments,
extra => { hello => "world" },
) or die $s->error;
# As we have created a Schema we give translate a dummy string so that
# it will run the produce.
lives_ok {$xml =$obj->translate("FOO");} "Translate (Procedure) ran";
ok("$xml" ne "" ,"Produced something!");
print "XML attrib_values=>1:\n$xml" if DEBUG;
# Strip sqlf header with its variable date so we diff safely
$xml =~ s/^([^\n]*\n){7}//m;
xml_equals $xml, $ans;
} # end Procedure
#
# Field.extra
#
{
my ($obj,$ans,$xml);
$ans = <
EOXML
$obj = SQL::Translator->new(
debug => DEBUG,
trace => TRACE,
show_warnings => 1,
add_drop_table => 1,
from => "MySQL",
to => "XML-SQLFairy",
);
my $s = $obj->schema;
my $t = $s->add_table( name => "Basic" ) or die $s->error;
my $f = $t->add_field(
name => "foo",
data_type => "integer",
size => "10",
) or die $t->error;
$f->extra(ZEROFILL => "1");
$t->add_field(
name => "bar",
data_type => "numeric",
size => "10,2",
) or die $t->error;
$t->add_field(
name => "baz",
data_type => "decimal",
size => [8,3],
) or die $t->error;
# As we have created a Schema we give translate a dummy string so that
# it will run the produce.
lives_ok {$xml =$obj->translate("FOO");} "Translate (Field.extra) ran";
ok("$xml" ne "" ,"Produced something!");
print "XML:\n$xml" if DEBUG;
# Strip sqlf header with its variable date so we diff safely
$xml =~ s/^([^\n]*\n){7}//m;
xml_equals $xml, $ans;
} # end extra
SQL-Translator-0.11024/t/55-oracle-add-field.t 0000644 0001750 0001750 00000002103 12163313615 017713 0 ustar ilmari ilmari #!/usr/bin/perl
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Diff;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::Oracle');
}
my $schema1 = $Bin.'/data/oracle/schema_diff_b.yaml';
my $schema2 = $Bin.'/data/oracle/schema_diff_c.yaml';
open my $io1, '<', $schema1 or die $!;
open my $io2, '<', $schema2 or die $!;
my ($yaml1, $yaml2);
{
local $/ = undef;
$yaml1 = <$io1>;
$yaml2 = <$io2>;
};
close $io1;
close $io2;
my $s = SQL::Translator->new(from => 'YAML');
$s->parser->($s,$yaml1);
my $t = SQL::Translator->new(from => 'YAML');
$t->parser->($t,$yaml2);
my $d = SQL::Translator::Diff->new
({
output_db => 'Oracle',
source_schema => $s->schema,
target_schema => $t->schema,
});
my $diff = $d->compute_differences->produce_diff_sql || die $d->error;
ok($diff, 'Diff generated.');
like($diff, '/ALTER TABLE d_operator ADD \( foo nvarchar2\(10\) NOT NULL \)/',
'Alter table generated.');
SQL-Translator-0.11024/t/57-class-dbi.t 0000644 0001750 0001750 00000002377 12163313615 016517 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More tests => 2;
use Test::SQL::Translator qw(maybe_plan);
use FindBin qw/$Bin/;
use SQL::Translator::Schema::View;
use SQL::Translator::Producer::SQLite;
{
my $view1 = SQL::Translator::Schema::View->new(
name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',
extra => {
temporary => 1,
if_not_exists => 1,
}
);
my $create_opts = { no_comments => 1 };
my $view1_sql1 =
[ SQL::Translator::Producer::SQLite::create_view( $view1, $create_opts ) ];
my $view_sql_replace = [ 'CREATE TEMPORARY VIEW IF NOT EXISTS view_foo AS
SELECT id, name FROM thing' ];
is_deeply( $view1_sql1, $view_sql_replace, 'correct "CREATE TEMPORARY VIEW" SQL' );
my $view2 = SQL::Translator::Schema::View->new(
name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',
);
my $view1_sql2 =
[ SQL::Translator::Producer::SQLite::create_view( $view2, $create_opts ) ];
my $view_sql_noreplace = [ 'CREATE VIEW view_foo AS
SELECT id, name FROM thing' ];
is_deeply( $view1_sql2, $view_sql_noreplace, 'correct "CREATE VIEW" SQL' );
}
SQL-Translator-0.11024/t/46xml-to-pg.t 0000644 0001750 0001750 00000003741 13070420670 016415 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Test::Differences;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::PostgreSQL');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my $sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'PostgreSQL',
filename => $xmlfile,
) or die $sqlt->error;
eq_or_diff($sql, << "SQL");
DROP TABLE "Basic" CASCADE;
CREATE TABLE "Basic" (
"id" serial NOT NULL,
"title" character varying(100) DEFAULT 'hello' NOT NULL,
"description" text DEFAULT '',
"email" character varying(500),
"explicitnulldef" character varying,
"explicitemptystring" character varying DEFAULT '',
-- Hello emptytagdef
"emptytagdef" character varying DEFAULT '',
"another_id" integer DEFAULT 2,
"timest" timestamp,
PRIMARY KEY ("id"),
CONSTRAINT "emailuniqueindex" UNIQUE ("email"),
CONSTRAINT "very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms" UNIQUE ("title")
);
CREATE INDEX "titleindex" on "Basic" ("title");
DROP TABLE "Another" CASCADE;
CREATE TABLE "Another" (
"id" serial NOT NULL,
"num" numeric(10,2),
PRIMARY KEY ("id")
);
DROP VIEW "email_list";
CREATE VIEW "email_list" ( "email" ) AS
SELECT email FROM Basic WHERE (email IS NOT NULL)
;
DROP TRIGGER IF EXISTS "foo_trigger";
CREATE TRIGGER "foo_trigger" after insert ON "Basic" FOR EACH row update modified=timestamp();;
DROP TRIGGER IF EXISTS "bar_trigger";
CREATE TRIGGER "bar_trigger" before insert OR update ON "Basic" FOR EACH row update modified2=timestamp();;
ALTER TABLE "Basic" ADD FOREIGN KEY ("another_id")
REFERENCES "Another" ("id") DEFERRABLE;
SQL
SQL-Translator-0.11024/t/73-sqlite-respects-quote.t 0000644 0001750 0001750 00000003517 12163313615 021133 0 ustar ilmari ilmari #!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 3;
use Test::Exception;
use Test::Differences;
use SQL::Translator;
use SQL::Translator::Parser::SQLite;
use SQL::Translator::Diff;
my $ddl = < 1,
from => 'SQLite',
to => 'SQLite');
my $unquoted = SQL::Translator
->new(%common_args)
->translate(\$ddl);
eq_or_diff($unquoted, <<'DDL', 'DDL with default quoting');
BEGIN TRANSACTION;
CREATE TABLE Foo (
foo INTEGER PRIMARY KEY NOT NULL,
bar VARCHAR(10) NOT NULL,
biff VARCHAR(10)
);
COMMIT;
DDL
dies_ok { SQL::Translator
->new(%common_args, quote_table_names=>0, quote_field_names => 1)
->translate(\$ddl) } 'mix and match quotes is asinine';
my $quoteall = SQL::Translator
->new(%common_args, quote_identifiers=>1)
->translate(\$ddl);
eq_or_diff($quoteall, <<'DDL', 'DDL with quoting');
BEGIN TRANSACTION;
CREATE TABLE "Foo" (
"foo" INTEGER PRIMARY KEY NOT NULL,
"bar" VARCHAR(10) NOT NULL,
"biff" VARCHAR(10)
);
COMMIT;
DDL
=begin FOR TODO
# FIGURE OUT HOW TO DO QUOTED DIFFS EVEN WHEN QUOTING IS DEFAULT OFF
#
eq_or_diff($upgrade_sql, <<'## END OF DIFF', "Diff as expected");
-- Convert schema '' to '':;
BEGIN;
CREATE TEMPORARY TABLE "Foo_temp_alter" (
"foo" INTEGER PRIMARY KEY NOT NULL,
"bar" VARCHAR(10) NOT NULL,
"baz" VARCHAR(10),
"doomed" VARCHAR(10)
);
INSERT INTO "Foo_temp_alter"( "foo", "bar") SELECT "foo", "bar" FROM "Foo";
DROP TABLE "Foo";
CREATE TABLE "Foo" (
"foo" INTEGER PRIMARY KEY NOT NULL,
"bar" VARCHAR(10) NOT NULL,
"baz" VARCHAR(10),
"doomed" VARCHAR(10)
);
INSERT INTO "Foo" SELECT "foo", "bar", "baz", "doomed" FROM "Foo_temp_alter";
DROP TABLE "Foo_temp_alter";
COMMIT;
## END OF DIFF
=cut
SQL-Translator-0.11024/t/48xml-to-sqlite.t 0000644 0001750 0001750 00000007532 12163313615 017316 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Test::Differences;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::SQLite');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
quote_identifiers => 1,
no_comments => 1,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my $sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'SQLite',
filename => $xmlfile,
) or die $sqlt->error;
eq_or_diff($sql, << "SQL");
BEGIN TRANSACTION;
DROP TABLE "Basic";
CREATE TABLE "Basic" (
"id" INTEGER PRIMARY KEY NOT NULL,
"title" varchar(100) NOT NULL DEFAULT 'hello',
"description" text DEFAULT '',
"email" varchar(500),
"explicitnulldef" varchar,
"explicitemptystring" varchar DEFAULT '',
-- Hello emptytagdef
"emptytagdef" varchar DEFAULT '',
"another_id" int(10) DEFAULT 2,
"timest" timestamp,
FOREIGN KEY ("another_id") REFERENCES "Another"("id")
);
CREATE INDEX "titleindex" ON "Basic" ("title");
CREATE UNIQUE INDEX "emailuniqueindex" ON "Basic" ("email");
CREATE UNIQUE INDEX "very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms" ON "Basic" ("title");
DROP TABLE "Another";
CREATE TABLE "Another" (
"id" INTEGER PRIMARY KEY NOT NULL,
"num" numeric(10,2)
);
DROP VIEW IF EXISTS "email_list";
CREATE VIEW "email_list" AS
SELECT email FROM Basic WHERE (email IS NOT NULL);
DROP TRIGGER IF EXISTS "foo_trigger";
CREATE TRIGGER "foo_trigger" after insert on "Basic" BEGIN update modified=timestamp(); END;
DROP TRIGGER IF EXISTS "bar_trigger_insert";
CREATE TRIGGER "bar_trigger_insert" before insert on "Basic" BEGIN update modified2=timestamp(); END;
DROP TRIGGER IF EXISTS "bar_trigger_update";
CREATE TRIGGER "bar_trigger_update" before update on "Basic" BEGIN update modified2=timestamp(); END;
COMMIT;
SQL
# Test in list context
my @sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'SQLite',
filename => $xmlfile,
) or die $sqlt->error;
eq_or_diff(\@sql,
[
'BEGIN TRANSACTION',
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
q,
'COMMIT',
], 'SQLite translate in list context matches');
SQL-Translator-0.11024/t/12header_comment.t 0000644 0001750 0001750 00000001124 12163313615 017527 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More tests => 5;
use SQL::Translator::Utils qw($DEFAULT_COMMENT header_comment);
# Superfluous test, but that's ok
use_ok("SQL::Translator::Utils");
is($DEFAULT_COMMENT, '-- ', 'default comment');
like(header_comment("foo"), qr/[-][-] Created by foo/, "Created by...");
my $comm = header_comment("My::Producer",
$DEFAULT_COMMENT,
"Hi mom!");
like($comm, qr/[-][-] Created by My::Producer/, 'Multiline header comment...');
like($comm, qr/[-][-] Hi mom!/, '...with additional junk');
SQL-Translator-0.11024/t/30sqlt-new-diff-mysql.t 0000644 0001750 0001750 00000022246 12542755372 020423 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use warnings;
use SQL::Translator;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use Test::More;
use Test::Differences;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator::Schema::Constants;
use Storable 'dclone';
plan tests => 9;
use_ok('SQL::Translator::Diff') or die "Cannot continue\n";
my $tr = SQL::Translator->new;
my ( $source_schema, $target_schema, $parsed_sql_schema ) = map {
my $t = SQL::Translator->new;
$t->parser( 'YAML' )
or die $tr->error;
my $out = $t->translate( catfile($Bin, qw/data diff/, $_ ) )
or die $tr->error;
my $schema = $t->schema;
unless ( $schema->name ) {
$schema->name( $_ );
}
($schema);
} (qw( create1.yml create2.yml ));
# Test for differences
my @out = SQL::Translator::Diff::schema_diff(
$source_schema, 'MySQL',
$target_schema, 'MySQL',
{
no_batch_alters => 1,
producer_args => { quote_identifiers => 0 }
}
);
ok( @out, 'Got a list' );
my $out = join('', @out);
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
SET foreign_key_checks=0;
CREATE TABLE added (
id integer(11) NULL
);
SET foreign_key_checks=1;
ALTER TABLE old_name RENAME TO new_name;
ALTER TABLE employee DROP FOREIGN KEY FK5302D47D93FE702E;
ALTER TABLE person DROP INDEX UC_age_name;
ALTER TABLE person DROP INDEX u_name;
ALTER TABLE employee DROP COLUMN job_title;
ALTER TABLE new_name ADD COLUMN new_field integer NULL;
ALTER TABLE person ADD COLUMN is_rock_star tinyint(4) NULL DEFAULT 1;
ALTER TABLE person CHANGE COLUMN person_id person_id integer(11) NOT NULL auto_increment;
ALTER TABLE person CHANGE COLUMN name name varchar(20) NOT NULL;
ALTER TABLE person CHANGE COLUMN age age integer(11) NULL DEFAULT 18;
ALTER TABLE person CHANGE COLUMN iq iq integer(11) NULL DEFAULT 0;
ALTER TABLE person CHANGE COLUMN description physical_description text NULL;
ALTER TABLE person ADD UNIQUE INDEX unique_name (name);
ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id) REFERENCES person (person_id);
ALTER TABLE person ADD UNIQUE UC_person_id (person_id);
ALTER TABLE person ADD UNIQUE UC_age_name (age, name);
ALTER TABLE person ENGINE=InnoDB;
ALTER TABLE deleted DROP FOREIGN KEY fk_fake;
DROP TABLE deleted;
COMMIT;
## END OF DIFF
$out = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $target_schema, 'MySQL',
{ ignore_index_names => 1,
ignore_constraint_names => 1,
producer_args => { quote_identifiers => 0 },
});
eq_or_diff($out, <<'## END OF DIFF', "Diff as expected");
-- Convert schema 'create1.yml' to 'create2.yml':;
BEGIN;
SET foreign_key_checks=0;
CREATE TABLE added (
id integer(11) NULL
);
SET foreign_key_checks=1;
ALTER TABLE employee DROP COLUMN job_title;
ALTER TABLE old_name RENAME TO new_name,
ADD COLUMN new_field integer NULL;
ALTER TABLE person DROP INDEX UC_age_name,
ADD COLUMN is_rock_star tinyint(4) NULL DEFAULT 1,
CHANGE COLUMN person_id person_id integer(11) NOT NULL auto_increment,
CHANGE COLUMN name name varchar(20) NOT NULL,
CHANGE COLUMN age age integer(11) NULL DEFAULT 18,
CHANGE COLUMN iq iq integer(11) NULL DEFAULT 0,
CHANGE COLUMN description physical_description text NULL,
ADD UNIQUE UC_person_id (person_id),
ADD UNIQUE UC_age_name (age, name),
ENGINE=InnoDB;
ALTER TABLE deleted DROP FOREIGN KEY fk_fake;
DROP TABLE deleted;
COMMIT;
## END OF DIFF
# Test for sameness
$out = SQL::Translator::Diff::schema_diff($source_schema, 'MySQL', $source_schema, 'MySQL' );
eq_or_diff($out, <<'## END OF DIFF', "No differences found");
-- Convert schema 'create1.yml' to 'create1.yml':;
-- No differences found;
## END OF DIFF
{
my $t = SQL::Translator->new;
$t->parser( 'MySQL' )
or die $tr->error;
my $out = $t->translate( catfile($Bin, qw/data mysql create.sql/ ) )
or die $tr->error;
# Lets remove the renamed table so we dont have to change the SQL or other tests
$target_schema->drop_table('new_name');
my $schema = $t->schema;
unless ( $schema->name ) {
$schema->name( 'create.sql' );
}
# Now lets change the type of one of the 'integer' columns so that it
# matches what the mysql parser sees for ' interger'.
my $field = $target_schema->get_table('employee')->get_field('employee_id');
$field->data_type('integer');
$field->size(0);
$out = SQL::Translator::Diff::schema_diff($schema, 'MySQL', $target_schema, 'MySQL', { producer_args => { quote_identifiers => 0 } } );
eq_or_diff($out, <<'## END OF DIFF', "No differences found");
-- Convert schema 'create.sql' to 'create2.yml':;
BEGIN;
SET foreign_key_checks=0;
CREATE TABLE added (
id integer(11) NULL
);
SET foreign_key_checks=1;
ALTER TABLE employee DROP FOREIGN KEY FK5302D47D93FE702E,
DROP COLUMN job_title,
ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id) REFERENCES person (person_id);
ALTER TABLE person DROP INDEX UC_age_name,
DROP INDEX u_name,
ADD COLUMN is_rock_star tinyint(4) NULL DEFAULT 1,
ADD COLUMN value double(8, 2) NULL DEFAULT 0.00,
CHANGE COLUMN person_id person_id integer(11) NOT NULL auto_increment,
CHANGE COLUMN name name varchar(20) NOT NULL,
CHANGE COLUMN age age integer(11) NULL DEFAULT 18,
CHANGE COLUMN iq iq integer(11) NULL DEFAULT 0,
CHANGE COLUMN description physical_description text NULL,
ADD UNIQUE INDEX unique_name (name),
ADD UNIQUE UC_person_id (person_id),
ADD UNIQUE UC_age_name (age, name),
ENGINE=InnoDB;
DROP TABLE deleted;
COMMIT;
## END OF DIFF
}
# Test InnoDB stupidness. Have to drop constraints before re-adding them if
# they are just alters.
{
my $s1 = SQL::Translator::Schema->new;
my $s2 = SQL::Translator::Schema->new;
$s1->name('Schema 1');
$s2->name('Schema 2');
my $t1 = $s1->add_table($target_schema->get_table('employee'));
my $t2 = $s2->add_table(dclone($target_schema->get_table('employee')));
my ($c) = grep { $_->name eq 'FK5302D47D93FE702E_diff' } $t2->get_constraints;
$c->on_delete('CASCADE');
$t2->add_constraint(
name => 'new_constraint',
type => 'FOREIGN KEY',
fields => ['employee_id'],
reference_fields => ['fake'],
reference_table => 'patty',
);
$t2->add_field(
name => 'new',
data_type => 'int'
);
my $out = SQL::Translator::Diff::schema_diff($s1, 'MySQL', $s2, 'MySQL' );
eq_or_diff($out, <<'## END OF DIFF', "Batch alter of constraints work for InnoDB");
-- Convert schema 'Schema 1' to 'Schema 2':;
BEGIN;
ALTER TABLE employee DROP FOREIGN KEY FK5302D47D93FE702E_diff;
ALTER TABLE employee ADD COLUMN new integer NULL,
ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id) REFERENCES person (person_id) ON DELETE CASCADE,
ADD CONSTRAINT new_constraint FOREIGN KEY (employee_id) REFERENCES patty (fake);
COMMIT;
## END OF DIFF
}
{
# Test other things about renaming tables to - namely that renames
# constraints are still formated right.
my $s1 = SQL::Translator::Schema->new;
my $s2 = SQL::Translator::Schema->new;
$s1->name('Schema 3');
$s2->name('Schema 4');
my $t1 = $s1->add_table(dclone($target_schema->get_table('employee')));
$s1->add_table(dclone($source_schema->get_table('deleted')));
my $t2 = dclone($target_schema->get_table('employee'));
$t2->name('fnord');
$t2->extra(renamed_from => 'employee');
$s2->add_table($t2);
$t1->add_constraint(
name => 'bar_fk',
type => 'FOREIGN KEY',
fields => ['employee_id'],
reference_fields => ['id'],
reference_table => 'bar',
);
$t2->add_constraint(
name => 'foo_fk',
type => 'FOREIGN KEY',
fields => ['employee_id'],
reference_fields => ['id'],
reference_table => 'foo',
);
my $out = SQL::Translator::Diff::schema_diff($s1, 'MySQL', $s2, 'MySQL' );
eq_or_diff($out, <<'## END OF DIFF', "Alter/drop constraints works with rename table");
-- Convert schema 'Schema 3' to 'Schema 4':;
BEGIN;
ALTER TABLE employee RENAME TO fnord,
DROP FOREIGN KEY bar_fk,
ADD CONSTRAINT foo_fk FOREIGN KEY (employee_id) REFERENCES foo (id);
ALTER TABLE deleted DROP FOREIGN KEY fk_fake;
DROP TABLE deleted;
COMMIT;
## END OF DIFF
# Test quoting works too.
$out = SQL::Translator::Diff::schema_diff($s1, 'MySQL', $s2, 'MySQL',
{ producer_args => { quote_identifiers => 1 } }
);
eq_or_diff($out, <<'## END OF DIFF', "Quoting can be turned on");
-- Convert schema 'Schema 3' to 'Schema 4':;
BEGIN;
ALTER TABLE `employee` RENAME TO `fnord`,
DROP FOREIGN KEY `bar_fk`,
ADD CONSTRAINT `foo_fk` FOREIGN KEY (`employee_id`) REFERENCES `foo` (`id`);
ALTER TABLE `deleted` DROP FOREIGN KEY `fk_fake`;
DROP TABLE `deleted`;
COMMIT;
## END OF DIFF
}
SQL-Translator-0.11024/t/postgresql-rename-table-and-field.t 0000644 0001750 0001750 00000004661 13213473206 023001 0 ustar ilmari ilmari #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::SQL::Translator;
use SQL::Translator;
use SQL::Translator::Diff;
maybe_plan(undef, 'DBD::Pg');
my ( $pg_tst, $ddl, $ret, $dsn, $user, $pass );
if ($ENV{DBICTEST_PG_DSN}) {
($dsn, $user, $pass) = map { $ENV{"DBICTEST_PG_$_"} } qw(DSN USER PASS);
}
else {
no warnings 'once';
maybe_plan(undef, 'Test::PostgreSQL');
$pg_tst = eval { Test::PostgreSQL->new }
or plan skip_all => "Can't create test database: $Test::PostgreSQL::errstr";
$dsn = $pg_tst->dsn;
};
my $dbh = DBI->connect($dsn, $user, $pass, { RaiseError => 1, AutoCommit => 1 });
$dbh->do('SET client_min_messages=warning');
my $source_ddl = <do($source_ddl), "create table" );
ok( $ret = $dbh->do(q| INSERT INTO sqlt_test_foo (bar) VALUES ('buzz') |), "insert data" );
cmp_ok( $ret, '==', 1, "one row inserted" );
my $target_ddl = <new(
no_comments => 1,
parser => 'SQL::Translator::Parser::PostgreSQL',
)->translate(\$source_ddl);
my $target_sqlt = SQL::Translator->new(
no_comments => 1,
parser => 'SQL::Translator::Parser::PostgreSQL',
)->translate(\$target_ddl);
my $table = $target_sqlt->get_table('sqlt_test_fluff');
$table->extra( renamed_from => 'sqlt_test_foo' );
my $field = $table->get_field('biff');
$field->extra( renamed_from => 'bar' );
my @diff = SQL::Translator::Diff->new({
output_db => 'PostgreSQL',
source_schema => $source_sqlt,
target_schema => $target_sqlt,
})->compute_differences->produce_diff_sql;
foreach my $line (@diff) {
$line =~ s/\n//g;
next if $line =~ /^--/;
lives_ok { $dbh->do($line) } "$line";
}
ok ( $ret = $dbh->selectall_arrayref(q(SELECT biff FROM sqlt_test_fluff), { Slice => {} }), "query DB for data" );
cmp_ok( scalar(@$ret), '==', 1, "Got 1 row");
cmp_ok( $ret->[0]->{biff}, 'eq', 'buzz', "col biff has value buzz" );
# Make sure Test::PostgreSQL can kill Pg
undef $dbh if $pg_tst;
END {
if ($dbh && !$pg_tst) {
$dbh->do("drop table if exists sqlt_test_$_") foreach qw(foo fluff);
}
elsif( $pg_tst ) {
# do the teardown ourselves, work around RT#108460
local $?;
$pg_tst->stop;
1;
}
}
done_testing;
SQL-Translator-0.11024/t/36-filters.t 0000644 0001750 0001750 00000010545 12163313615 016317 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
#=============================================================================
# Test Package based filters that oks when called.
package SQL::Translator::Filter::Ok;
use strict;
sub filter { Test::More::pass(
'Filter called with args: ' . join ', ', @_
) }
# Hack to allow sqlt to see our module as it wasn't loaded from a .pm
$INC{'SQL/Translator/Filter/Ok.pm'} = 'lib/SQL/Translator/Filter/Ok.pm';
#=============================================================================
# SQL::Translator::Filter::HelloWorld - Test filter in a package
package # hide from cpan
SQL::Translator::Filter::HelloWorld;
use strict;
sub filter {
my ($schema,%args) = (shift,@_);
my $greeting = $args{greeting} || "Hello";
my $newtable = "${greeting}World";
$schema->add_table( name => $newtable );
}
# Hack to allow sqlt to see our module as it wasn't loaded from a .pm
$INC{'SQL/Translator/Filter/HelloWorld.pm'}
= 'lib/SQL/Translator/Filter/HelloWorld.pm';
#=============================================================================
package main;
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
BEGIN {
maybe_plan(16, 'Template 2.20', 'Test::Differences',
'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::YAML')
}
use Test::Differences;
use SQL::Translator;
my $in_yaml = qq{--- #YAML:1.0
schema:
tables:
person:
name: person
fields:
first_name:
data_type: foovar
name: First_Name
};
my $sqlt_version = $SQL::Translator::VERSION;
my $ans_yaml = qq{---
schema:
procedures: {}
tables:
GdayWorld:
constraints: []
fields: {}
indices: []
name: GdayWorld
options: []
order: 3
HelloWorld:
constraints: []
fields: {}
indices: []
name: HelloWorld
options: []
order: 2
PERSON:
constraints: []
fields:
first_name:
data_type: foovar
default_value: ~
is_nullable: 1
is_primary_key: 0
is_unique: 0
name: first_name
order: 1
size:
- 0
indices: []
name: PERSON
options: []
order: 1
triggers: {}
views: {}
translator:
add_drop_table: 0
filename: ~
no_comments: 0
parser_args: {}
parser_type: SQL::Translator::Parser::YAML
producer_args: {}
producer_type: SQL::Translator::Producer::YAML
show_warnings: 1
trace: 0
version: $sqlt_version
};
# Parse the test XML schema
my $obj;
$obj = SQL::Translator->new(
debug => 0,
show_warnings => 1,
parser => "YAML",
data => $in_yaml,
to => "YAML",
filters => [
# Check they get called ok
sub {
pass("Filter 1 called");
isa_ok($_[0],"SQL::Translator::Schema", "Filter 1, arg0 ");
is( $#_, 0, "Filter 1, got no args");
},
sub {
pass("Filter 2 called");
isa_ok($_[0],"SQL::Translator::Schema", "Filter 2, arg0 ");
is( $#_, 0, "Filter 2, got no args");
},
# Sub filter with args
[ sub {
pass("Filter 3 called");
isa_ok($_[0],"SQL::Translator::Schema", "Filter 3, arg0 ");
is( $#_, 2, "Filter 3, go 2 args");
is( $_[1], "hello", "Filter 3, arg1=hello");
is( $_[2], "world", "Filter 3, arg2=world");
},
hello => "world" ],
# Uppercase all the table names.
sub {
my $schema = shift;
foreach ($schema->get_tables) {
$_->name(uc $_->name);
}
},
# lowercase all the field names.
sub {
my $schema = shift;
foreach ( map { $_->get_fields } $schema->get_tables ) {
$_->name(lc $_->name);
}
},
# Filter from SQL::Translator::Filter::*
'Ok',
[ 'HelloWorld' ],
[ 'HelloWorld', greeting => 'Gday' ],
],
) or die "Failed to create translator object: ".SQL::Translator->error;
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
is $obj->error, '' ,"No errors";
ok $out ne "" ,"Produced something!";
eq_or_diff $out, $ans_yaml ,"Output looks right";
SQL-Translator-0.11024/t/23json.t 0000644 0001750 0001750 00000021646 13154007105 015536 0 ustar ilmari ilmari use warnings;
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
use FindBin '$Bin';
BEGIN {
maybe_plan(
2,
'SQL::Translator::Parser::SQLite',
'SQL::Translator::Producer::JSON',
);
}
my $sqlt_version = $SQL::Translator::VERSION;
use JSON;
my $json = from_json(<;
my $tr = SQL::Translator->new(
parser => 'SQLite',
producer => 'JSON',
producer_args => {
canonical => 1,
pretty => 1,
},
data => $data,
);
my $out;
lives_ok { $out = from_json($tr->translate) } 'Translate SQLite to JSON';
is_deeply( $out, $json, 'JSON matches expected' );
SQL-Translator-0.11024/t/71-generator-sql_server.t 0000644 0001750 0001750 00000001645 12421750467 021027 0 ustar ilmari ilmari use strict;
use warnings;
use Test::More;
use SQL::Translator::Generator::DDL::SQLServer;
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Table;
my $shim = SQL::Translator::Generator::DDL::SQLServer->new();
is $shim->field(SQL::Translator::Schema::Field->new(
name => 'lol',
data_type => 'int',
)), '[lol] int NULL', 'simple field is generated correctly';
is $shim->field(SQL::Translator::Schema::Field->new(
name => 'nice',
data_type => 'varchar',
size => 10,
)), '[nice] varchar(10) NULL', 'sized field is generated correctly';
my $table = SQL::Translator::Schema::Table->new(
name => 'mytable',
);
$table->add_field(
name => 'myenum',
data_type => 'enum',
extra => { list => [qw(foo ba'r)] },
);
like $shim->table($table),
qr/\b\QCONSTRAINT [myenum_chk] CHECK ([myenum] IN ('foo','ba''r'))\E/,
'enum constraint is generated and escaped correctly';
done_testing;
SQL-Translator-0.11024/t/49xml-to-pg-samefield.t 0000644 0001750 0001750 00000002315 12163313615 020345 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::PostgreSQL');
}
my $xmlfile = "$Bin/data/xml/samefield.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
show_warnings => 1,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my $sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'PostgreSQL',
filename => $xmlfile,
) or die $sqlt->error;
is($sql, << "SQL");
DROP TABLE "one" CASCADE;
CREATE TABLE "one" (
"same" character varying(100) DEFAULT 'hello' NOT NULL
);
DROP TABLE "two" CASCADE;
CREATE TABLE "two" (
"same" character varying(100) DEFAULT 'hello' NOT NULL
);
SQL
### This doesnt work, cant add a field with a name thats already there, so how do we test dupe field names?!
# my $table = $sqlt->schema->get_table('two');
# $table->add_field(name => 'same');
# print Dumper($table);
# $sql = SQL::Translator::Producer::PostgreSQL::produce($sqlt);
# print ">>$sql<<\n";
SQL-Translator-0.11024/t/11normalize.t 0000644 0001750 0001750 00000001066 12163313615 016561 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator::Utils qw(normalize_name);
my %tests = (
"silly field (with random characters)" => "silly_field_with_random_characters",
"444" => "_444",
"hello, world" => "hello_world",
"- 9s80 qwehjf 4r" => "_9s80_qwehjf_4r",
);
plan tests => scalar(keys %tests) + 1;
# Superfluous test, but that's ok
use_ok("SQL::Translator::Utils");
for my $test (keys %tests) {
is(normalize_name($test) => $tests{$test},
"normalize_name('$test') => '$tests{$test}'");
}
SQL-Translator-0.11024/t/mysql-sqlite-translate.t 0000644 0001750 0001750 00000004063 12163313615 021056 0 ustar ilmari ilmari #!/usr/bin/perl
use warnings;
use strict;
use Test::More;
use_ok( "SQL::Translator" );
use_ok( "SQL::Translator::Parser::MySQL" );
use_ok( "SQL::Translator::Producer::SQLite" );
# This test reproduces a bug in SQL::Translator::Producer::SQLite.
#
# When tables are created their names are not added to %global_names, and
# may be duplicated.
#
# SQL::Translator::Producer::SQLite version 1.59.
# compliments of SymKat
my $output = SQL::Translator
->new( data => do { local $/; })
->translate( from => 'MySQL', to => 'SQLite' );
sub find_table_names {
my ( $content ) = @_;
my @tables;
for my $line ( split /\n/, $content ) {
if ($content =~ /CREATE (?:INDEX|UNIQUE|TABLE| ){0,6} ([^\s]+)/gc) {
push @tables, $1;
}
}
return @tables;
}
sub has_dupes {
my ( @list ) = @_;
my %hist;
for my $elem ( @list ) {
return 0 if exists $hist{$elem};
$hist{$elem} = 1;
}
return 1;
}
ok ( has_dupes( find_table_names( $output ) ) );
done_testing;
__DATA__
CREATE TABLE `ip_address` (
`id` int(11) NOT NULL auto_increment,
`ip_address` varchar(255) NOT NULL,
`machine_id` int(11) default NULL,
`primary_machine_id` int(11) default NULL,
`secondary_machine_id` int(11) default NULL,
`tertiary_machine_id` int(11) default NULL,
`protocol` enum('ipv4','ipv6') NOT NULL default 'ipv4',
`shared` tinyint(1) NOT NULL default '1',
PRIMARY KEY (`id`),
UNIQUE KEY `ip_address` (`ip_address`),
KEY `machine_id` (`machine_id`),
KEY `primary_machine_id` (`primary_machine_id`),
KEY `secondary_machine_id` (`secondary_machine_id`),
KEY `tertiary_machine_id` (`tertiary_machine_id`),
CONSTRAINT `ip_address_ibfk_1` FOREIGN KEY (`machine_id`) REFERENCES `machine` (`id`),
CONSTRAINT `ip_address_ibfk_2` FOREIGN KEY (`primary_machine_id`) REFERENCES `machine` (`id`),
CONSTRAINT `ip_address_ibfk_3` FOREIGN KEY (`secondary_machine_id`) REFERENCES `machine` (`id`),
CONSTRAINT `ip_address_ibfk_4` FOREIGN KEY (`tertiary_machine_id`) REFERENCES `machine` (`id`)
);
SQL-Translator-0.11024/t/63-spacial-pgsql.t 0000644 0001750 0001750 00000017140 12612463104 017403 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
use FindBin qw/$Bin/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(10,
'SQL::Translator::Producer::PostgreSQL',
'Test::Differences',
)
}
use Test::Differences;
use SQL::Translator;
my $options = { quote_identifiers => 1 };
my $schema = SQL::Translator::Schema->new( name => 'myschema' );
my $table = SQL::Translator::Schema::Table->new( name => 'my\'table', schema => $schema );
my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'geometry',
extra => {
dimensions => 2,
geometry_type => 'POINT',
srid => -1
},
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field1_sql = SQL::Translator::Producer::PostgreSQL::create_field($field1, $options);
is($field1_sql, '"myfield" geometry', 'Create geometry field works');
my $field1_geocol = SQL::Translator::Producer::PostgreSQL::add_geometry_column($field1, $options);
is($field1_geocol, "INSERT INTO geometry_columns VALUES ('','myschema','my''table','myfield','2','-1','POINT')", 'Add geometry column works');
my $field1_geocon = SQL::Translator::Producer::PostgreSQL::add_geometry_constraints($field1, $options);
is($field1_geocon, qq[ALTER TABLE "my'table" ADD CONSTRAINT "enforce_dims_myfield" CHECK ((ST_NDims("myfield") = 2));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_srid_myfield" CHECK ((ST_SRID("myfield") = -1));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_geotype_myfield" CHECK ((GeometryType("myfield") = 'POINT'::text OR "myfield" IS NULL))],
'Add geometry constraints works');
my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 25,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field1,
$field2, $options);
is($alter_field, qq[DELETE FROM geometry_columns WHERE f_table_schema = 'myschema' AND f_table_name = 'my''table' AND f_geometry_column = 'myfield';
ALTER TABLE "my'table" DROP CONSTRAINT "enforce_dims_myfield";
ALTER TABLE "my'table" DROP CONSTRAINT "enforce_srid_myfield";
ALTER TABLE "my'table" DROP CONSTRAINT "enforce_geotype_myfield";
ALTER TABLE "my'table" ALTER COLUMN "myfield" SET NOT NULL;
ALTER TABLE "my'table" ALTER COLUMN "myfield" TYPE character varying(25)],
'Alter field geometry to non geometry works');
my $alter_field2 = SQL::Translator::Producer::PostgreSQL::alter_field($field2,
$field1, $options);
is($alter_field2, qq[ALTER TABLE "my'table" ALTER COLUMN "myfield" DROP NOT NULL;
ALTER TABLE "my'table" ALTER COLUMN "myfield" TYPE geometry;
INSERT INTO geometry_columns VALUES ('','myschema','my''table','myfield','2','-1','POINT');
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_dims_myfield" CHECK ((ST_NDims("myfield") = 2));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_srid_myfield" CHECK ((ST_SRID("myfield") = -1));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_geotype_myfield" CHECK ((GeometryType("myfield") = 'POINT'::text OR "myfield" IS NULL))],
'Alter field non geometry to geometry works');
$field1->name('field3');
my $add_field = SQL::Translator::Producer::PostgreSQL::add_field($field1, $options);
is($add_field, qq[ALTER TABLE "my'table" ADD COLUMN "field3" geometry;
INSERT INTO geometry_columns VALUES ('','myschema','my''table','field3','2','-1','POINT');
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_dims_field3" CHECK ((ST_NDims("field3") = 2));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_srid_field3" CHECK ((ST_SRID("field3") = -1));
ALTER TABLE "my'table" ADD CONSTRAINT "enforce_geotype_field3" CHECK ((GeometryType("field3") = 'POINT'::text OR "field3" IS NULL))],
'Add geometry field works');
my $drop_field = SQL::Translator::Producer::PostgreSQL::drop_field($field1, $options);
is($drop_field, qq[ALTER TABLE "my'table" DROP COLUMN "field3";
DELETE FROM geometry_columns WHERE f_table_schema = 'myschema' AND f_table_name = 'my''table' AND f_geometry_column = 'field3'],
'Drop geometry field works');
$table->add_field($field1);
my $field4 = SQL::Translator::Schema::Field->new( name => 'field4',
table => $table,
data_type => 'geography',
extra => {
geography_type => 'POINT',
srid => -1
},
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
$table->add_field($field4);
my ($create_table,$fks) = SQL::Translator::Producer::PostgreSQL::create_table($table, $options);
is($create_table,qq[--
-- Table: my'table
--
CREATE TABLE "my'table" (
"field3" geometry,
"field4" geography(POINT,-1),
CONSTRAINT "enforce_dims_field3" CHECK ((ST_NDims("field3") = 2)),
CONSTRAINT "enforce_srid_field3" CHECK ((ST_SRID("field3") = -1)),
CONSTRAINT "enforce_geotype_field3" CHECK ((GeometryType("field3") = 'POINT'::text OR "field3" IS NULL))
);
INSERT INTO geometry_columns VALUES ('','myschema','my''table','field3','2','-1','POINT')],
'Create table with geometry works.');
my $rename_table = SQL::Translator::Producer::PostgreSQL::rename_table($table, "table2", $options);
is($rename_table,qq[ALTER TABLE "my'table" RENAME TO "table2";
DELETE FROM geometry_columns WHERE f_table_schema = 'myschema' AND f_table_name = 'my''table' AND f_geometry_column = 'field3';
INSERT INTO geometry_columns VALUES ('','myschema','table2','field3','2','-1','POINT')],
'Rename table with geometry works.');
$table->name("table2");
my $drop_table = SQL::Translator::Producer::PostgreSQL::drop_table($table, $options);
is($drop_table, qq[DROP TABLE "table2" CASCADE;
DELETE FROM geometry_columns WHERE f_table_schema = 'myschema' AND f_table_name = 'table2' AND f_geometry_column = 'field3'],
'Drop table with geometry works.');
SQL-Translator-0.11024/t/09sqlt-diagram.t 0000644 0001750 0001750 00000001460 12617123640 017154 0 ustar ilmari ilmari use strict;
use warnings;
use File::Spec::Functions qw(catfile updir tmpdir);
use File::Temp qw(mktemp);
use FindBin qw($Bin);
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use Text::ParseWords qw(shellwords);
BEGIN {
maybe_plan(
3,
'GD',
'Graph::Directed',
'SQL::Translator::Producer::Diagram',
'SQL::Translator::Parser::MySQL',
);
}
my @script = qw(script sqlt-diagram);
my @data = qw(data mysql create2.sql);
my $sqlt_diagram = catfile($Bin, updir, @script);
my $test_data = catfile($Bin, @data);
my $tmp = mktemp('sqlXXXXX');
ok(-e $sqlt_diagram);
my @cmd = ($^X, shellwords($ENV{HARNESS_PERL_SWITCHES}||''), $sqlt_diagram, "-d", "MySQL", "-o", $tmp, $test_data);
eval { system(@cmd); };
ok(!$@ && ($? == 0));
ok(-e $tmp);
eval { unlink $tmp; };
SQL-Translator-0.11024/t/08postgres-to-mysql.t 0000644 0001750 0001750 00000012376 12224545240 020225 0 ustar ilmari ilmari #!/usr/local/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator;
use Data::Dumper;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(1,
'SQL::Translator::Parser::PostgreSQL',
'SQL::Translator::Producer::MySQL',
);
}
my $create = q|
-- The cvterm module design is based on the ontology
-- ================================================
-- TABLE: cv
-- ================================================
create table cv (
cv_id serial not null,
primary key (cv_id),
cvname varchar not null,
cvdefinition text,
unique(cvname)
);
-- ================================================
-- TABLE: cvterm
-- ================================================
create table cvterm (
cvterm_id serial not null,
primary key (cvterm_id),
cv_id int not null,
foreign key (cv_id) references cv (cv_id),
name varchar(255) not null,
termdefinition text,
dbxref_id int,
foreign key (dbxref_id) references dbxref (dbxref_id),
unique(termname, cv_id)
);
create index cvterm_idx1 on cvterm (cv_id);
-- the primary dbxref for this term. Other dbxrefs may be cvterm_dbxref
-- The unique key on termname, termtype_id ensures that all terms are
-- unique within a given cv
COMMENT ON TABLE cvterm IS
'A term, class or concept within an ontology
or controlled vocabulary';
COMMENT ON COLUMN cvterm.cv_id IS
'The cv/ontology/namespace to which this cvterm belongs';
COMMENT ON COLUMN cvterm.name IS
'A concise human-readable name describing the meaning of the cvterm';
COMMENT ON COLUMN cvterm.termdefinition IS
'A human-readable text definition';
COMMENT ON COLUMN cvterm.dbxref_id IS
'A human-readable text definition';
COMMENT ON INDEX cvterm_c1 IS
'the OBO identifier is globally unique';
-- ================================================
-- TABLE: cvrelationship
-- ================================================
create table cvrelationship (
cvrelationship_id serial not null,
primary key (cvrelationship_id),
reltype_id int not null,
foreign key (reltype_id) references cvterm (cvterm_id),
subjterm_id int not null,
foreign key (subjterm_id) references cvterm (cvterm_id),
objterm_id int not null,
foreign key (objterm_id) references cvterm (cvterm_id),
unique(reltype_id, subjterm_id, objterm_id)
);
create index cvrelationship_idx1 on cvrelationship (reltype_id);
create index cvrelationship_idx2 on cvrelationship (subjterm_id);
create index cvrelationship_idx3 on cvrelationship (objterm_id);
-- ================================================
-- TABLE: cvpath
-- ================================================
create table cvpath (
cvpath_id serial not null,
primary key (cvpath_id),
reltype_id int,
foreign key (reltype_id) references cvterm (cvterm_id),
subjterm_id int not null,
foreign key (subjterm_id) references cvterm (cvterm_id),
objterm_id int not null,
foreign key (objterm_id) references cvterm (cvterm_id),
cv_id int not null,
foreign key (cv_id) references cv (cv_id),
pathdistance int,
unique (subjterm_id, objterm_id)
);
create index cvpath_idx1 on cvpath (reltype_id);
create index cvpath_idx2 on cvpath (subjterm_id);
create index cvpath_idx3 on cvpath (objterm_id);
create index cvpath_idx4 on cvpath (cv_id);
-- ================================================
-- TABLE: cvtermsynonym
-- ================================================
create table cvtermsynonym (
cvterm_id int not null,
foreign key (cvterm_id) references cvterm (cvterm_id),
termsynonym varchar(255) not null,
unique(cvterm_id, termsynonym)
);
-- The table "cvterm_synonym" doesn't exist, so
-- creating an index on it screws things up!
-- create index cvterm_synonym_idx1 on cvterm_synonym (cvterm_id);
-- ================================================
-- TABLE: cvterm_dbxref
-- ================================================
create table cvterm_dbxref (
cvterm_dbxref_id serial not null,
primary key (cvterm_dbxref_id),
cvterm_id int not null,
foreign key (cvterm_id) references cvterm (cvterm_id),
dbxref_id int not null,
foreign key (dbxref_id) references dbxref (dbxref_id),
unique(cvterm_id, dbxref_id)
);
create index cvterm_dbxref_idx1 on cvterm_dbxref (cvterm_id);
create index cvterm_dbxref_idx2 on cvterm_dbxref (dbxref_id);
-- ================================================
-- TABLE: cvterm_geom
-- ================================================
create table cvterm_geom (
cvterm_geom_id serial not null,
primary key (cvterm_geom_id),
cvterm_id int not null,
foreign key (cvterm_id) references cvterm (cvterm_id),
cvterm_geom geometry,
constraint "enforce_dims_cvterm_geom" CHECK ((st_ndims(cvterm_geom) = 2)),
constraint "enforce_srid_cvterm_geom" CHECK ((st_srid(cvterm_geom) = -1)),
constraint "enforce_geotype_cvterm_geom" CHECK ((geometrytype(cvterm_geom) = 'POINT'::text OR cvterm_geom IS NULL)),
unique(cvterm_id)
);
|;
my $tr = SQL::Translator->new(
parser => "PostgreSQL",
producer => "MySQL"
);
ok( $tr->translate(\$create), 'Translate PG2My' ) or diag($tr->error);
SQL-Translator-0.11024/t/18ttschema-producer.t 0000644 0001750 0001750 00000004310 12163313615 020214 0 ustar ilmari ilmari #!/usr/bin/perl -w
# vim:filetype=perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
use FindBin qw/$Bin/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(6,
'SQL::Translator::Parser::XML::SQLFairy',
'Template 2.20',
'Test::Differences'
);
}
use Test::Differences;
use SQL::Translator;
use SQL::Translator::Producer::TTSchema;
# Main test. Template whole schema and test tt_vars
{
my $obj;
$obj = SQL::Translator->new(
show_warnings => 0,
from => "XML-SQLFairy",
filename => "$Bin/data/xml/schema.xml",
to => "TTSchema",
producer_args => {
ttfile => "$Bin/data/template/basic.tt",
tt_vars => {
foo => 'bar',
hello => 'world',
},
},
);
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
ok $out ne "" ,"Produced something!";
eq_or_diff
$out,
do { local (@ARGV, $/) = "$Bin/data/template/testresult_basic.txt"; <> },
"Output looks right"
;
}
# Test passing of Template config
{
my $tmpl = q{
[%- FOREACH table = schema.get_tables %]
Table: $table
[%- END %]};
my $obj;
$obj = SQL::Translator->new(
show_warnings => 0,
from => "XML-SQLFairy",
filename => "$Bin/data/xml/schema.xml",
to => "TTSchema",
producer_args => {
ttfile => \$tmpl,
tt_conf => {
INTERPOLATE => 1,
},
tt_vars => {
foo => 'bar',
hello => 'world',
},
},
);
my $out;
lives_ok { $out = $obj->translate; } "Translate ran";
ok $out ne "" ,"Produced something!";
local $/ = undef; # slurp
eq_or_diff $out, q{
Table: Basic
Table: Another}
,"Output looks right";
}
SQL-Translator-0.11024/t/44-xml-to-db2-array.t 0000644 0001750 0001750 00000003751 12163313615 017650 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::DB2');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my @sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'DB2',
filename => $xmlfile,
) or die $sqlt->error;
my $want = [ 'DROP TABLE Basic;',
q|CREATE TABLE Basic (
id INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1) NOT NULL,
title VARCHAR(100) NOT NULL DEFAULT 'hello',
description VARCHAR(0) DEFAULT '',
email VARCHAR(500),
explicitnulldef VARCHAR(0),
explicitemptystring VARCHAR(0) DEFAULT '',
emptytagdef VARCHAR(0) DEFAULT '',
another_id INTEGER DEFAULT 2,
timest TIMESTAMP,
PRIMARY KEY (id),
CONSTRAINT emailuniqueindex UNIQUE (email),
CONSTRAINT very_long_index_name_on_title_field_which_should_be_truncated_for_various_rdbms UNIQUE (title)
);|,
'DROP TABLE Another;',
q|CREATE TABLE Another (
id INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1) NOT NULL,
num NUMERIC(10,2),
PRIMARY KEY (id)
);|,
'ALTER TABLE Basic ADD FOREIGN KEY (another_id) REFERENCES Another(id);',
'CREATE INDEX titleindex ON Basic ( title );',
'CREATE VIEW email_list AS
SELECT email FROM Basic WHERE (email IS NOT NULL);',
'CREATE TRIGGER foo_trigger after insert ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified=timestamp();',
'CREATE TRIGGER bar_trigger before insert, update ON Basic REFERENCING OLD AS oldrow NEW AS newrow FOR EACH ROW MODE DB2SQL update modified2=timestamp();',
];
is_deeply(\@sql, $want, 'Got correct DB2 statements in list context');
SQL-Translator-0.11024/t/60roundtrip.t 0000644 0001750 0001750 00000014674 12421750412 016621 0 ustar ilmari ilmari #!/usr/bin/perl
use warnings;
use strict;
use Test::More qw/no_plan/;
use Test::Exception;
use Test::Differences;
use FindBin qw/$Bin/;
use SQL::Translator;
use SQL::Translator::Utils qw/ddl_parser_instance/;
### Set $ENV{SQLTTEST_RT_DEBUG} = 1 for more output
# What tests to run - parser/producer name, and optional args
my $plan = [
{
engine => 'XML',
req => 'XML::LibXML 1.69',
no_grammar => 1,
},
{
engine => 'YAML',
no_grammar => 1,
},
{
engine => 'SQLite',
producer_args => {},
parser_args => {},
},
{
engine => 'MySQL',
producer_args => {},
parser_args => {},
},
{
engine => 'MySQL',
name => 'MySQL 5.0',
producer_args => { mysql_version => 5 },
parser_args => { mysql_parser_version => 5 },
},
{
engine => 'MySQL',
name => 'MySQL 5.1',
producer_args => { mysql_version => '5.1' },
parser_args => { mysql_parser_version => '5.1' },
},
{
engine => 'PostgreSQL',
producer_args => {},
parser_args => {},
},
{
engine => 'SQLServer',
producer_args => {},
parser_args => {},
},
{
engine => 'Oracle',
producer_args => {},
parser_args => {},
todo_cmp => "auto-increment triggers aren't detected",
},
{
engine => 'Sybase',
producer_args => {},
parser_args => {},
todo => 'Needs volunteers',
},
{
engine => 'DB2',
producer_args => {},
parser_args => {},
todo => 'Needs volunteers',
},
# There is no Access producer
# {
# engine => 'Access',
# producer_args => {},
# parser_args => {},
# },
];
# This data file has the right mix of table/view/procedure/trigger
# definitions, and lists enough quirks to trip up most combos
my $base_file = "$Bin/data/roundtrip_autogen.yaml";
open (my $base_fh, '<', $base_file) or die "$base_file: $!";
my $base_t = SQL::Translator->new;
$base_t->$_ (1) for qw/add_drop_table no_comments quote_identifiers/;
my $base_schema = $base_t->translate (
parser => 'YAML',
data => do { local $/; <$base_fh>; },
) or die $base_t->error;
#assume there is at least one table
my $string_re = {
XML => qr/\s* qr/\A---\n.+tables\:/s,
SQL => qr/^\s*CREATE TABLE/m,
};
for my $args (@$plan) {
SKIP: {
$args->{name} ||= $args->{engine};
my @req = ref $args->{req} ? @{$args->{req}} : $args->{req}||();
my @missing;
for (@req) {
eval "use $_ ()";
push @missing, $_ if ($@);
}
if (@missing) {
skip sprintf ('Need %s for %s roundtrip test',
join (', ', @missing),
$args->{name},
);
}
use_ok("SQL::Translator::Producer::$args->{engine}");
use_ok("SQL::Translator::Parser::$args->{engine}");
ok(ddl_parser_instance($args->{engine}), 'Got proper parser instance')
unless $args->{no_grammar};
TODO: {
local $TODO = $args->{todo} if $args->{todo};
no warnings 'once';
# silence PR::D from spewing on STDERR
local $::RD_ERRORS = 0 if $args->{todo};
local $::RD_WARN = 0 if $args->{todo};
local $::RD_HINT = 0 if $args->{todo};
lives_ok (
sub { check_roundtrip ($args, $base_schema, $args->{todo_cmp}) },
"Round trip for $args->{name} did not throw an exception",
);
}
}
}
sub check_roundtrip {
my ($args, $base_schema, $todo_cmp) = @_;
my $base_t = $base_schema->translator;
# create some output from the submitted schema
my $base_out = $base_t->translate (
data => $base_schema,
producer => $args->{engine},
producer_args => $args->{producer_args},
);
like (
$base_out,
$string_re->{$args->{engine}} || $string_re->{SQL},
"Received some meaningful output from the first $args->{name} production",
) or do {
diag ( _gen_diag ($base_t->error) );
return;
};
# parse the sql back
my $parser_t = SQL::Translator->new;
$parser_t->$_ (1) for qw/add_drop_table no_comments quote_identifiers/;
my $mid_schema = $parser_t->translate (
data => $base_out,
parser => $args->{engine},
parser_args => $args->{parser_args},
);
isa_ok ($mid_schema, 'SQL::Translator::Schema', "First $args->{name} parser pass produced a schema:")
or do {
diag (_gen_diag ( $parser_t->error, $base_out ) );
my $i;
note join ("\n" . ( '=' x 76) . "\n",
'Unparseable DDL:',
(join ("\n", map { ++$i . ":\t$_" } split /\n/, $base_out) ),
''
);
return;
};
# schemas should be comparable at least as far as table/field numbers go
is_deeply (
_get_table_info ($mid_schema->get_tables),
_get_table_info ($base_schema->get_tables),
"Schema tables generally match afer $args->{name} parser trip",
) or (diag(explain _get_table_info($mid_schema->get_tables)), return);
# and produce sql once again
# Producing a schema with a Translator different from the one the schema was generated
# from does not work. This is arguably a bug, 61translator_agnostic.t works with that
# my $producer_t = SQL::Translator->new;
# $producer_t->$_ (1) for qw/add_drop_table no_comments/;
# my $rt_sql = $producer_t->translate (
# data => $mid_schema,
# producer => $args->{engine},
# producer_args => $args->{producer_args},
# );
my $rt_out = $parser_t->translate (
data => $mid_schema,
producer => $args->{engine},
producer_args => $args->{producer_args},
);
like (
$rt_out,
$string_re->{$args->{engine}} || $string_re->{SQL},
"Received some meaningful output from the second $args->{name} production",
) or do {
diag ( _gen_diag ( $parser_t->error ) );
return;
};
local $TODO = $todo_cmp;
# the two sql strings should be identical
my $msg = "$args->{name} SQL roundtrip successful - SQL statements match";
$ENV{SQLTTEST_RT_DEBUG}
? eq_or_diff ($rt_out, $base_out, $msg)
: ok ($rt_out eq $base_out, $msg)
;
}
sub _get_table_info {
my @tables = @_;
my @info;
for my $t (@tables) {
push @info, {
name => $t->name,
fields => [
map { $_->name } ($t->get_fields),
],
};
}
return \@info;
}
# takes an error string and an optional output block
# returns the string conctenated with a line-numbered block for
# easier reading
sub _gen_diag {
my ($err, $out) = @_;
return 'Unknown error' unless $err;
if ($out and $ENV{SQLTTEST_RT_DEBUG}) {
my @lines;
for (split /\n/, $out) {
push @lines, sprintf ('%03d: %s',
scalar @lines + 1,
$_,
);
}
return "$err\n\n" . join ("\n", @lines);
}
return $err;
}
SQL-Translator-0.11024/t/31dumper.t 0000644 0001750 0001750 00000003124 12411012516 016044 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
# Test for Dumper producer
use strict;
use File::Temp 'tempfile';
use FindBin qw/$Bin/;
use IPC::Open3;
use SQL::Translator;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use Symbol qw(gensym);
use Text::ParseWords qw(shellwords);
BEGIN {
maybe_plan(
5,
'DBI',
'SQL::Translator::Parser::SQLite',
'SQL::Translator::Producer::Dumper'
);
}
my $db_user = 'nomar';
my $db_pass = 'gos0X!';
my $dsn = 'dbi:SQLite:dbname=/tmp/foo';
my $file = "$Bin/data/sqlite/create.sql";
my $t = SQL::Translator->new(
from => 'SQLite',
to => 'Dumper',
producer_args => {
skip => 'pet',
skiplike => '',
db_user => $db_user,
db_password => $db_pass,
dsn => $dsn,
}
);
my $output = $t->translate( $file );
ok( $output, 'Got dumper script' );
like( $output, qr{DBI->connect\(\s*'$dsn',\s*'$db_user',\s*'$db_pass',},
'Script contains correct DSN, db user and password' );
like( $output, qr/table_name\s*=>\s*'person',/, 'Found "person" table' );
unlike( $output, qr/table_name\s*=>\s*'pet',/, 'Skipped "pet" table' );
my ( $fh, $filename ) = tempfile( 'XXXXXXXX' );
print $fh $output;
close $fh or die "Can't close file '$filename': $!";
my $out;
my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}||''), '-cw', $filename );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
like( $res, qr/syntax OK/, 'Generated script syntax is OK' );
unlink $filename;
SQL-Translator-0.11024/t/72-sqlite-add-drop-fields.t 0000644 0001750 0001750 00000002525 12163313615 021103 0 ustar ilmari ilmari #!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 4;
use Test::Differences;
use SQL::Translator;
use SQL::Translator::Parser::SQLite;
use SQL::Translator::Diff;
ok my $version1 = SQL::Translator->new(from=>'SQLite')
->translate(\<new(from=>'SQLite')
->translate(\<new({
output_db => 'SQLite',
source_schema => $version1,
target_schema => $version2,
})->compute_differences->produce_diff_sql;
eq_or_diff($upgrade_sql, <<'## END OF DIFF', "Diff as expected");
-- Convert schema '' to '':;
BEGIN;
CREATE TEMPORARY TABLE Foo_temp_alter (
foo INTEGER PRIMARY KEY NOT NULL,
bar VARCHAR(10) NOT NULL,
baz VARCHAR(10),
doomed VARCHAR(10)
);
INSERT INTO Foo_temp_alter( foo, bar) SELECT foo, bar FROM Foo;
DROP TABLE Foo;
CREATE TABLE Foo (
foo INTEGER PRIMARY KEY NOT NULL,
bar VARCHAR(10) NOT NULL,
baz VARCHAR(10),
doomed VARCHAR(10)
);
INSERT INTO Foo SELECT foo, bar, baz, doomed FROM Foo_temp_alter;
DROP TABLE Foo_temp_alter;
COMMIT;
## END OF DIFF
SQL-Translator-0.11024/t/74-filename-arrayref.t 0000644 0001750 0001750 00000000640 12163313615 020235 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
# Test that the filename can be set with an ArrayRef as well as a Str.
#
use strict;
use SQL::Translator;
use Test::More tests => 2;
my $datafile = "t/data/mysql/Apache-Session-MySQL.sql";
my $tr0 = SQL::Translator->new(filename => $datafile);
my $tr1 = SQL::Translator->new(filename => [$datafile]);
ok($tr0, "filename takes a Str");
ok($tr1, "filename takes an ArrayRef");
SQL-Translator-0.11024/t/19sybase-parser.t 0000644 0001750 0001750 00000006647 12163313615 017363 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl ts=4 et:
#
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(41, 'SQL::Translator::Parser::Sybase');
SQL::Translator::Parser::Sybase->import('parse');
}
my $file = "$Bin/data/sybase/create.sql";
ok( -e $file, "File exists" );
my $data;
{
local $/;
open my $fh, "<$file" or die "Can't read file '$file': $!\n";
$data = <$fh>;
close $fh;
}
ok( $data, 'Data' );
my $t = SQL::Translator->new;
my $val = parse($t, $data);
is( $val, 1, 'Parse' );
my $schema = $t->schema;
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema' );
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 9, 'Nine tables' );
{
my $t = $schema->get_table( 'jdbc_function_escapes' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'jdbc_function_escapes', "Name = 'jdbc_function_escapes'" );
my @fields = $t->get_fields;
is( scalar @fields, 2, 'Two fields' );
is( $fields[0]->name, 'escape_name', "First field name is 'escape_name'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 40, "First field size is '40'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
is( $fields[1]->name, 'map_string', "Second field name is 'map_string'" );
is( $fields[1]->data_type, 'varchar', "Second field is 'varchar'" );
is( $fields[1]->size, 40, "Second field size is '40'" );
is( $fields[1]->is_nullable, 0, "Second field cannot be null" );
}
{
my $t = $schema->get_table( 'spt_jtext' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'spt_jtext', "Name = 'spt_jtext'" );
my @fields = $t->get_fields;
is( scalar @fields, 2, 'Two fields' );
is( $fields[0]->name, 'mdinfo', "First field name is 'mdinfo'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 30, "First field size is '30'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
is( $fields[1]->name, 'value', "Second field name is 'value'" );
is( $fields[1]->data_type, 'text', "Second field is 'text'" );
is( $fields[1]->size, 0, "Second field size is '0'" );
is( $fields[1]->is_nullable, 0, "Second field cannot be null" );
my @constraints = $t->get_constraints;
is( scalar @constraints, 1, 'One constraint' );
is( $constraints[0]->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $constraints[0]->fields), 'mdinfo', 'On "mdinfo"' );
}
{
my $t = $schema->get_table( 'spt_mda' );
isa_ok( $t, 'SQL::Translator::Schema::Table', 'Table' );
is( $t->name, 'spt_mda', "Name = 'spt_mda'" );
my @fields = $t->get_fields;
is( scalar @fields, 7, 'Seven fields' );
is( $fields[0]->name, 'mdinfo', "First field name is 'mdinfo'" );
is( $fields[0]->data_type, 'varchar', "First field is 'varchar'" );
is( $fields[0]->size, 30, "First field size is '30'" );
is( $fields[0]->is_nullable, 0, "First field cannot be null" );
my @constraints = $t->get_constraints;
is( scalar @constraints, 1, 'One constraint' );
is( $constraints[0]->type, UNIQUE, 'Constraint is UNIQUE' );
is( join(',', $constraints[0]->fields),
'mdinfo,mdaver_end,srvver_end', 'On "mdinfo,mdaver_end,srvver_end"' );
}
SQL-Translator-0.11024/t/sqlite-rename-field.t 0000644 0001750 0001750 00000003273 12375136713 020257 0 ustar ilmari ilmari #!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use DBI;
use SQL::Translator;
use SQL::Translator::Parser::SQLite;
use SQL::Translator::Diff;
eval "use DBD::SQLite";
plan skip_all => "DBD::SQLite required" if $@;
my ( $dbh , $ddl, $ret );
lives_ok { $dbh = DBI->connect("dbi:SQLite:dbname=:memory:")} "dbi connect";
my $source_ddl = <do($source_ddl) } "create table";
lives_ok { $ret = $dbh->do(q| INSERT INTO Foo (bar) VALUES ('buzz') |) } "insert data";
cmp_ok( $ret, '==', 1, "one row inserted" );
my $target_ddl = <new(
no_comments => 1,
parser => 'SQL::Translator::Parser::SQLite',
)->translate(\$source_ddl);
my $target_sqlt = SQL::Translator->new(
no_comments => 1,
parser => 'SQL::Translator::Parser::SQLite',
)->translate(\$target_ddl);
my $table = $target_sqlt->get_table('Foo');
my $field = $table->get_field('biff');
$field->extra( renamed_from => 'bar' );
my @diff = SQL::Translator::Diff->new({
output_db => 'SQLite',
source_schema => $source_sqlt,
target_schema => $target_sqlt,
})->compute_differences->produce_diff_sql;
foreach my $line (@diff) {
$line =~ s/\n//g;
lives_ok { $dbh->do($line) || die } "$line";
}
lives_ok { $ret = $dbh->selectall_arrayref(q(SELECT biff FROM Foo), { Slice => {} }) } "query DB for data";
cmp_ok( scalar(@$ret), '==', 1, "Got 1 row");
cmp_ok( $ret->[0]->{biff}, 'eq', 'buzz', "col biff has value buzz" );
done_testing;
SQL-Translator-0.11024/t/13schema.t 0000644 0001750 0001750 00000075047 12372440725 016042 0 ustar ilmari ilmari #!/usr/bin/perl
# vim:set ft=perl:
$| = 1;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use SQL::Translator::Schema::Constants;
require_ok( 'SQL::Translator' );
require_ok( 'SQL::Translator::Schema' );
{
#
# Schema
#
my $schema = SQL::Translator::Schema->new(
name => 'foo',
database => 'MySQL',
);
isa_ok( $schema, 'SQL::Translator::Schema' );
is( $schema->name, 'foo', 'Schema name is "foo"' );
is( $schema->name('bar'), 'bar', 'Schema name changed to "bar"' );
is( $schema->database, 'MySQL', 'Schema database is "MySQL"' );
is( $schema->database('PostgreSQL'), 'PostgreSQL',
'Schema database changed to "PostgreSQL"' );
is( $schema->is_valid, undef, 'Schema not valid...' );
like( $schema->error, qr/no tables/i, '...because there are no tables' );
#
# $schema->add_*
#
my $foo_table = $schema->add_table(name => 'foo') or warn $schema->error;
isa_ok( $foo_table, 'SQL::Translator::Schema::Table', 'Table "foo"' );
my $bar_table = SQL::Translator::Schema::Table->new( name => 'bar' ) or
warn SQL::Translator::Schema::Table->error;
$bar_table = $schema->add_table( $bar_table );
isa_ok( $bar_table, 'SQL::Translator::Schema::Table', 'Table "bar"' );
is( $bar_table->name, 'bar', 'Add table "bar"' );
$schema = $bar_table->schema( $schema );
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema' );
is( $bar_table->name('foo'), undef,
q[Can't change name of table "bar" to "foo"...]);
like( $bar_table->error, qr/can't use table name/i,
q[...because "foo" exists] );
my $redundant_table = $schema->add_table(name => 'foo');
is( $redundant_table, undef, qq[Can't create another "foo" table...] );
like( $schema->error, qr/can't use table name/i,
'... because "foo" exists' );
$redundant_table = $schema->add_table(name => '');
is( $redundant_table, undef, qq[Can't add an anonymous table...] );
like( $schema->error, qr/No table name/i,
'... because it has no name ' );
$redundant_table = SQL::Translator::Schema::Table->new(name => '');
is( $redundant_table, undef, qq[Can't create an anonymous table] );
like( SQL::Translator::Schema::Table->error, qr/No table name/i,
'... because it has no name ' );
#
# $schema-> drop_table
#
my $dropped_table = $schema->drop_table($foo_table->name, cascade => 1);
isa_ok($dropped_table, 'SQL::Translator::Schema::Table', 'Dropped table "foo"' );
$schema->add_table($foo_table);
my $dropped_table2 = $schema->drop_table($foo_table, cascade => 1);
isa_ok($dropped_table2, 'SQL::Translator::Schema::Table', 'Dropped table "foo" by object' );
my $dropped_table3 = $schema->drop_table($foo_table->name, cascade => 1);
like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant table "foo"] );
$schema->add_table($foo_table);
#
# Table default new
#
is( $foo_table->name, 'foo', 'Table name is "foo"' );
is( "$foo_table", 'foo', 'Table stringifies to "foo"' );
is( $foo_table->is_valid, undef, 'Table "foo" is not yet valid' );
my $fields = $foo_table->get_fields;
is( scalar @{ $fields || [] }, 0, 'Table "foo" has no fields' );
like( $foo_table->error, qr/no fields/i, 'Error for no fields' );
is( $foo_table->comments, undef, 'No comments' );
#
# New table with args
#
my $person_table = $schema->add_table(
name => 'person',
comments => 'foo',
);
is( $person_table->name, 'person', 'Table name is "person"' );
is( $person_table->is_valid, undef, 'Table is not yet valid' );
is( $person_table->comments, 'foo', 'Comments = "foo"' );
is( join(',', $person_table->comments('bar')), 'foo,bar',
'Table comments = "foo,bar"' );
is( $person_table->comments, "foo\nbar", 'Table comments = "foo,bar"' );
#
# Field default new
#
my $f1 = $person_table->add_field(name => 'foo') or
warn $person_table->error;
isa_ok( $f1, 'SQL::Translator::Schema::Field', 'Field' );
is( $f1->name, 'foo', 'Field name is "foo"' );
is( $f1->full_name, 'person.foo', 'Field full_name is "person.foo"' );
is( "$f1", 'foo', 'Field stringifies to "foo"' );
is( $f1->data_type, '', 'Field data type is blank' );
is( $f1->size, 0, 'Field size is "0"' );
is( $f1->is_primary_key, '0', 'Field is_primary_key is false' );
is( $f1->is_nullable, 1, 'Field can be NULL' );
is( $f1->default_value, undef, 'Field default is undefined' );
is( $f1->comments, '', 'No comments' );
is( $f1->table, 'person', 'Field table is person' );
is( $f1->schema->database, 'PostgreSQL', 'Field schema shortcut works' );
my $f2 = SQL::Translator::Schema::Field->new (
name => 'f2',
comments => 'foo',
) or warn SQL::Translator::Schema::Field->error;
$f2 = $person_table->add_field( $f2 );
isa_ok( $f1, 'SQL::Translator::Schema::Field', 'f2' );
is( $f2->name, 'f2', 'Add field "f2"' );
is( $f2->is_nullable(0), 0, 'Field cannot be NULL' );
is( $f2->is_nullable(''), 0, 'Field cannot be NULL' );
is( $f2->is_nullable('0'), 0, 'Field cannot be NULL' );
is( $f2->default_value(''), '', 'Field default is empty string' );
is( $f2->comments, 'foo', 'Field comment = "foo"' );
is( join(',', $f2->comments('bar')), 'foo,bar',
'Field comment = "foo,bar"' );
is( $f2->comments, "foo\nbar", 'Field comment = "foo,bar"' );
$person_table = $f2->table( $person_table );
isa_ok( $person_table, 'SQL::Translator::Schema::Table', 'person_table' );
is( $f2->name('foo'), undef, q[Can't set field name of "f2" to "foo"...] );
like( $f2->error, qr/can't use field name/i, '...because name exists' );
my $redundant_field = $person_table->add_field(name => 'f2');
is( $redundant_field, undef, qq[Didn't create another "f2" field...] );
like( $person_table->error, qr/can't use field/i,
'... because it exists' );
$redundant_field = $person_table->add_field(name => '');
is( $redundant_field, undef, qq[Didn't add a "" field...] );
like( $person_table->error, qr/No field name/i,
'... because it has no name' );
$redundant_field = SQL::Translator::Schema::Field->new(name => '');
is( $redundant_field, undef, qq[Didn't create a "" field...] );
like( SQL::Translator::Schema::Field->error, qr/No field name/i,
'... because it has no name' );
my @fields = $person_table->get_fields;
is( scalar @fields, 2, 'Table "foo" has 2 fields' );
is( $fields[0]->name, 'foo', 'First field is "foo"' );
is( $fields[1]->name, 'f2', 'Second field is "f2"' );
is( join(",",$person_table->field_names), 'foo,f2',
'field_names is "foo,f2"' );
my $ci_field = $person_table->get_field('FOO', 'case_insensitive');
is( $ci_field->name, 'foo', 'Got field case-insensitively' );
#
# $table-> drop_field
#
my $dropped_field = $person_table->drop_field($f2->name, cascade => 1);
isa_ok($dropped_field, 'SQL::Translator::Schema::Field', 'Dropped field "f2"' );
$person_table->add_field($f2);
my $dropped_field2 = $person_table->drop_field($f2, cascade => 1);
isa_ok($dropped_field2, 'SQL::Translator::Schema::Field', 'Dropped field "f2" by object' );
my $dropped_field3 = $person_table->drop_field($f2->name, cascade => 1);
like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant field "f2"] );
$person_table->add_field($f2);
#
# Field methods
#
is( $f1->name('person_name'), 'person_name',
'Field name is "person_name"' );
is( $f1->data_type('varchar'), 'varchar', 'Field data type is "varchar"' );
is( $f1->size('30'), '30', 'Field size is "30"' );
is( $f1->is_primary_key(0), '0', 'Field is_primary_key is negative' );
$f1->extra( foo => 'bar' );
$f1->extra( { baz => 'quux' } );
my %extra = $f1->extra;
is( $extra{'foo'}, 'bar', 'Field extra "foo" is "bar"' );
is( $extra{'baz'}, 'quux', 'Field extra "baz" is "quux"' );
#
# New field with args
#
my $age = $person_table->add_field(
name => 'age',
data_type => 'float',
size => '10,2',
);
is( $age->name, 'age', 'Field name is "age"' );
is( $age->data_type, 'float', 'Field data type is "float"' );
is( $age->size, '10,2', 'Field size is "10,2"' );
is( $age->size(10,2), '10,2', 'Field size still "10,2"' );
is( $age->size([10,2]), '10,2', 'Field size still "10,2"' );
is( $age->size(qw[ 10 2 ]), '10,2', 'Field size still "10,2"' );
is( join(':', $age->size), '10:2', 'Field size returns array' );
#
# Index
#
my @indices = $person_table->get_indices;
is( scalar @indices, 0, 'No indices' );
like( $person_table->error, qr/no indices/i, 'Error for no indices' );
my $index1 = $person_table->add_index( name => "foo" )
or warn $person_table->error;
isa_ok( $index1, 'SQL::Translator::Schema::Index', 'Index' );
is( $index1->name, 'foo', 'Index name is "foo"' );
is( $index1->is_valid, undef, 'Index name is not valid...' );
like( $index1->error, qr/no fields/i, '...because it has no fields' );
is( join(':', $index1->fields('foo,bar')), 'foo:bar',
'Index accepts fields');
is( $index1->is_valid, undef, 'Index name is not valid...' );
like( $index1->error, qr/does not exist in table/i,
'...because it used fields not in the table' );
is( join(':', $index1->fields(qw[foo age])), 'foo:age',
'Index accepts fields');
is( $index1->is_valid, 1, 'Index name is now valid' );
is( $index1->type, NORMAL, 'Index type is "normal"' );
my $index2 = SQL::Translator::Schema::Index->new( name => "bar" )
or warn SQL::Translator::Schema::Index->error;
$index2 = $person_table->add_index( $index2 );
isa_ok( $index2, 'SQL::Translator::Schema::Index', 'Index' );
is( $index2->name, 'bar', 'Index name is "bar"' );
my $indices = $person_table->get_indices;
is( scalar @$indices, 2, 'Two indices' );
is( $indices->[0]->name, 'foo', '"foo" index' );
is( $indices->[1]->name, 'bar', '"bar" index' );
#
# $table-> drop_index
#
my $dropped_index = $person_table->drop_index($index1->name);
isa_ok($dropped_index, 'SQL::Translator::Schema::Index', 'Dropped index "foo"' );
$person_table->add_index($index1);
my $dropped_index2 = $person_table->drop_index($index1);
isa_ok($dropped_index2, 'SQL::Translator::Schema::Index', 'Dropped index "foo" by object' );
is($dropped_index2->name, $index1->name, 'Dropped correct index "foo"');
my $dropped_index3 = $person_table->drop_index($index1->name);
like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant index "foo"] );
$person_table->add_index($index1);
#
# Constraint
#
my @constraints = $person_table->get_constraints;
is( scalar @constraints, 0, 'No constraints' );
like( $person_table->error, qr/no constraints/i,
'Error for no constraints' );
my $constraint1 = $person_table->add_constraint( name => 'foo' )
or warn $person_table->error;
isa_ok( $constraint1, 'SQL::Translator::Schema::Constraint', 'Constraint' );
is( $constraint1->name, 'foo', 'Constraint name is "foo"' );
$fields = join(',', $constraint1->fields('age') );
is( $fields, 'age', 'Constraint field = "age"' );
$fields = $constraint1->fields;
ok( ref $fields[0] && $fields[0]->isa("SQL::Translator::Schema::Field"),
'Constraint fields returns a SQL::Translator::Schema::Field' );
$fields = join(',', $constraint1->fields('age,age') );
is( $fields, 'age', 'Constraint field = "age"' );
$fields = join(',', $constraint1->fields('age', 'name') );
is( $fields, 'age,name', 'Constraint field = "age,name"' );
$fields = join(',', $constraint1->fields( 'age,name,age' ) );
is( $fields, 'age,name', 'Constraint field = "age,name"' );
$fields = join(',', $constraint1->fields( 'age, name' ) );
is( $fields, 'age,name', 'Constraint field = "age,name"' );
$fields = join(',', $constraint1->fields( [ 'age', 'name' ] ) );
is( $fields, 'age,name', 'Constraint field = "age,name"' );
$fields = join(',', $constraint1->fields( qw[ age name ] ) );
is( $fields, 'age,name', 'Constraint field = "age,name"' );
$fields = join(',', $constraint1->field_names );
is( $fields, 'age,name', 'Constraint field_names = "age,name"' );
is( $constraint1->match_type, '', 'Constraint match type is empty' );
is( $constraint1->match_type('foo'), undef,
'Constraint match type rejects bad arg...' );
like( $constraint1->error, qr/invalid match type/i,
'...because it is invalid');
is( $constraint1->match_type('FULL'), 'full',
'Constraint match type = "full"' );
my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'bar' );
$constraint2 = $person_table->add_constraint( $constraint2 );
isa_ok( $constraint2, 'SQL::Translator::Schema::Constraint', 'Constraint' );
is( $constraint2->name, 'bar', 'Constraint name is "bar"' );
my $constraint3 = $person_table->add_constraint(
type => 'check',
expression => 'foo bar',
) or die $person_table->error;
isa_ok( $constraint3, 'SQL::Translator::Schema::Constraint', 'Constraint' );
is( $constraint3->type, CHECK_C, 'Constraint type is "CHECK"' );
is( $constraint3->expression, 'foo bar',
'Constraint expression is "foo bar"' );
my $constraints = $person_table->get_constraints;
is( scalar @$constraints, 3, 'Three constraints' );
is( $constraints->[0]->name, 'foo', '"foo" constraint' );
is( $constraints->[1]->name, 'bar', '"bar" constraint' );
#
# $table-> drop_constraint
#
my $dropped_con = $person_table->drop_constraint($constraint1->name);
isa_ok($dropped_con, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo"' );
$person_table->add_constraint($constraint1);
my $dropped_con2 = $person_table->drop_constraint($constraint1);
isa_ok($dropped_con2, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo" by object' );
is($dropped_con2->name, $constraint1->name, 'Dropped correct constraint "foo"');
my $dropped_con3 = $person_table->drop_constraint($constraint1->name);
like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant constraint "foo"] );
$person_table->add_constraint($constraint1);
#
# View
#
my $view = $schema->add_view( name => 'view1' ) or warn $schema->error;
isa_ok( $view, 'SQL::Translator::Schema::View', 'View' );
my $view_sql = 'select * from table';
is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' );
my $view2 = SQL::Translator::Schema::View->new(name => 'view2') or
warn SQL::Translator::Schema::View->error;
my $check_view = $schema->add_view( $view2 );
is( $check_view->name, 'view2', 'Add view "view2"' );
my $redundant_view = $schema->add_view(name => 'view2');
is( $redundant_view, undef, qq[Didn't create another "view2" view...] );
like( $schema->error, qr/can't create view/i, '... because it exists' );
#
# $schema-> drop_view
#
my $dropped_view = $schema->drop_view($view->name);
isa_ok($dropped_view, 'SQL::Translator::Schema::View', 'Dropped view "view1"' );
$schema->add_view($view);
my $dropped_view2 = $schema->drop_view($view);
isa_ok($dropped_view2, 'SQL::Translator::Schema::View', 'Dropped view "view1" by object' );
is($dropped_view2->name, $view->name, 'Dropped correct view "view1"');
my $dropped_view3 = $schema->drop_view($view->name);
like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant view "view1"] );
$schema->add_view($view);
#
# $schema->get_*
#
my $bad_table = $schema->get_table;
like( $schema->error, qr/no table/i, 'Error on no arg to get_table' );
$bad_table = $schema->get_table('baz');
like( $schema->error, qr/does not exist/i,
'Error on bad arg to get_table' );
my $bad_view = $schema->get_view;
like( $schema->error, qr/no view/i, 'Error on no arg to get_view' );
$bad_view = $schema->get_view('bar');
like( $schema->error, qr/does not exist/i,
'Error on bad arg to get_view' );
my $good_table = $schema->get_table('foo');
isa_ok( $good_table, 'SQL::Translator::Schema::Table', 'Table "foo"' );
my $good_view = $schema->get_view('view1');
isa_ok( $good_view, 'SQL::Translator::Schema::View', 'View "view1"' );
is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' );
#
# $schema->get_*s
#
my @tables = $schema->get_tables;
is( scalar @tables, 3, 'Found 2 tables' );
my @views = $schema->get_views;
is( scalar @views, 2, 'Found 1 view' );
}
#
# Test ability to introspect some values
#
{
my $s = SQL::Translator::Schema->new(
name => 'foo',
database => 'PostgreSQL',
);
my $t = $s->add_table( name => 'person' ) or warn $s->error;
my $f = $t->add_field( name => 'person_id' ) or warn $t->error;
$f->data_type('serial');
my $c = $t->add_constraint(
type => PRIMARY_KEY,
fields => 'person_id',
) or warn $t->error;
is( $f->is_primary_key, 1, 'Field is PK' );
is( $f->is_auto_increment, 1, 'Field is auto inc' );
}
#
# FK constraint validity
#
{
my $s = SQL::Translator::Schema->new;
my $t = $s->add_table( name => 'person' ) or warn $s->error;
my $c = $t->add_constraint or warn $t->error;
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/no type/i, '...because it has no type' );
is( $c->type( FOREIGN_KEY ), FOREIGN_KEY, 'Constraint type now a FK' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/no fields/i, '...because it has no fields' );
is( join('', $c->fields('foo')), 'foo', 'Fields now = "foo"' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/non-existent field/i,
q[...because field "foo" doesn't exist] );
my $fk = $t->add_field( name => 'pet_id' );
is( $fk->name, 'pet_id', 'Added field "pet_id"' );
is( join('', $c->fields('pet_id')), 'pet_id', 'Fields now = "pet_id"' );
$t->add_field( name => 'f1' );
$t->add_field( name => 'f2' );
is( join(',', $c->fields('f1,f2')), 'f1,f2', 'Fields now = "f1,f2"' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/only one field/i,
q[...because too many fields for FK] );
$c->fields('f1');
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/no reference table/i,
q[...because there's no reference table] );
is( $c->reference_table('foo'), 'foo', 'Reference table now = "foo"' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/no table named/i,
q[...because reference table "foo" doesn't exist] );
my $t2 = $s->add_table( name => 'pet' );
is( $t2->name, 'pet', 'Added "pet" table' );
is( $c->reference_table('pet'), 'pet', 'Reference table now = "pet"' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/no reference fields/i,
q[...because there're no reference fields]);
is( join('', $c->reference_fields('pet_id')), 'pet_id',
'Reference fields = "pet_id"' );
is( $c->is_valid, undef, 'Constraint on "person" not valid...');
like( $c->error, qr/non-existent field/i,
q[...because there's no "pet_id" field in "pet"]);
my $pet_id = $t2->add_field( name => 'pet_id' );
is( $pet_id->name, 'pet_id', 'Added field "pet_id"' );
is( $c->is_valid, 1, 'Constraint now valid' );
}
#
# $table->primary_key test
#
{
my $s = SQL::Translator::Schema->new;
my $t = $s->add_table( name => 'person' );
is( $t->primary_key, undef, 'No primary key' );
is( $t->primary_key('person_id'), undef,
q[Can't make PK on "person_id"...] );
like( $t->error, qr/invalid field/i, "...because it doesn't exist" );
$t->add_field( name => 'person_id' );
my $c = $t->primary_key('person_id');
isa_ok( $c, 'SQL::Translator::Schema::Constraint', 'Constraint' );
is( join('', $c->fields), 'person_id', 'Constraint now on "person_id"' );
$t->add_field( name => 'name' );
$c = $t->primary_key('name');
is( join(',', $c->fields), 'person_id,name',
'Constraint now on "person_id" and "name"' );
is( scalar @{ $t->get_constraints }, 1, 'Found 1 constraint' );
}
#
# FK finds PK
#
{
my $s = SQL::Translator::Schema->new;
my $t1 = $s->add_table( name => 'person' );
my $t2 = $s->add_table( name => 'pet' );
$t1->add_field( name => 'id' );
my $c1 = $t1->primary_key( 'id' ) or warn $t1->error;
is( $c1->type, PRIMARY_KEY, 'Made "person_id" PK on "person"' );
$t2->add_field( name => 'person_id' );
my $c2 = $t2->add_constraint(
type => PRIMARY_KEY,
fields => 'person_id',
reference_table => 'person',
);
is( join('', $c2->reference_fields), 'id', 'FK found PK "person.id"' );
}
#
# View
#
{
my $s = SQL::Translator::Schema->new( name => 'ViewTest' );
my $name = 'foo_view';
my $sql = 'select name, age from person';
my $fields = 'name, age';
my $v = $s->add_view(
name => $name,
sql => $sql,
fields => $fields,
schema => $s,
);
isa_ok( $v, 'SQL::Translator::Schema::View', 'View' );
isa_ok( $v->schema, 'SQL::Translator::Schema', 'Schema' );
is( $v->schema->name, 'ViewTest', qq[Schema name is "'ViewTest'"] );
is( $v->name, $name, qq[Name is "$name"] );
is( $v->sql, $sql, qq[Name is "$sql"] );
is( join(':', $v->fields), 'name:age', qq[Fields are "$fields"] );
my @views = $s->get_views;
is( scalar @views, 1, 'Number of views is 1' );
my $v1 = $s->get_view( $name );
isa_ok( $v1, 'SQL::Translator::Schema::View', 'View' );
is( $v1->name, $name, qq[Name is "$name"] );
}
#
# Trigger
#
{
my $s = SQL::Translator::Schema->new(name => 'TrigTest');
$s->add_table(name=>'foo') or die "Couldn't create table: ", $s->error;
my $name = 'foo_trigger';
my $perform_action_when = 'after';
my $database_events = 'insert';
my $on_table = 'foo';
my $action = 'update modified=timestamp();';
my $t = $s->add_trigger(
name => $name,
perform_action_when => $perform_action_when,
database_events => $database_events,
on_table => $on_table,
action => $action,
) or die $s->error;
isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' );
isa_ok( $t->schema, 'SQL::Translator::Schema', 'Schema' );
is( $t->schema->name, 'TrigTest', qq[Schema name is "'TrigTest'"] );
is( $t->name, $name, qq[Name is "$name"] );
is( $t->perform_action_when, $perform_action_when,
qq[Perform action when is "$perform_action_when"] );
is( join(',', $t->database_events), $database_events,
qq[Database event is "$database_events"] );
isa_ok( $t->table, 'SQL::Translator::Schema::Table', qq[table is a Table"] );
is( $t->action, $action, qq[Action is "$action"] );
my @triggs = $s->get_triggers;
is( scalar @triggs, 1, 'Number of triggers is 1' );
my $t1 = $s->get_trigger( $name );
isa_ok( $t1, 'SQL::Translator::Schema::Trigger', 'Trigger' );
is( $t1->name, $name, qq[Name is "$name"] );
my $s2 = SQL::Translator::Schema->new(name => 'TrigTest2');
$s2->add_table(name=>'foo') or die "Couldn't create table: ", $s2->error;
my $t2 = $s2->add_trigger(
name => 'foo_trigger',
perform_action_when => 'after',
database_events => [qw/insert update/],
on_table => 'foo',
action => 'update modified=timestamp();',
) or die $s2->error;
isa_ok( $t2, 'SQL::Translator::Schema::Trigger', 'Trigger' );
isa_ok( $t2->schema, 'SQL::Translator::Schema', 'Schema' );
is( $t2->schema->name, 'TrigTest2', qq[Schema name is "'TrigTest2'"] );
is( $t2->name, 'foo_trigger', qq[Name is "foo_trigger"] );
is_deeply(
[$t2->database_events],
[qw/insert update/],
"Database events are [qw/insert update/] "
);
isa_ok($t2->database_events,'ARRAY','Database events');
#
# Trigger equal tests
#
isnt(
$t1->equals($t2),
1,
'Compare two Triggers with database_event and database_events'
);
$t1->database_events($database_events);
$t2->database_events($database_events);
is($t1->equals($t2),1,'Compare two Triggers with database_event');
$t2->database_events('');
$t1->database_events([qw/update insert/]);
$t2->database_events([qw/insert update/]);
is($t1->equals($t2),1,'Compare two Triggers with database_events');
#
# $schema-> drop_trigger
#
my $dropped_trig = $s->drop_trigger($t->name);
isa_ok($dropped_trig, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger"' );
$s->add_trigger($t);
my $dropped_trig2 = $s->drop_trigger($t);
isa_ok($dropped_trig2, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger" by object' );
is($dropped_trig2->name, $t->name, 'Dropped correct trigger "foo_trigger"');
my $dropped_trig3 = $s->drop_trigger($t->name);
like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant trigger "foo_trigger"] );
$s->add_trigger($t);
}
#
# Procedure
#
{
my $s = SQL::Translator::Schema->new( name => 'ProcTest' );
my $name = 'foo_proc';
my $sql = 'select foo from bar';
my $parameters = 'foo, bar';
my $owner = 'Nomar';
my $comments = 'Go Sox!';
my $p = $s->add_procedure(
name => $name,
sql => $sql,
parameters => $parameters,
owner => $owner,
comments => $comments,
) or die $s->error;
isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' );
isa_ok( $p->schema, 'SQL::Translator::Schema', 'Schema' );
is( $p->schema->name, 'ProcTest', qq[Schema name is "'ProcTest'"] );
is( $p->name, $name, qq[Name is "$name"] );
is( $p->sql, $sql, qq[SQL is "$sql"] );
is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] );
is( $p->comments, $comments, qq[Comments = "$comments"] );
my @procs = $s->get_procedures;
is( scalar @procs, 1, 'Number of procedures is 1' );
my $p1 = $s->get_procedure( $name );
isa_ok( $p1, 'SQL::Translator::Schema::Procedure', 'Procedure' );
is( $p1->name, $name, qq[Name is "$name"] );
#
# $schema-> drop_procedure
#
my $dropped_proc = $s->drop_procedure($p->name);
isa_ok($dropped_proc, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc"' );
$s->add_procedure($p);
my $dropped_proc2 = $s->drop_procedure($p);
isa_ok($dropped_proc2, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc" by object' );
is($dropped_proc2->name, $p->name, 'Dropped correct procedure "foo_proc"');
my $dropped_proc3 = $s->drop_procedure($p->name);
like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant procedure "foo_proc"] );
$s->add_procedure($p);
}
#
# Test field order
#
{
my $s = SQL::Translator::Schema->new;
my $t = $s->add_table( name => 'person' );
my $f3 = $t->add_field( name => 'age', order => 3 );
my $f1 = $t->add_field( name => 'person_id', order => 1 );
my $f2 = $t->add_field( name => 'name', order => 2 );
my $f4 = $t->add_field( name => 'gender' );
my $f5 = $t->add_field( name => 'alias' );
is( $f1->order, 1, 'Field order is passed, order is 1' );
is( $f2->order, 2, 'Field order is passed, order is 2' );
is( $f3->order, 3, 'Field order is passed, order is 3' );
is( $f4->order, 4, 'Field order is not passed, order is 4' );
is( $f5->order, 5, 'Field order is not passed, order is 5' );
my $t2 = $s->add_table( name => 'place' );
$f2 = $t2->add_field( name => 'name', order => 2 );
throws_ok { my $f22 = $t2->add_field( name => 'name2', order => 2 ) }
qr/\QRequested order '2' for column 'name2' conflicts with already existing column 'name'/;
throws_ok { $f1 = $t2->add_field( name => 'location' ) }
qr/field order incomplete/;
}
#
# Test link tables
#
{
my $s = SQL::Translator::Schema->new;
my $t1 = $s->add_table( name => 'person' );
$t1->add_field( name => 'id' );
$t1->primary_key( 'id' );
$t1->add_field( name => 'name' );
ok( $t1->is_data, 'Person table has data' );
ok( !$t1->is_trivial_link, 'Person table is not trivial' );
my $t2 = $s->add_table( name => 'pet' );
$t2->add_field( name => 'id' );
$t2->primary_key( 'id' );
$t2->add_field( name => 'name' );
ok( $t2->is_data, 'Pet table has data' );
ok( !$t1->is_trivial_link, 'Pet table is trivial' );
my $t3 = $s->add_table( name => 'person_pet' );
$t3->add_field( name => 'id' );
my $f1 = $t3->add_field( name => 'person_id' );
my $f2 = $t3->add_field( name => 'pet_id' );
$t3->primary_key( 'id' );
$t3->add_constraint(
type => FOREIGN_KEY,
fields => 'person_id',
reference_table => $t1,
);
$t3->add_constraint(
type => FOREIGN_KEY,
fields => 'pet_id',
reference_table => $t2,
);
ok( $f1->is_foreign_key, "person_id is foreign key" );
ok( $f2->is_foreign_key, "pet_id is foreign key" );
ok( !$t3->is_data, 'Link table has no data' );
ok( $t3->is_trivial_link, 'Link table is trivial' );
is( $t3->can_link($t1, $t2)->[0], 'one2one', 'Link table can link' );
my $t4 = $s->add_table( name => 'fans' );
my $f3 = $t4->add_field( name => 'fan_id' );
my $f4 = $t4->add_field( name => 'idol_id' );
$t4->primary_key( 'fan_id', 'idol_id' );
$t4->add_constraint(
type => FOREIGN_KEY,
name => 'fan_fan_fk',
fields => 'fan_id',
reference_table => $t1,
);
$t4->add_constraint(
type => FOREIGN_KEY,
name => 'fan_idol_fk',
fields => 'idol_id',
reference_table => $t1,
);
ok( $f3->is_foreign_key, "fan_id is foreign key" );
ok( $f4->is_foreign_key, "idol_id is foreign key" );
ok( !$t4->is_data, 'Self-link table has no data' );
ok( !$t4->is_trivial_link, 'Self-link table is not trivial' );
is( $t4->can_link($t1, $t1)->[0], 'many2many', 'Self-link table can link' );
ok( !$t4->can_link($t1, $t2)->[0], 'Self-link table can\'t link other' );
}
done_testing;
SQL-Translator-0.11024/t/35-access-parser.t 0000644 0001750 0001750 00000005320 12163313615 017374 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
use strict;
use FindBin '$Bin';
use Test::More 'no_plan';
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan table_ok);
#BEGIN {
# maybe_plan(180, "SQL::Translator::Parser::Access");
# SQL::Translator::Parser::Access->import('parse');
#}
use SQL::Translator::Parser::Access 'parse';
{
my $tr = SQL::Translator->new;
my $file = "$Bin/data/access/gdpdm.ddl";
open FH, "<$file" or die "Can't read '$file': $!\n";
local $/;
my $data = ;
close FH;
my $val = parse($tr, $data);
ok( $val, 'Parsed OK' );
my $schema = $tr->schema;
is( $schema->is_valid, 1, 'Schema is valid' );
my @tables = $schema->get_tables;
is( scalar @tables, 24, 'Right number of tables (24)' );
my @tblnames = map {$_->name} @tables;
is_deeply( \@tblnames,
[qw/div_aa_annotation div_allele div_allele_assay div_annotation_type div_exp_entry div_experiment div_generation div_locality div_locus div_marker div_obs_unit div_obs_unit_sample div_passport div_poly_type div_statistic_type div_stock div_stock_parent div_trait div_trait_uom div_treatment div_treatment_uom div_unit_of_measure qtl_trait_ontology qtl_treatment_ontology/]
,"tables");
table_ok( $schema->get_table("div_aa_annotation"), {
name => "div_aa_annotation",
fields => [
{
name => "div_aa_annotation_id",
data_type => "Long Integer",
size => 4,
},
{
name => "div_annotation_type_id",
data_type => "Long Integer",
size => 4,
},
{
name => "div_allele_assay_id",
data_type => "Long Integer",
size => 4,
},
{
name => "annotation_value",
data_type => "Text",
size => 50,
},
],
});
table_ok( $schema->get_table("div_allele"), {
name => "div_allele",
fields => [
{
name => "div_allele_id",
data_type => "Long Integer",
size => 4,
},
{
name => "div_obs_unit_sample_id",
data_type => "Long Integer",
size => 4,
},
{
name => "div_allele_assay_id",
data_type => "Long Integer",
size => 4,
},
{
name => "allele_num",
data_type => "Long Integer",
size => 4,
},
{
name => "quality",
data_type => "Long Integer",
size => 4,
},
{
name => "value",
data_type => "Text",
size => 50,
},
],
});
}
SQL-Translator-0.11024/t/45db2-producer.t 0000644 0001750 0001750 00000004547 12163313615 017067 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use Data::Dumper;
use FindBin qw/$Bin/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(4,
'SQL::Translator::Producer::DB2',
'Test::Differences',
)
}
use Test::Differences;
use SQL::Translator;
my $table = SQL::Translator::Schema::Table->new( name => 'mytable');
my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field1_sql = SQL::Translator::Producer::DB2::create_field($field1);
is($field1_sql, 'myfield VARCHAR(10)', 'Create field works');
my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 25,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $alter_field = SQL::Translator::Producer::DB2::alter_field($field1,
$field2);
is($alter_field, 'ALTER TABLE mytable ALTER myfield SET DATATYPE VARCHAR(25)', 'Alter field works');
my $add_field = SQL::Translator::Producer::DB2::add_field($field1);
is($add_field, 'ALTER TABLE mytable ADD COLUMN myfield VARCHAR(10)', 'Add field works');
my $drop_field = SQL::Translator::Producer::DB2::drop_field($field2);
is($drop_field, '', 'Drop field works');
SQL-Translator-0.11024/t/51-xml-to-oracle.t 0000644 0001750 0001750 00000010257 12163313615 017327 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Test::Differences;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::XML::SQLFairy',
'SQL::Translator::Producer::Oracle');
}
my $xmlfile = "$Bin/data/xml/schema.xml";
my $sqlt;
$sqlt = SQL::Translator->new(
no_comments => 1,
quote_table_names => 0,
quote_field_names => 0,
show_warnings => 0,
add_drop_table => 1,
);
die "Can't find test schema $xmlfile" unless -e $xmlfile;
my @sql = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'Oracle',
filename => $xmlfile,
) or die $sqlt->error;
my $sql_string = $sqlt->translate(
from => 'XML-SQLFairy',
to => 'Oracle',
filename => $xmlfile,
) or die $sqlt->error;
my $want = [
'DROP TABLE Basic CASCADE CONSTRAINTS',
'DROP SEQUENCE sq_Basic_id',
'CREATE SEQUENCE sq_Basic_id',
'CREATE TABLE Basic (
id number(10) NOT NULL,
title varchar2(100) DEFAULT \'hello\' NOT NULL,
description clob DEFAULT \'\',
email varchar2(500),
explicitnulldef varchar2(4000),
explicitemptystring varchar2(4000) DEFAULT \'\',
emptytagdef varchar2(4000) DEFAULT \'\',
another_id number(10) DEFAULT \'2\',
timest date,
PRIMARY KEY (id),
CONSTRAINT u_Basic_emailuniqueindex UNIQUE (email),
CONSTRAINT u_Basic_very_long_index_name_o UNIQUE (title)
)',
'DROP TABLE Another CASCADE CONSTRAINTS',
'DROP SEQUENCE sq_Another_id',
'CREATE SEQUENCE sq_Another_id',
'CREATE TABLE Another (
id number(10) NOT NULL,
num number(10,2),
PRIMARY KEY (id)
)',
'DROP VIEW email_list',
'CREATE VIEW email_list AS
SELECT email FROM Basic WHERE (email IS NOT NULL)',
'ALTER TABLE Basic ADD CONSTRAINT Basic_another_id_fk FOREIGN KEY (another_id) REFERENCES Another (id)',
'CREATE OR REPLACE TRIGGER ai_Basic_id
BEFORE INSERT ON Basic
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_Basic_id.nextval
INTO :new.id
FROM dual;
END;
',
'CREATE OR REPLACE TRIGGER ts_Basic_timest
BEFORE INSERT OR UPDATE ON Basic
FOR EACH ROW WHEN (new.timest IS NULL)
BEGIN
SELECT sysdate INTO :new.timest FROM dual;
END;
',
'CREATE OR REPLACE TRIGGER ai_Another_id
BEFORE INSERT ON Another
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_Another_id.nextval
INTO :new.id
FROM dual;
END;
',
'CREATE INDEX titleindex on Basic (title)'];
is_deeply(\@sql, $want, 'Got correct Oracle statements in list context');
eq_or_diff($sql_string, q|DROP TABLE Basic CASCADE CONSTRAINTS;
DROP SEQUENCE sq_Basic_id01;
CREATE SEQUENCE sq_Basic_id01;
CREATE TABLE Basic (
id number(10) NOT NULL,
title varchar2(100) DEFAULT 'hello' NOT NULL,
description clob DEFAULT '',
email varchar2(500),
explicitnulldef varchar2(4000),
explicitemptystring varchar2(4000) DEFAULT '',
emptytagdef varchar2(4000) DEFAULT '',
another_id number(10) DEFAULT '2',
timest date,
PRIMARY KEY (id),
CONSTRAINT u_Basic_emailuniqueindex01 UNIQUE (email),
CONSTRAINT u_Basic_very_long_index_name01 UNIQUE (title)
);
DROP TABLE Another CASCADE CONSTRAINTS;
DROP SEQUENCE sq_Another_id01;
CREATE SEQUENCE sq_Another_id01;
CREATE TABLE Another (
id number(10) NOT NULL,
num number(10,2),
PRIMARY KEY (id)
);
DROP VIEW email_list;
CREATE VIEW email_list AS
SELECT email FROM Basic WHERE (email IS NOT NULL);
ALTER TABLE Basic ADD CONSTRAINT Basic_another_id_fk01 FOREIGN KEY (another_id) REFERENCES Another (id);
CREATE INDEX titleindex01 on Basic (title);
CREATE OR REPLACE TRIGGER ai_Basic_id01
BEFORE INSERT ON Basic
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_Basic_id01.nextval
INTO :new.id
FROM dual;
END;
/
CREATE OR REPLACE TRIGGER ts_Basic_timest01
BEFORE INSERT OR UPDATE ON Basic
FOR EACH ROW WHEN (new.timest IS NULL)
BEGIN
SELECT sysdate INTO :new.timest FROM dual;
END;
/
CREATE OR REPLACE TRIGGER ai_Another_id01
BEFORE INSERT ON Another
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_Another_id01.nextval
INTO :new.id
FROM dual;
END;
/
|);
SQL-Translator-0.11024/t/lib/ 0000755 0001750 0001750 00000000000 13225114407 014773 5 ustar ilmari ilmari SQL-Translator-0.11024/t/lib/Producer/ 0000755 0001750 0001750 00000000000 13225114407 016556 5 ustar ilmari ilmari SQL-Translator-0.11024/t/lib/Producer/BaseTest.pm 0000644 0001750 0001750 00000001156 12163313615 020633 0 ustar ilmari ilmari package Producer::BaseTest;
#
# A trivial little sub-class to test sub-classing the TT::Base producer.
#
use base qw/SQL::Translator::Producer::TT::Base/;
# Make sure we use our new class as the producer
sub produce { return __PACKAGE__->new( translator => shift )->run; };
# Note: we don't need to impliment tt_schema as the default will use the DATA
# section by default.
sub tt_vars { ( foo => "bar" ); }
sub tt_config { ( INTERPOLATE => 1 ); }
1;
__DATA__
Hello World
Tables: [% schema.get_tables.join(', ') %]
[% FOREACH table IN schema.get_tables -%]
$table
------
Fields: $table.field_names.join
[% END %]
SQL-Translator-0.11024/t/47postgres-producer.t 0000644 0001750 0001750 00000075050 12617123640 020266 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator::Schema::Constants;
use Data::Dumper;
use FindBin qw/$Bin/;
# Testing 1,2,3,4...
#=============================================================================
BEGIN {
maybe_plan(undef,
'SQL::Translator::Producer::PostgreSQL',
'Test::Differences',
)
}
use Test::Differences;
use SQL::Translator;
my $PRODUCER = \&SQL::Translator::Producer::PostgreSQL::create_field;
{
my $table = SQL::Translator::Schema::Table->new( name => 'foo.bar',
comments => [ "multi\nline",'single line' ] );
my $field = SQL::Translator::Schema::Field->new( name => 'baz',
comments => [ "multi\nline",'single line' ],
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => 'quux',
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
$table->add_field($field);
my ($create, $fks) = SQL::Translator::Producer::PostgreSQL::create_table($table, { quote_table_names => q{"} });
is($table->name, 'foo.bar');
my $expected = <new( name => 'mytable');
my $field1 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field1_sql = SQL::Translator::Producer::PostgreSQL::create_field($field1);
is($field1_sql, 'myfield character varying(10)', 'Create field works');
my $field_array = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'character varying[]',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
my $field_array_sql = SQL::Translator::Producer::PostgreSQL::create_field($field_array);
is($field_array_sql, 'myfield character varying(10)[]', 'Create field works');
my $field2 = SQL::Translator::Schema::Field->new( name => 'myfield',
table => $table,
data_type => 'VARCHAR',
size => 25,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $pk_constraint = SQL::Translator::Schema::Constraint->new(
table => $table,
name => 'foo',
fields => [qw(myfield)],
type => 'PRIMARY_KEY',
);
my ($pk_constraint_def_ref, $pk_constraint_fk_ref ) = SQL::Translator::Producer::PostgreSQL::create_constraint($pk_constraint);
ok(@{$pk_constraint_def_ref} == 1 && @{$pk_constraint_fk_ref} == 0, 'precheck of create_Primary Key constraint');
is($pk_constraint_def_ref->[0], 'CONSTRAINT foo PRIMARY KEY (myfield)', 'Create Primary Key Constraint works');
my $alter_pk_constraint = SQL::Translator::Producer::PostgreSQL::alter_drop_constraint($pk_constraint);
is($alter_pk_constraint, 'ALTER TABLE mytable DROP CONSTRAINT foo', 'Alter drop Primary Key constraint works');
my $table2 = SQL::Translator::Schema::Table->new( name => 'mytable2');
my $field1_2 = SQL::Translator::Schema::Field->new( name => 'myfield_2',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0 );
# check named, and unnamed foreign keys
for my $name ( 'foo', undef ) {
my $fk_constraint = SQL::Translator::Schema::Constraint->new(
table => $table,
name => $name,
fields => [qw(myfield)],
type => 'FOREIGN_KEY',
reference_table => $table2,
reference_fields => [qw(myfield_2)],
);
my $fk_constraint_2 = SQL::Translator::Schema::Constraint->new(
table => $table,
name => $name,
fields => [qw(myfield)],
type => 'FOREIGN_KEY',
reference_table => $table2,
reference_fields => [qw(myfield_2)],
);
my ($fk_constraint_def_ref, $fk_constraint_fk_ref ) = SQL::Translator::Producer::PostgreSQL::create_constraint($fk_constraint);
ok(@{$fk_constraint_def_ref} == 0 && @{$fk_constraint_fk_ref} == 1, 'precheck of create_Foreign Key constraint');
if ( $name ) {
is($fk_constraint_fk_ref->[0], "ALTER TABLE mytable ADD CONSTRAINT $name FOREIGN KEY (myfield)
REFERENCES mytable2 (myfield_2) DEFERRABLE", 'Create Foreign Key Constraint works');
# ToDo: may we should check if the constraint name was valid, or if next
# unused_name created has choosen a different one
my $alter_fk_constraint = SQL::Translator::Producer::PostgreSQL::alter_drop_constraint($fk_constraint);
is($alter_fk_constraint, "ALTER TABLE mytable DROP CONSTRAINT $name", 'Alter drop Foreign Key constraint works');
}
else {
is($fk_constraint_fk_ref->[0], 'ALTER TABLE mytable ADD FOREIGN KEY (myfield)
REFERENCES mytable2 (myfield_2) DEFERRABLE', 'Create un-named Foreign Key Constraint works');
my $alter_fk_constraint = SQL::Translator::Producer::PostgreSQL::alter_drop_constraint($fk_constraint);
is($alter_fk_constraint, 'ALTER TABLE mytable DROP CONSTRAINT mytable_myfield_fkey', 'Alter drop un-named Foreign Key constraint works');
}
}
# check named, and unnamed primary keys
for my $name ( 'foo', undef ) {
my $pk_constraint = SQL::Translator::Schema::Constraint->new(
table => $table,
name => $name,
fields => [qw(myfield)],
type => 'PRIMARY_KEY',
);
my $pk_constraint_2 = SQL::Translator::Schema::Constraint->new(
table => $table,
name => $name,
fields => [qw(myfield)],
type => 'PRIMARY_KEY',
);
my ($pk_constraint_def_ref, $pk_constraint_pk_ref ) = SQL::Translator::Producer::PostgreSQL::create_constraint($pk_constraint);
if ( $name ) {
is($pk_constraint_def_ref->[0], "CONSTRAINT $name PRIMARY KEY (myfield)", 'Create Primary Key Constraint works');
# ToDo: may we should check if the constraint name was valid, or if next
# unused_name created has choosen a different one
my $alter_pk_constraint = SQL::Translator::Producer::PostgreSQL::alter_drop_constraint($pk_constraint);
is($alter_pk_constraint, "ALTER TABLE mytable DROP CONSTRAINT $name", 'Alter drop Primary Key constraint works');
}
else {
is($pk_constraint_def_ref->[0], 'PRIMARY KEY (myfield)', 'Create un-named Primary Key Constraint works');
my $alter_pk_constraint = SQL::Translator::Producer::PostgreSQL::alter_drop_constraint($pk_constraint);
is($alter_pk_constraint, 'ALTER TABLE mytable DROP CONSTRAINT mytable_pkey', 'Alter drop un-named Foreign Key constraint works');
}
}
my $alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field1,
$field2);
is($alter_field, qq[ALTER TABLE mytable ALTER COLUMN myfield SET NOT NULL;
ALTER TABLE mytable ALTER COLUMN myfield TYPE character varying(25)],
'Alter field works');
my $field1_complex = SQL::Translator::Schema::Field->new(
name => 'my_complex_field',
table => $table,
data_type => 'VARCHAR',
size => 10,
default_value => undef,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
my $field2_complex = SQL::Translator::Schema::Field->new(
name => 'my_altered_field',
table => $table,
data_type => 'VARCHAR',
size => 60,
default_value => 'whatever',
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0
);
my $alter_field_complex = SQL::Translator::Producer::PostgreSQL::alter_field($field1_complex, $field2_complex);
is(
$alter_field_complex,
q{ALTER TABLE mytable RENAME COLUMN my_complex_field TO my_altered_field;
ALTER TABLE mytable ALTER COLUMN my_altered_field TYPE character varying(60);
ALTER TABLE mytable ALTER COLUMN my_altered_field SET DEFAULT 'whatever'},
'Complex Alter field works'
);
$field1->name('field3');
my $add_field = SQL::Translator::Producer::PostgreSQL::add_field($field1);
is($add_field, 'ALTER TABLE mytable ADD COLUMN field3 character varying(10)', 'Add field works');
my $drop_field = SQL::Translator::Producer::PostgreSQL::drop_field($field2);
is($drop_field, 'ALTER TABLE mytable DROP COLUMN myfield', 'Drop field works');
my $field_serial = SQL::Translator::Schema::Field->new( name => 'serial_field',
table => $table,
data_type => 'INT',
is_auto_increment => 1,
is_nullable => 0 );
my $field_serial_sql = SQL::Translator::Producer::PostgreSQL::create_field($field_serial);
is($field_serial_sql, 'serial_field serial NOT NULL', 'Create serial field works');
my $field_bigserial = SQL::Translator::Schema::Field->new( name => 'bigserial_field',
table => $table,
data_type => 'BIGINT',
is_auto_increment => 1,
is_nullable => 0 );
my $field_bigserial_sql = SQL::Translator::Producer::PostgreSQL::create_field($field_bigserial);
is($field_bigserial_sql, 'bigserial_field bigserial NOT NULL', 'Create bigserial field works (from bigint type)');
$field_bigserial = SQL::Translator::Schema::Field->new( name => 'bigserial_field',
table => $table,
data_type => 'INT',
is_auto_increment => 1,
is_nullable => 0,
size => 12 );
$field_bigserial_sql = SQL::Translator::Producer::PostgreSQL::create_field($field_bigserial);
is($field_bigserial_sql, 'bigserial_field bigserial NOT NULL', 'Create bigserial field works (based on size)');
my $field3 = SQL::Translator::Schema::Field->new( name => 'time_field',
table => $table,
data_type => 'TIME',
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field3_sql = SQL::Translator::Producer::PostgreSQL::create_field($field3);
is($field3_sql, 'time_field time NOT NULL', 'Create time field works');
my $field3_datetime_with_TZ = SQL::Translator::Schema::Field->new(
name => 'datetime_with_TZ',
table => $table,
data_type => 'timestamp with time zone',
size => 7,
);
my $field3_datetime_with_TZ_sql =
SQL::Translator::Producer::PostgreSQL::create_field(
$field3_datetime_with_TZ
);
is(
$field3_datetime_with_TZ_sql,
'datetime_with_TZ timestamp(6) with time zone',
'Create time field with time zone and size, works'
);
my $field3_time_without_TZ = SQL::Translator::Schema::Field->new(
name => 'time_without_TZ',
table => $table,
data_type => 'time without time zone',
size => 2,
);
my $field3_time_without_TZ_sql
= SQL::Translator::Producer::PostgreSQL::create_field(
$field3_time_without_TZ
);
is(
$field3_time_without_TZ_sql,
'time_without_TZ time(2) without time zone',
'Create time field without time zone but with size, works'
);
my $field_num = SQL::Translator::Schema::Field->new( name => 'num',
table => $table,
data_type => 'numeric',
size => [10,2],
);
my $fieldnum_sql = SQL::Translator::Producer::PostgreSQL::create_field($field_num);
is($fieldnum_sql, 'num numeric(10,2)', 'Create numeric field works');
my $field4 = SQL::Translator::Schema::Field->new( name => 'bytea_field',
table => $table,
data_type => 'bytea',
size => '16777215',
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field4_sql = SQL::Translator::Producer::PostgreSQL::create_field($field4);
is($field4_sql, 'bytea_field bytea NOT NULL', 'Create bytea field works');
my $field5 = SQL::Translator::Schema::Field->new( name => 'enum_field',
table => $table,
data_type => 'enum',
extra => { list => [ 'Foo', 'Bar', 'Ba\'z' ] },
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field5_types = {};
my $field5_sql = SQL::Translator::Producer::PostgreSQL::create_field(
$field5,
{
postgres_version => 8.3,
type_defs => $field5_types,
}
);
is($field5_sql, 'enum_field mytable_enum_field_type NOT NULL', 'Create real enum field works');
is_deeply(
$field5_types,
{ mytable_enum_field_type =>
"DROP TYPE IF EXISTS mytable_enum_field_type CASCADE;\n" .
"CREATE TYPE mytable_enum_field_type AS ENUM ('Foo', 'Bar', 'Ba''z')"
},
'Create real enum type works'
);
my $field6 = SQL::Translator::Schema::Field->new(
name => 'character',
table => $table,
data_type => 'character',
size => '123',
default_value => 'foobar',
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0);
my $field7 = SQL::Translator::Schema::Field->new(
name => 'character',
table => $table,
data_type => 'character',
size => '123',
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0);
$alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field6,
$field7);
is($alter_field, q(ALTER TABLE mytable ALTER COLUMN character DROP DEFAULT), 'DROP DEFAULT');
$field7->default_value(q(foo'bar'));
$alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field6,
$field7);
is($alter_field, q(ALTER TABLE mytable ALTER COLUMN character SET DEFAULT 'foo''bar'''), 'DEFAULT with escaping');
$field7->default_value(\q(foobar));
$alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field6,
$field7);
is($alter_field, q(ALTER TABLE mytable ALTER COLUMN character SET DEFAULT foobar), 'DEFAULT unescaped if scalarref');
$field7->is_nullable(1);
$field7->default_value(q(foobar));
$alter_field = SQL::Translator::Producer::PostgreSQL::alter_field($field6,
$field7);
is($alter_field, q(ALTER TABLE mytable ALTER COLUMN character DROP NOT NULL), 'DROP NOT NULL');
my $field8 = SQL::Translator::Schema::Field->new( name => 'ts_field',
table => $table,
data_type => 'timestamp with time zone',
size => 6,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field8_sql = SQL::Translator::Producer::PostgreSQL::create_field($field8,{ postgres_version => 8.3 });
is($field8_sql, 'ts_field timestamp(6) with time zone NOT NULL', 'timestamp with precision');
my $field9 = SQL::Translator::Schema::Field->new( name => 'time_field',
table => $table,
data_type => 'time with time zone',
size => 6,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field9_sql = SQL::Translator::Producer::PostgreSQL::create_field($field9,{ postgres_version => 8.3 });
is($field9_sql, 'time_field time(6) with time zone NOT NULL', 'time with precision');
my $field10 = SQL::Translator::Schema::Field->new( name => 'interval_field',
table => $table,
data_type => 'interval',
size => 6,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field10_sql = SQL::Translator::Producer::PostgreSQL::create_field($field10,{ postgres_version => 8.3 });
is($field10_sql, 'interval_field interval(6) NOT NULL', 'time with precision');
my $field11 = SQL::Translator::Schema::Field->new( name => 'time_field',
table => $table,
data_type => 'time without time zone',
size => 6,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field11_sql = SQL::Translator::Producer::PostgreSQL::create_field($field11,{ postgres_version => 8.3 });
is($field11_sql, 'time_field time(6) without time zone NOT NULL', 'time with precision');
my $field12 = SQL::Translator::Schema::Field->new( name => 'time_field',
table => $table,
data_type => 'timestamp',
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field12_sql = SQL::Translator::Producer::PostgreSQL::create_field($field12,{ postgres_version => 8.3 });
is($field12_sql, 'time_field timestamp NOT NULL', 'time with precision');
my $field13 = SQL::Translator::Schema::Field->new( name => 'enum_field_with_type_name',
table => $table,
data_type => 'enum',
extra => { list => [ 'Foo', 'Bar', 'Ba\'z' ],
custom_type_name => 'real_enum_type' },
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0 );
my $field13_types = {};
my $field13_sql = SQL::Translator::Producer::PostgreSQL::create_field(
$field13,
{
postgres_version => 8.3,
type_defs => $field13_types,
}
);
is($field13_sql, 'enum_field_with_type_name real_enum_type NOT NULL', 'Create real enum field works');
is_deeply(
$field13_types,
{ real_enum_type =>
"DROP TYPE IF EXISTS real_enum_type CASCADE;\n" .
"CREATE TYPE real_enum_type AS ENUM ('Foo', 'Bar', 'Ba''z')"
},
'Create real enum type works'
);
{
# let's test default values! -- rjbs, 2008-09-30
my %field = (
table => $table,
data_type => 'VARCHAR',
size => 10,
is_auto_increment => 0,
is_nullable => 1,
is_foreign_key => 0,
is_unique => 0,
);
{
my $simple_default = SQL::Translator::Schema::Field->new(
%field,
name => 'str_default',
default_value => 'foo',
);
is(
$PRODUCER->($simple_default),
q{str_default character varying(10) DEFAULT 'foo'},
'default str',
);
}
{
my $null_default = SQL::Translator::Schema::Field->new(
%field,
name => 'null_default',
default_value => \'NULL',
);
is(
$PRODUCER->($null_default),
q{null_default character varying(10) DEFAULT NULL},
'default null',
);
}
{
my $null_default = SQL::Translator::Schema::Field->new(
%field,
name => 'null_default_2',
default_value => 'NULL', # XXX: this should go away
);
is(
$PRODUCER->($null_default),
q{null_default_2 character varying(10) DEFAULT NULL},
'default null from special cased string',
);
}
{
my $func_default = SQL::Translator::Schema::Field->new(
%field,
name => 'func_default',
default_value => \'func(funky)',
);
is(
$PRODUCER->($func_default),
q{func_default character varying(10) DEFAULT func(funky)},
'unquoted default from scalar ref',
);
}
}
my $view1 = SQL::Translator::Schema::View->new(
name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',
);
my $create_opts = { add_replace_view => 1, no_comments => 1 };
my $view1_sql1 = SQL::Translator::Producer::PostgreSQL::create_view($view1, $create_opts);
my $view_sql_replace = "CREATE VIEW view_foo ( id, name ) AS
SELECT id, name FROM thing
";
is($view1_sql1, $view_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL');
my $view2 = SQL::Translator::Schema::View->new(
name => 'view_foo2',
sql => 'SELECT id, name FROM thing',
extra => {
'temporary' => '1',
'check_option' => 'cascaded',
},
);
my $create2_opts = { add_replace_view => 1, no_comments => 1 };
my $view2_sql1 = SQL::Translator::Producer::PostgreSQL::create_view($view2, $create2_opts);
my $view2_sql_replace = "CREATE TEMPORARY VIEW view_foo2 AS
SELECT id, name FROM thing
WITH CASCADED CHECK OPTION";
is($view2_sql1, $view2_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL 2');
{
my $table = SQL::Translator::Schema::Table->new( name => 'foobar', fields => [qw( foo bar )] );
my $quote = { quote_table_names => '"' };
{
my $index = $table->add_index(name => 'myindex', fields => ['foo']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index);
is($def, "CREATE INDEX myindex on foobar (foo)", 'index created');
($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
is($def, 'CREATE INDEX "myindex" on "foobar" ("foo")', 'index created w/ quotes');
}
{
my $index = $table->add_index(name => 'myindex', fields => ['lower(foo)']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index);
is($def, "CREATE INDEX myindex on foobar (lower(foo))", 'index created');
($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
is($def, 'CREATE INDEX "myindex" on "foobar" (lower(foo))', 'index created w/ quotes');
}
{
my $index = $table->add_index(name => 'myindex', fields => ['bar', 'lower(foo)']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index);
is($def, "CREATE INDEX myindex on foobar (bar, lower(foo))", 'index created');
($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
is($def, 'CREATE INDEX "myindex" on "foobar" ("bar", lower(foo))', 'index created w/ quotes');
}
{
my $constr = $table->add_constraint(name => 'constr', type => UNIQUE, fields => ['foo']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr);
is($def->[0], 'CONSTRAINT constr UNIQUE (foo)', 'constraint created');
($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr, $quote);
is($def->[0], 'CONSTRAINT "constr" UNIQUE ("foo")', 'constraint created w/ quotes');
}
{
my $constr = $table->add_constraint(name => 'constr', type => UNIQUE, fields => ['lower(foo)']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr);
is($def->[0], 'CONSTRAINT constr UNIQUE (lower(foo))', 'constraint created');
($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr, $quote);
is($def->[0], 'CONSTRAINT "constr" UNIQUE (lower(foo))', 'constraint created w/ quotes');
}
{
my $constr = $table->add_constraint(name => 'constr', type => UNIQUE, fields => ['bar', 'lower(foo)']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr);
is($def->[0], 'CONSTRAINT constr UNIQUE (bar, lower(foo))', 'constraint created');
($def) = SQL::Translator::Producer::PostgreSQL::create_constraint($constr, $quote);
is($def->[0], 'CONSTRAINT "constr" UNIQUE ("bar", lower(foo))', 'constraint created w/ quotes');
}
{
my $index = $table->add_index(name => 'myindex', options => [{using => 'hash'}, {where => "upper(foo) = 'bar' AND bar = 'foo'"}], fields => ['bar', 'lower(foo)']);
my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index);
is($def, "CREATE INDEX myindex on foobar USING hash (bar, lower(foo)) WHERE upper(foo) = 'bar' AND bar = 'foo'", 'index using & where created');
($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote);
is($def, 'CREATE INDEX "myindex" on "foobar" USING hash ("bar", lower(foo)) WHERE upper(foo) = \'bar\' AND bar = \'foo\'', 'index using & where created w/ quotes');
}
}
my $drop_view_opts1 = { add_drop_view => 1, no_comments => 1, postgres_version => 8.001 };
my $drop_view_8_1_produced = SQL::Translator::Producer::PostgreSQL::create_view($view1, $drop_view_opts1);
my $drop_view_8_1_expected = "DROP VIEW view_foo;
CREATE VIEW view_foo ( id, name ) AS
SELECT id, name FROM thing
";
is($drop_view_8_1_produced, $drop_view_8_1_expected, "My DROP VIEW statement for 8.1 is correct");
my $drop_view_opts2 = { add_drop_view => 1, no_comments => 1, postgres_version => 9.001 };
my $drop_view_9_1_produced = SQL::Translator::Producer::PostgreSQL::create_view($view1, $drop_view_opts2);
my $drop_view_9_1_expected = "DROP VIEW IF EXISTS view_foo;
CREATE VIEW view_foo ( id, name ) AS
SELECT id, name FROM thing
";
is($drop_view_9_1_produced, $drop_view_9_1_expected, "My DROP VIEW statement for 9.1 is correct");
done_testing;
SQL-Translator-0.11024/t/56-sqlite-producer.t 0000644 0001750 0001750 00000020601 12542755372 020000 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use SQL::Translator::Schema;
use SQL::Translator::Schema::View;
use SQL::Translator::Schema::Table;
use SQL::Translator::Producer::SQLite;
$SQL::Translator::Producer::SQLite::NO_QUOTES = 0;
{
my $view1 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',
extra => {
temporary => 1,
if_not_exists => 1,
});
my $create_opts = { no_comments => 1 };
my $view1_sql1 = [ SQL::Translator::Producer::SQLite::create_view($view1, $create_opts) ];
my $view_sql_replace = [ 'CREATE TEMPORARY VIEW IF NOT EXISTS "view_foo" AS
SELECT id, name FROM thing' ];
is_deeply($view1_sql1, $view_sql_replace, 'correct "CREATE TEMPORARY VIEW" SQL');
my $view2 = SQL::Translator::Schema::View->new( name => 'view_foo',
fields => [qw/id name/],
sql => 'SELECT id, name FROM thing',);
my $view1_sql2 = [ SQL::Translator::Producer::SQLite::create_view($view2, $create_opts) ];
my $view_sql_noreplace = [ 'CREATE VIEW "view_foo" AS
SELECT id, name FROM thing' ];
is_deeply($view1_sql2, $view_sql_noreplace, 'correct "CREATE VIEW" SQL');
}
{
my $create_opts;
my $table = SQL::Translator::Schema::Table->new(
name => 'foo_table',
);
$table->add_field(
name => 'foreign_key',
data_type => 'integer',
default_value => 1,
);
my $constraint = SQL::Translator::Schema::Constraint->new(
table => $table,
name => 'fk',
type => 'FOREIGN_KEY',
fields => ['foreign_key'],
reference_fields => ['id'],
reference_table => 'foo',
on_delete => 'RESTRICT',
on_update => 'CASCADE',
);
my $expected = [ 'FOREIGN KEY ("foreign_key") REFERENCES "foo"("id") ON DELETE RESTRICT ON UPDATE CASCADE'];
my $result = [SQL::Translator::Producer::SQLite::create_foreignkey($constraint,$create_opts)];
is_deeply($result, $expected, 'correct "FOREIGN KEY"');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'foo_table',
);
$table->add_field(
name => 'id',
data_type => 'integer',
default_value => 1,
);
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly unquoted DEFAULT');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'foo',
);
$table->add_field(
name => 'data',
data_type => 'bytea',
);
$table->add_field(
name => 'data2',
data_type => 'set',
);
$table->add_field(
name => 'data2',
data_type => 'set',
);
$table->add_field(
name => 'data3',
data_type => 'text',
size => 30,
);
$table->add_field(
name => 'data4',
data_type => 'blob',
size => 30,
);
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly translated bytea to blob');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'foo_table',
);
$table->add_field(
name => 'id',
data_type => 'integer',
default_value => \'gunshow',
);
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly unquoted DEFAULT');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'foo_table',
);
$table->add_field(
name => 'id',
data_type => 'integer',
default_value => 'frew',
);
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly quoted DEFAULT');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'foo',
);
$table->add_field(
name => 'id',
data_type => 'integer',
default_value => 'NULL',
);
$table->add_field(
name => 'when',
default_value => 'now()',
);
$table->add_field(
name => 'at',
default_value => 'CURRENT_TIMESTAMP',
);
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly unquoted excempted DEFAULTs');
}
{
my $table = SQL::Translator::Schema::Table->new(
name => 'some_table',
);
$table->add_field(
name => 'id',
data_type => 'integer',
is_auto_increment => 1,
is_nullable => 0,
extra => {
auto_increment_type => 'monotonic',
},
);
$table->primary_key('id');
my $expected = [ qq];
my $result = [SQL::Translator::Producer::SQLite::create_table($table, { no_comments => 1 })];
is_deeply($result, $expected, 'correctly built monotonicly autoincremened PK');
}
{
my $table = SQL::Translator::Schema::Table->new( name => 'foobar', fields => ['foo'] );
{
my $index = $table->add_index(name => 'myindex', fields => ['foo']);
my ($def) = SQL::Translator::Producer::SQLite::create_index($index);
is($def, 'CREATE INDEX "myindex" ON "foobar" ("foo")', 'index created');
}
{
my $index = $table->add_index(fields => ['foo']);
my ($def) = SQL::Translator::Producer::SQLite::create_index($index);
is($def, 'CREATE INDEX "foobar_idx" ON "foobar" ("foo")', 'index created');
}
{
my $constr = $table->add_constraint(name => 'constr', fields => ['foo']);
my ($def) = SQL::Translator::Producer::SQLite::create_constraint($constr);
is($def, 'CREATE UNIQUE INDEX "constr" ON "foobar" ("foo")', 'constraint created');
}
{
my $constr = $table->add_constraint(fields => ['foo']);
my ($def) = SQL::Translator::Producer::SQLite::create_constraint($constr);
is($def, 'CREATE UNIQUE INDEX "foobar_idx02" ON "foobar" ("foo")', 'constraint created');
}
}
{
my $schema = SQL::Translator::Schema->new();
my $table = $schema->add_table( name => 'foo', fields => ['bar'] );
{
my $trigger = $schema->add_trigger(
name => 'mytrigger',
perform_action_when => 'before',
database_events => 'update',
on_table => 'foo',
fields => ['bar'],
action => 'BEGIN baz() END'
);
my ($def) = SQL::Translator::Producer::SQLite::create_trigger($trigger);
is($def, 'CREATE TRIGGER "mytrigger" before update on "foo" BEGIN baz() END', 'trigger created');
}
{
my $trigger = $schema->add_trigger(
name => 'mytrigger2',
perform_action_when => 'after',
database_events => ['insert'],
on_table => 'foo',
fields => ['bar'],
action => 'baz()'
);
my ($def) = SQL::Translator::Producer::SQLite::create_trigger($trigger);
is($def, 'CREATE TRIGGER "mytrigger2" after insert on "foo" BEGIN baz() END', 'trigger created');
}
}
{
my $table = SQL::Translator::Schema::Table->new( name => 'foobar', fields => ['foo'] );
my $constr = $table->add_constraint(name => 'constr', expression => "foo != 'baz'");
my ($def) = SQL::Translator::Producer::SQLite::create_check_constraint($constr);
is($def, q{CONSTRAINT "constr" CHECK(foo != 'baz')}, 'check constraint created');
}
done_testing;
SQL-Translator-0.11024/t/14postgres-parser.t 0000644 0001750 0001750 00000036575 13070420670 017737 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use Test::More;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(undef, 'SQL::Translator::Parser::PostgreSQL');
SQL::Translator::Parser::PostgreSQL->import('parse');
}
my $t = SQL::Translator->new( trace => 0 );
my $sql = q{
-- comment on t_test1
create table t_test1 (
-- this is the primary key
f_serial serial NOT NULL default '0' primary key,
f_varchar character varying (255),
f_double double precision,
f_bigint bigint not null,
f_char character(10) default 'FOO'::character(10),
f_bool boolean,
f_bin bytea,
f_tz timestamp default '1970-01-01 00:00:00'::TIMESTAMP,
f_text text,
f_fk1 integer not null references t_test2 (f_id),
f_dropped text,
f_timestamp timestamp(0) with time zone,
f_timestamp2 timestamp without time zone,
f_json json,
f_hstore hstore,
f_numarray numeric(7,2) [ ],
f_uuid uuid,
f_time time(0) with time zone,
f_time2 time without time zone
);
create table t_test2 (
f_id integer NOT NULL,
f_varchar varchar(25),
f_int smallint,
f_smallint smallint default (0)::smallint,
primary key (f_id),
check (f_int between 1 and 5)
);
CREATE TABLE products_1 (
product_no integer,
name text,
price numeric
);
CREATE TEMP TABLE products_2 (
product_no integer,
name text,
price numeric
);
CREATE TEMPORARY TABLE products_3 (
product_no integer,
name text,
price numeric
);
CREATE TRIGGER test_trigger
BEFORE INSERT OR UPDATE OR DELETE
ON products_1
FOR EACH ROW
EXECUTE PROCEDURE foo();
CREATE INDEX test_index1 ON t_test1 (f_varchar);
CREATE INDEX test_index2 ON t_test1 USING hash (f_char, f_bool);
CREATE INDEX test_index3 ON t_test1 USING hash (f_bigint, f_tz) WHERE f_bigint = '1' AND f_tz IS NULL;
alter table t_test1 add f_fk2 integer;
alter table only t_test1 add constraint c_u1 unique (f_varchar);
alter table t_test1 add constraint "c_fk2" foreign key (f_fk2)
references t_test2 (f_id) match simple
on update no action on delete cascade deferrable;
alter table t_test1 drop column f_dropped restrict;
alter table t_test1 alter column f_fk2 set default 'FOO';
alter table t_test1 alter column f_char drop default;
-- The following are allowed by the grammar
-- but won\'t do anything... - ky
alter table t_text1 alter column f_char set not null;
alter table t_text1 alter column f_char drop not null;
alter table t_test1 alter f_char set statistics 10;
alter table t_test1 alter f_text set storage extended;
alter table t_test1 rename column f_text to foo;
alter table t_test1 rename to foo;
alter table only t_test1 drop constraint foo cascade;
alter table t_test1 owner to foo;
commit;
};
$| = 1;
my $data = parse( $t, $sql );
my $schema = $t->schema;
isa_ok( $schema, 'SQL::Translator::Schema', 'Schema object' );
my @tables = $schema->get_tables;
is( scalar @tables, 5, 'Five tables' );
my $t1 = shift @tables;
is( $t1->name, 't_test1', 'Table t_test1 exists' );
is( $t1->comments, 'comment on t_test1', 'Table comment exists' );
my @t1_fields = $t1->get_fields;
is( scalar @t1_fields, 19, '19 fields in t_test1' );
my $f1 = shift @t1_fields;
is( $f1->name, 'f_serial', 'First field is "f_serial"' );
is( $f1->data_type, 'integer', 'Field is an integer' );
is( $f1->is_nullable, 0, 'Field cannot be null' );
is( $f1->size, 11, 'Size is "11"' );
is( $f1->default_value, '0', 'Default value is "0"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
is( $f1->comments, 'this is the primary key', 'Comment' );
is( $f1->is_auto_increment, 1, 'Field is auto increment' );
my $f2 = shift @t1_fields;
is( $f2->name, 'f_varchar', 'Second field is "f_varchar"' );
is( $f2->data_type, 'varchar', 'Field is a varchar' );
is( $f2->is_nullable, 1, 'Field can be null' );
is( $f2->size, 255, 'Size is "255"' );
is( $f2->default_value, undef, 'Default value is undefined' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
is( $f2->is_auto_increment, 0, 'Field is not auto increment' );
my $f3 = shift @t1_fields;
is( $f3->name, 'f_double', 'Third field is "f_double"' );
is( $f3->data_type, 'float', 'Field is a float' );
is( $f3->is_nullable, 1, 'Field can be null' );
is( $f3->size, 20, 'Size is "20"' );
is( $f3->default_value, undef, 'Default value is undefined' );
is( $f3->is_primary_key, 0, 'Field is not PK' );
my $f4 = shift @t1_fields;
is( $f4->name, 'f_bigint', 'Fourth field is "f_bigint"' );
is( $f4->data_type, 'integer', 'Field is an integer' );
is( $f4->is_nullable, 0, 'Field cannot be null' );
is( $f4->size, 20, 'Size is "20"' );
is( $f4->default_value, undef, 'Default value is undefined' );
is( $f4->is_primary_key, 0, 'Field is not PK' );
my $f5 = shift @t1_fields;
is( $f5->name, 'f_char', 'Fifth field is "f_char"' );
is( $f5->data_type, 'char', 'Field is char' );
is( $f5->is_nullable, 1, 'Field can be null' );
is( $f5->size, 10, 'Size is "10"' );
is( $f5->default_value, undef, 'Default value is undefined' );
is( $f5->is_primary_key, 0, 'Field is not PK' );
my $f6 = shift @t1_fields;
is( $f6->name, 'f_bool', 'Sixth field is "f_bool"' );
is( $f6->data_type, 'boolean', 'Field is a boolean' );
is( $f6->is_nullable, 1, 'Field can be null' );
is( $f6->size, 0, 'Size is "0"' );
is( $f6->default_value, undef, 'Default value is undefined' );
is( $f6->is_primary_key, 0, 'Field is not PK' );
my $f7 = shift @t1_fields;
is( $f7->name, 'f_bin', 'Seventh field is "f_bin"' );
is( $f7->data_type, 'bytea', 'Field is bytea' );
is( $f7->is_nullable, 1, 'Field can be null' );
is( $f7->size, 0, 'Size is "0"' );
is( $f7->default_value, undef, 'Default value is undefined' );
is( $f7->is_primary_key, 0, 'Field is not PK' );
my $f8 = shift @t1_fields;
is( $f8->name, 'f_tz', 'Eighth field is "f_tz"' );
is( $f8->data_type, 'timestamp', 'Field is a timestamp' );
is( $f8->is_nullable, 1, 'Field can be null' );
is( $f8->size, 0, 'Size is "0"' );
is( $f8->default_value, '1970-01-01 00:00:00', 'Default value is 1970-01-01 00:00:00' );
is( $f8->is_primary_key, 0, 'Field is not PK' );
my $f9 = shift @t1_fields;
is( $f9->name, 'f_text', 'Ninth field is "f_text"' );
is( $f9->data_type, 'text', 'Field is text' );
is( $f9->is_nullable, 1, 'Field can be null' );
is( $f9->size, 64000, 'Size is "64,000"' );
is( $f9->default_value, undef, 'Default value is undefined' );
is( $f9->is_primary_key, 0, 'Field is not PK' );
my $f10 = shift @t1_fields;
is( $f10->name, 'f_fk1', 'Tenth field is "f_fk1"' );
is( $f10->data_type, 'integer', 'Field is an integer' );
is( $f10->is_nullable, 0, 'Field cannot be null' );
is( $f10->size, 10, 'Size is "10"' );
is( $f10->default_value, undef, 'Default value is undefined' );
is( $f10->is_primary_key, 0, 'Field is not PK' );
is( $f10->is_foreign_key, 1, 'Field is a FK' );
my $fk_ref1 = $f10->foreign_key_reference;
isa_ok( $fk_ref1, 'SQL::Translator::Schema::Constraint', 'FK' );
is( $fk_ref1->reference_table, 't_test2', 'FK is to "t_test2" table' );
my $f11 = shift @t1_fields;
is( $f11->name, 'f_timestamp', 'Eleventh field is "f_timestamp"' );
is( $f11->data_type, 'timestamp with time zone', 'Field is a timestamp with time zone' );
is( $f11->is_nullable, 1, 'Field can be null' );
is( $f11->size, 0, 'Size is "0"' );
is( $f11->default_value, undef, 'Default value is "undef"' );
is( $f11->is_primary_key, 0, 'Field is not PK' );
is( $f11->is_foreign_key, 0, 'Field is not FK' );
my $f12 = shift @t1_fields;
is( $f12->name, 'f_timestamp2', '12th field is "f_timestamp2"' );
is( $f12->data_type, 'timestamp without time zone', 'Field is a timestamp without time zone' );
is( $f12->is_nullable, 1, 'Field can be null' );
is( $f12->size, 0, 'Size is "0"' );
is( $f12->default_value, undef, 'Default value is "undef"' );
is( $f12->is_primary_key, 0, 'Field is not PK' );
is( $f12->is_foreign_key, 0, 'Field is not FK' );
my $f13 = shift @t1_fields;
is( $f13->name, 'f_json', '13th field is "f_json"' );
is( $f13->data_type, 'json', 'Field is Json' );
is( $f13->is_nullable, 1, 'Field can be null' );
is( $f13->size, 0, 'Size is "0"' );
is( $f13->default_value, undef, 'Default value is "undef"' );
is( $f13->is_primary_key, 0, 'Field is not PK' );
is( $f13->is_foreign_key, 0, 'Field is not FK' );
my $f14 = shift @t1_fields;
is( $f14->name, 'f_hstore', '14th field is "f_hstore"' );
is( $f14->data_type, 'hstore', 'Field is hstore' );
is( $f14->is_nullable, 1, 'Field can be null' );
is( $f14->size, 0, 'Size is "0"' );
is( $f14->default_value, undef, 'Default value is "undef"' );
is( $f14->is_primary_key, 0, 'Field is not PK' );
is( $f14->is_foreign_key, 0, 'Field is not FK' );
my $f15 = shift @t1_fields;
is( $f15->name, 'f_numarray', '15th field is "f_numarray"' );
is( $f15->data_type, 'numeric[]', 'Field is numeric[]' );
is( $f15->is_nullable, 1, 'Field can be null' );
is_deeply( [$f15->size], [7,2] , 'Size is "7,2"' );
is( $f15->default_value, undef, 'Default value is "undef"' );
is( $f15->is_primary_key, 0, 'Field is not PK' );
is( $f15->is_foreign_key, 0, 'Field is not FK' );
my $f16 = shift @t1_fields;
is( $f16->name, 'f_uuid', '16th field is "f_uuid"' );
is( $f16->data_type, 'uuid', 'Field is a UUID' );
is( $f16->is_nullable, 1, 'Field can be null' );
is( $f16->size, 0, 'Size is "0"' );
is( $f16->default_value, undef, 'Default value is "undef"' );
is( $f16->is_primary_key, 0, 'Field is not PK' );
is( $f16->is_foreign_key, 0, 'Field is not FK' );
my $f17 = shift @t1_fields;
is( $f17->name, 'f_time', '17th field is "f_time"' );
is( $f17->data_type, 'time with time zone', 'Field is a time with time zone' );
is( $f17->is_nullable, 1, 'Field can be null' );
is( $f17->size, 0, 'Size is "0"' );
is( $f17->default_value, undef, 'Default value is "undef"' );
is( $f17->is_primary_key, 0, 'Field is not PK' );
is( $f17->is_foreign_key, 0, 'Field is not FK' );
my $f18 = shift @t1_fields;
is( $f18->name, 'f_time2', '18th field is "f_time2"' );
is( $f18->data_type, 'time without time zone', 'Field is a time without time zone' );
is( $f18->is_nullable, 1, 'Field can be null' );
is( $f18->size, 0, 'Size is "0"' );
is( $f18->default_value, undef, 'Default value is "undef"' );
is( $f18->is_primary_key, 0, 'Field is not PK' );
is( $f18->is_foreign_key, 0, 'Field is not FK' );
# my $fk_ref2 = $f11->foreign_key_reference;
# isa_ok( $fk_ref2, 'SQL::Translator::Schema::Constraint', 'FK' );
# is( $fk_ref2->reference_table, 't_test2', 'FK is to "t_test2" table' );
my @t1_constraints = $t1->get_constraints;
is( scalar @t1_constraints, 8, '8 constraints on t_test1' );
my $c1 = $t1_constraints[0];
is( $c1->type, PRIMARY_KEY, 'First constraint is PK' );
is( join(',', $c1->fields), 'f_serial', 'Constraint is on field "f_serial"' );
my $c2 = $t1_constraints[4];
is( $c2->type, FOREIGN_KEY, 'Second constraint is foreign key' );
is( join(',', $c2->fields), 'f_fk1', 'Constraint is on field "f_fk1"' );
is( $c2->reference_table, 't_test2', 'Constraint is to table "t_test2"' );
is( join(',', $c2->reference_fields), 'f_id', 'Constraint is to field "f_id"' );
my $c3 = $t1_constraints[5];
is( $c3->type, UNIQUE, 'Third constraint is unique' );
is( join(',', $c3->fields), 'f_varchar', 'Constraint is on field "f_varchar"' );
my $c4 = $t1_constraints[6];
is( $c4->type, FOREIGN_KEY, 'Fourth constraint is foreign key' );
is( join(',', $c4->fields), 'f_fk2', 'Constraint is on field "f_fk2"' );
is( $c4->reference_table, 't_test2', 'Constraint is to table "t_test2"' );
is( join(',', $c4->reference_fields), 'f_id', 'Constraint is to field "f_id"' );
is( $c4->on_delete, 'cascade', 'On delete: cascade' );
is( $c4->on_update, 'no_action', 'On delete: no action' );
is( $c4->match_type, 'simple', 'Match type: simple' );
is( $c4->deferrable, 1, 'Deferrable detected' );
my $t2 = shift @tables;
is( $t2->name, 't_test2', 'Table t_test2 exists' );
my @t2_fields = $t2->get_fields;
is( scalar @t2_fields, 4, '4 fields in t_test2' );
my $t2_f1 = shift @t2_fields;
is( $t2_f1->name, 'f_id', 'First field is "f_id"' );
is( $t2_f1->data_type, 'integer', 'Field is an integer' );
is( $t2_f1->is_nullable, 0, 'Field cannot be null' );
is( $t2_f1->size, 10, 'Size is "10"' );
is( $t2_f1->default_value, undef, 'Default value is undefined' );
is( $t2_f1->is_primary_key, 1, 'Field is PK' );
my $t2_f2 = shift @t2_fields;
is( $t2_f2->name, 'f_varchar', 'Second field is "f_varchar"' );
is( $t2_f2->data_type, 'varchar', 'Field is an varchar' );
is( $t2_f2->is_nullable, 1, 'Field can be null' );
is( $t2_f2->size, 25, 'Size is "25"' );
is( $t2_f2->default_value, undef, 'Default value is undefined' );
is( $t2_f2->is_primary_key, 0, 'Field is not PK' );
my $t2_f3 = shift @t2_fields;
is( $t2_f3->name, 'f_int', 'Third field is "f_int"' );
is( $t2_f3->data_type, 'integer', 'Field is an integer' );
is( $t2_f3->is_nullable, 1, 'Field can be null' );
is( $t2_f3->size, 5, 'Size is "5"' );
is( $t2_f3->default_value, undef, 'Default value is undefined' );
is( $t2_f3->is_primary_key, 0, 'Field is not PK' );
my $t2_f4 = shift @t2_fields;
is( $t2_f4->name, 'f_smallint', 'Fourth field is "f_smallint"' );
is( $t2_f4->data_type, 'integer', 'Field is an integer' );
is( $t2_f4->is_nullable, 1, 'Field can be null' );
is( $t2_f4->size, 5, 'Size is "5"' );
is( $t2_f4->default_value, 0, 'Default value is 0' );
is( $t2_f4->is_primary_key, 0, 'Field is not PK' );
my @t2_constraints = $t2->get_constraints;
is( scalar @t2_constraints, 3, "Three constraints on table" );
my $t2_c1 = shift @t2_constraints;
is( $t2_c1->type, NOT_NULL, "Constraint is NOT NULL" );
my $t2_c2 = shift @t2_constraints;
is( $t2_c2->type, PRIMARY_KEY, "Constraint is a PK" );
my $t2_c3 = shift @t2_constraints;
is( $t2_c3->type, CHECK_C, "Constraint is a 'CHECK'" );
# test temporary tables
is( exists $schema->get_table('products_1')->extra()->{'temporary'}, "", "Table is NOT temporary");
is( $schema->get_table('products_2')->extra('temporary'), 1,"Table is TEMP");
is( $schema->get_table('products_3')->extra('temporary'), 1,"Table is TEMPORARY");
# test trigger
my $trigger = $schema->get_trigger('test_trigger');
is( $trigger->on_table, 'products_1', "Trigger is on correct table");
is_deeply( scalar $trigger->database_events, [qw(insert update delete)], "Correct events for trigger");
is( $trigger->perform_action_when, 'before', "Correct time for trigger");
is( $trigger->scope, 'row', "Correct scope for trigger");
is( $trigger->action, 'EXECUTE PROCEDURE foo()', "Correct action for trigger");
# test index
my @indices = $t1->get_indices;
is(scalar @indices, 3, 'got three indexes');
my $t1_i1 = $indices[0];
is( $t1_i1->name, 'test_index1', 'First index is "test_index1"' );
is( join(',', $t1_i1->fields), 'f_varchar', 'Index is on field "f_varchar"' );
is_deeply( [ $t1_i1->options ], [], 'Index is has no options' );
my $t1_i2 = $indices[1];
is( $t1_i2->name, 'test_index2', 'Second index is "test_index2"' );
is( join(',', $t1_i2->fields), 'f_char,f_bool', 'Index is on fields "f_char, f_bool"' );
is_deeply( [ $t1_i2->options ], [ { using => 'hash' } ], 'Index is using hash method' );
my $t1_i3 = $indices[2];
is( $t1_i3->name, 'test_index3', 'Third index is "test_index3"' );
is( join(',', $t1_i3->fields), 'f_bigint,f_tz', 'Index is on fields "f_bigint, f_tz"' );
is_deeply(
[ $t1_i3->options ],
[ { using => 'hash' }, { where => "f_bigint = '1' AND f_tz IS NULL" } ],
'Index is using hash method and has predicate right'
);
done_testing;
SQL-Translator-0.11024/t/53-oracle-delay-constraints.t 0000644 0001750 0001750 00000001466 12163313615 021556 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(2, 'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::Oracle');
}
my $yamlfile = "$Bin/data/oracle/schema_with_options.yaml";
my $sqlt;
$sqlt = SQL::Translator->new(
show_warnings => 0,
add_drop_table => 0,
producer_args => { 'delay_constraints' => 1 },
quote_table_names => 0,
quote_field_names => 0,
);
my $sql_string = $sqlt->translate(
from => 'YAML',
to => 'Oracle',
filename => $yamlfile,
);
ok($sql_string, 'Translation successfull');
ok($sql_string =~ /ADD CONSTRAINT pk_d_operator PRIMARY KEY/, 'constraints delayed');
SQL-Translator-0.11024/t/30sqlt-new-diff.t 0000644 0001750 0001750 00000007517 12163313615 017251 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use warnings;
use SQL::Translator;
use File::Spec::Functions qw(catfile updir tmpdir);
use FindBin qw($Bin);
use Test::More;
use Test::Differences;
plan tests => 10;
use_ok('SQL::Translator::Diff') or die "Cannot continue\n";
my $tr = SQL::Translator->new;
my ( $source_schema, $target_schema ) = map {
my $t = SQL::Translator->new;
$t->parser( 'YAML' )
or die $tr->error;
my $out = $t->translate( catfile($Bin, qw/data diff /, $_ ) )
or die $tr->error;
my $schema = $t->schema;
unless ( $schema->name ) {
$schema->name( $_ );
}
($schema);
} (qw/create1.yml create2.yml/);
# Test for differences
my $diff = SQL::Translator::Diff->new({
source_schema => $source_schema,
source_db => 'MySQL',
target_schema => $target_schema,
target_db => 'MySQL',
})->compute_differences;
my $diff_hash = make_diff_hash();
eq_or_diff($diff_hash->{employee},
{
constraints_to_create => [ 'FK5302D47D93FE702E_diff' ],
constraints_to_drop => [ 'FK5302D47D93FE702E' ],
fields_to_drop => [ 'job_title' ]
},
"Correct differences correct on employee table");
eq_or_diff($diff_hash->{person},
{
constraints_to_create => [ 'UC_person_id', 'UC_age_name' ],
constraints_to_drop => [ 'UC_age_name' ],
fields_to_alter => [
'person_id person_id',
'name name',
'age age',
'iq iq',
],
fields_to_create => [ 'is_rock_star' ],
fields_to_rename => [ 'description physical_description' ],
indexes_to_create => [ 'unique_name' ],
indexes_to_drop => [ 'u_name' ],
table_options => [ 'person' ],
},
"Correct differences correct on person table");
eq_or_diff(
[ map { $_->name } @{$diff->tables_to_drop} ],
[ "deleted" ],
"tables_to_drop right"
);
eq_or_diff(
[ map { $_->name } @{$diff->tables_to_create} ],
[ "added" ],
"tables_to_create right"
);
$diff = SQL::Translator::Diff->new({
source_schema => $source_schema,
source_db => 'MySQL',
target_schema => $target_schema,
target_db => 'MySQL',
ignore_index_names => 1,
ignore_constraint_names => 1,
})->compute_differences;
$diff_hash = make_diff_hash();
eq_or_diff($diff_hash->{employee},
{
fields_to_drop => [ 'job_title' ]
},
"Correct differences correct on employee table");
eq_or_diff($diff_hash->{person},
{
constraints_to_create => [ 'UC_person_id', 'UC_age_name' ],
constraints_to_drop => [ 'UC_age_name' ],
fields_to_alter => [
'person_id person_id',
'name name',
'age age',
'iq iq',
],
fields_to_create => [ 'is_rock_star' ],
fields_to_rename => [ 'description physical_description' ],
table_options => [ 'person' ],
},
"Correct differences correct on person table");
# Test for sameness
$diff = SQL::Translator::Diff->new({
source_schema => $source_schema,
source_db => 'MySQL',
target_schema => $source_schema,
target_db => 'MySQL',
})->compute_differences;
$diff_hash = make_diff_hash();
eq_or_diff($diff_hash, {}, "No differences");
is( @{$diff->tables_to_drop}, 0, "tables_to_drop right");
is( @{$diff->tables_to_create}, 0, "tables_to_create right");
# Turn table_diff_hash into something we can eq_or_diff better
sub make_diff_hash {
return {
map {
my $table = $_;
my $table_diff = $diff->table_diff_hash->{$table};
my %table_diffs = (
map {
my $opt = $table_diff->{$_};
@$opt ? ( $_ => [ map {
(ref $_||'') eq 'ARRAY' ? "@$_" :
(ref $_) ? $_->name
: "$_";
} @$opt
] )
: ()
} keys %$table_diff
);
%table_diffs ? ( $table => \%table_diffs ) : ();
} keys %{ $diff->table_diff_hash }
};
}
SQL-Translator-0.11024/t/61translator_agnostic.t 0000644 0001750 0001750 00000002175 12163313615 020650 0 ustar ilmari ilmari #!/usr/bin/perl
use warnings;
use strict;
use Test::More;
use Test::SQL::Translator;
use FindBin qw/$Bin/;
BEGIN {
maybe_plan(1, 'SQL::Translator::Parser::XML',
'SQL::Translator::Producer::XML');
}
use SQL::Translator;
# Producing a schema with a Translator different from the one the schema was
# generated should just work. After all the $schema object is just data.
my $base_file = "$Bin/data/xml/schema.xml";
my $base_t = SQL::Translator->new;
$base_t->$_ (1) for qw/add_drop_table no_comments/;
# create a base schema attached to $base_t
my $base_schema = $base_t->translate (
parser => 'XML',
file => $base_file,
) or die $base_t->error;
# now create a new translator and try to feed it the same schema
my $new_t = SQL::Translator->new;
$new_t->$_ (1) for qw/add_drop_table no_comments/;
my $sql = $new_t->translate (
data => $base_schema,
producer => 'SQLite'
);
TODO: {
local $TODO = 'This will probably not work before the rewrite';
like (
$sql,
qr/^\s*CREATE TABLE/m, #assume there is at least one create table statement
"Received some meaningful output from the producer",
);
}
SQL-Translator-0.11024/t/55-oracle-producer.t 0000644 0001750 0001750 00000004555 12163313615 017742 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use warnings;
use Test::More;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Schema::Table;
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Constraint;
use SQL::Translator::Producer::Oracle;
{
my $table1 = SQL::Translator::Schema::Table->new( name => 'table1' );
my $table1_field1 = $table1->add_field(
name => 'fk_col1',
data_type => 'NUMBER',
size => 6,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 1,
is_unique => 0
);
my $table1_field2 = $table1->add_field(
name => 'fk_col2',
data_type => 'VARCHAR',
size => 64,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 1,
is_unique => 0
);
my $table2 = SQL::Translator::Schema::Table->new( name => 'table2' );
my $table2_field1 = $table2->add_field(
name => 'fk_col1',
data_type => 'NUMBER',
size => 6,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0
);
my $table2_field2 = $table2->add_field(
name => 'fk_col2',
data_type => 'VARCHAR',
size => 64,
default_value => undef,
is_auto_increment => 0,
is_nullable => 0,
is_foreign_key => 0,
is_unique => 0
);
my $constraint1 = $table1->add_constraint(
name => 'foo',
fields => [qw/ fk_col1 fk_col2 /],
reference_fields => [qw/ fk_col1 fk_col2 /],
reference_table => 'table2',
type => FOREIGN_KEY,
);
my ($table1_def, $fk1_def, $trigger1_def,
$index1_def, $constraint1_def
) = SQL::Translator::Producer::Oracle::create_table($table1);
is_deeply(
$fk1_def,
[ 'ALTER TABLE table1 ADD CONSTRAINT table1_fk_col1_fk_col2_fk FOREIGN KEY (fk_col1, fk_col2) REFERENCES table2 (fk_col1, fk_col2)'
],
'correct "CREATE CONSTRAINT" SQL'
);
}
done_testing();
SQL-Translator-0.11024/t/20format_X_name.t 0000644 0001750 0001750 00000006125 12163313615 017341 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
use strict;
use SQL::Translator;
use Test::More tests => 25;
my ($tr, $ret);
my %format_X_name = (
format_table_name => sub { "table_$_[0]" },
format_package_name => sub { "package_$_[0]" },
format_fk_name => sub { "fk_$_[0]" },
format_pk_name => sub { "pk_$_[0]" },
);
ok($tr = SQL::Translator->new);
is(($ret = $tr->format_table_name("foo")), "foo",
'$tr->format_table_name("foo") == "foo"');
is(($ret = $tr->format_package_name("foo")), "foo",
'$tr->format_package_name("foo") == "foo"');
is(($ret = $tr->format_fk_name("foo")), "foo",
'$tr->format_fk_name("foo") == "foo"');
is(($ret = $tr->format_pk_name("foo")), "foo",
'$tr->format_pk_name("foo") == "foo"');
ok($tr->format_table_name($format_X_name{format_table_name}),
'$tr->format_table_name(sub { "table_$_[0]" })');
is(($ret = $tr->format_table_name("foo")), "table_foo",
'$tr->format_table_name("foo") == "table_foo"');
ok($tr->format_package_name($format_X_name{format_package_name}),
'$tr->format_package_name(sub { "package_$_[0]" })');
is(($ret = $tr->format_package_name("foo")), "package_foo",
'$tr->format_package_name("foo") == "package_foo"');
ok($tr->format_fk_name($format_X_name{format_fk_name}),
'$tr->format_fk_name(sub { "fk_$_[0]" })');
is(($ret = $tr->format_fk_name("foo")), "fk_foo",
'$tr->format_fk_name("foo") == "fk_foo"');
ok($tr->format_pk_name($format_X_name{format_pk_name}),
'$tr->format_pk_name(sub { "pk_$_[0]" })');
is(($ret = $tr->format_pk_name("foo")), "pk_foo",
'$tr->format_pk_name("foo") == "pk_foo"');
ok($tr->format_table_name($format_X_name{format_table_name}),
'$tr->format_table_name(sub { "table_$_[0]" })');
is(($ret = $tr->format_table_name("foo")), "table_foo",
'$tr->format_table_name("foo") == "table_foo"');
ok($tr->format_package_name($format_X_name{format_package_name}),
'$tr->format_package_name(sub { "package_$_[0]" })');
is(($ret = $tr->format_package_name("foo")), "package_foo",
'$tr->format_package_name("foo") == "package_foo"');
ok($tr->format_fk_name($format_X_name{format_fk_name}),
'$tr->format_fk_name(sub { "fk_$_[0]" })');
is(($ret = $tr->format_fk_name("foo")), "fk_foo",
'$tr->format_fk_name("foo") == "fk_foo"');
ok($tr->format_pk_name($format_X_name{format_pk_name}),
'$tr->format_pk_name(sub { "pk_$_[0]" })');
is(($ret = $tr->format_pk_name("foo")), "pk_foo",
'$tr->format_pk_name("foo") == "pk_foo"');
is(($ret = $tr->format_table_name($format_X_name{format_table_name}, "foo")), "table_foo",
'$tr->format_table_name(sub { "table_$_[0]" }, "foo") == "table_foo"');
is(($ret = $tr->format_package_name($format_X_name{format_package_name}, "foo")), "package_foo",
'$tr->format_package_name(sub { "package_$_[0]" }, "foo") == "package_foo"');
is(($ret = $tr->format_fk_name($format_X_name{format_fk_name}, "foo")), "fk_foo",
'$tr->format_fk_name(sub { "fk_$_[0]" }, "foo") == "fk_foo"');
is(($ret = $tr->format_pk_name($format_X_name{format_pk_name}, "foo")), "pk_foo",
'$tr->format_pk_name(sub { "pk_$_[0]" }, "foo") == "pk_foo"');
SQL-Translator-0.11024/t/06xsv.t 0000644 0001750 0001750 00000004332 12163313615 015404 0 ustar ilmari ilmari #!/usr/bin/perl
# vim: set ft=perl:
#
# Tests for xSV parser
#
use strict;
use SQL::Translator;
use SQL::Translator::Schema;
use SQL::Translator::Schema::Constants;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
maybe_plan(25, 'SQL::Translator::Parser::xSV');
SQL::Translator::Parser::xSV->import('parse');
}
my $tr = SQL::Translator->new;
my $s = SQL::Translator::Schema->new;
my $data = q|One, Two, Three, Four, Five, Six, Seven
I, Am, Some, Data, Yo, -10, .04
And, So, am, I, "you crazy, crazy bastard", 500982, 1.1
|;
$tr->parser_args( trim_fields => 1, scan_fields => 1 );
my $val = parse($tr, $data, $s);
my $schema = $tr->schema;
my @tables = $schema->get_tables;
is( scalar @tables, 1, 'Correct number of tables (1)' );
my $table = shift @tables;
is( $table->name, 'table1', 'Table is named "table1"' );
my @fields = $table->get_fields;
is( scalar @fields, 7, 'Correct number of fields (7)' );
my $f1 = $fields[0];
is( $f1->name, 'One', 'First field name is "One"' );
is( $f1->data_type, 'char', 'Data type is "char"' );
is( $f1->size, '3', 'Size is "3"' );
is( $f1->is_primary_key, 1, 'Field is PK' );
my $f2 = $fields[1];
is( $f2->name, 'Two', 'First field name is "Two"' );
is( $f2->data_type, 'char', 'Data type is "char"' );
is( $f2->size, '2', 'Size is "2"' );
is( $f2->is_primary_key, 0, 'Field is not PK' );
my $f5 = $fields[4];
is( $f5->name, 'Five', 'Fifth field name is "Five"' );
is( $f5->data_type, 'char', 'Data type is "char"' );
is( $f5->size, '26', 'Size is "26"' );
is( $f5->is_primary_key, 0, 'Field is not PK' );
my $f6 = $fields[5];
is( $f6->name, 'Six', 'Sixth field name is "Six"' );
is( $f6->data_type, 'integer', 'Data type is "integer"' );
is( $f6->size, '6', 'Size is "6"' );
my $f7 = $fields[6];
is( $f7->name, 'Seven', 'Seventh field name is "Seven"' );
is( $f7->data_type, 'float', 'Data type is "float"' );
is( $f7->size, '3,2', 'Size is "3,2"' );
my @indices = $table->get_indices;
is( scalar @indices, 0, 'Correct number of indices (0)' );
my @constraints = $table->get_constraints;
is( scalar @constraints, 1, 'Correct number of constraints (1)' );
my $c = shift @constraints;
is( $c->type, PRIMARY_KEY, 'Constraint is a PK' );
is( join(',', $c->fields), 'One', 'On field "One"' );
SQL-Translator-0.11024/t/52-oracle-options.t 0000644 0001750 0001750 00000001346 12163313615 017602 0 ustar ilmari ilmari #!/usr/bin/perl
use strict;
use FindBin qw/$Bin/;
use Test::More;
use Test::SQL::Translator;
use Test::Exception;
use Data::Dumper;
use SQL::Translator;
use SQL::Translator::Schema::Constants;
BEGIN {
maybe_plan(3, 'SQL::Translator::Parser::YAML',
'SQL::Translator::Producer::Oracle');
}
my $yamlfile = "$Bin/data/oracle/schema_with_options.yaml";
my $sqlt;
$sqlt = SQL::Translator->new(
show_warnings => 0,
add_drop_table => 0,
);
my $sql_string = $sqlt->translate(
from => 'YAML',
to => 'Oracle',
filename => $yamlfile,
);
ok($sql_string, 'Translation successfull');
ok($sql_string =~ /TABLESPACE\s+DATA/, 'Table options');
ok($sql_string =~ /TABLESPACE\s+INDX/, 'Index options');
SQL-Translator-0.11024/AUTHORS 0000644 0001750 0001750 00000005077 12533577437 015064 0 ustar ilmari ilmari The following people have contributed to the SQLFairy project:
- Aaron Schrab
- Adam Strzelecki
- Alexander Hartmaier
- Allen Day
- Amiri Barksdale
- Anders Nor Berle
- André Walker
- Andreas 'ac0v' Specht
- Andrew Moore
- Andrew Gregory
- Andrew Pam
- Arthur Axel "fREW" Schmidt
- Ben Faga
- Cedric Carree
- Chris Hilton
- Chris Mungall
- Chris To
- Colin Newell
- Dagfinn Ilmari Mannsåker
- Daniel Ruoso
- Darren Chamberlain
- Dave Cash
- Fabien Wernli
- Fabrice Gabolde
- Geoff Cant
- Gudmundur A. Thorisson
- Guillermo Roditi
- Ivan Baidakou (basiliscos)
- Jaime Soriano Pastor
- Jason Williams
- Johan Viklund
- John Goulah
- John Napiorkowski
- Jonathan Yu
- Ken Youens-Clark
- Kevin McClellan
- Lukas 'mauke' Mai
- Lukas Thiemeier
- Mark Addison
- Maximilian Gass
- H.Merijn Brand
- Michal Jurosz
- Mikey Melillo
- Moritz Onken
- Nick Wellnhofer
- Paul Harrington
- Peter Rabbitson
- Robert Bohne
- Ross Smith II
- Ryan D Johnson
- Salvatore Bonaccorso
- Sam Angiuoli
- Sebastian Knapp
- Stephen Bennett
- Stephen Clouse
- SymKat
- Tina Müller
- Vincent Bachelier
- Wallace Reis
- William Wolf
- Ying Zhang
- Zefram
SQL-Translator-0.11024/Changes 0000644 0001750 0001750 00000062735 13225113500 015263 0 ustar ilmari ilmari Changes for SQL::Translator
0.11024 2018-01-09
* Remove temporary diagnostics added in 0.11023_01
0.11023_02 2017-12-08
* Make maybe_plan skip on unrecognised failures to load modules
0.11023_01 2017-12-07
* Add diagnostics to t/postgresql-rename-table-and-field.t that's
failing mysteriously on some smokers
0.11023 2017-12-05
* Fix error handling for Test::PostgreSQL 1.20
0.11022 2017-12-04
* Add support for monotonically increasing SQLite autoincs (GH#47)
* Add support for CHECK constraint in SQLite producer (GH#57)
* Add support for CHECK constraint in POD producer (GH#63)
* Fix forgotten quoting in the MySQL DROP TABLE diff producer (GH#50)
* Fix Pg grammar parsing of UUID, time, timetz columns (RT#100196, GH#52)
* Add support for USING and WHERE on indexes in PostgreSQL producer
and parser (RT#63814, GH#52)
* Improve add_trigger consistency between producers (GH#48)
* Add trigger 'scope' attribute support to JSON, YAML and XML producers,
and XML and SQLite parsers (RT#119997)
* Declare dependencies in deterministic order (RT#102859)
* Multiple speedups of naive internal debugging mechanism (GH#54)
* Remove dependency on List::MoreUtils ( http://is.gd/lmu_cac_debacle )
* Fix parsing of strings with leading whitespace for MySQL, Oracle, PostgreSQL,
SQLServer and SQLite
* Fix parsing of MySQL column comments (RT#83380)
* Fix multi-line comments in YAML, JSON and PostgreSQL producers
* Fix identifier quoting in PostgreSQL diff producer
* Fix incorrect type conversion from various BigInt AutoIncrement to the
PostgreSQL-specific bigserial (GH#72)
* Fix missing semicolons between PostGIS statements
* Fix string and identifier quoting in PostGIS statements
* Fix intermittent test failures (RT#108460)
* Fix relying on exact serialisation for JSON/YAML tests (RT#121901)
0.11021 2015-01-29
* Fix Oracle producer generating an unnecessary / at the end in case there
are no triggers
* Skip HTML tests if CGI is not installed (RT#98027)
* Fix JSON and YAML tests if the defaults have been tweaked (RT#98824)
* Fixes for parsing and producing identifiers and values that need
quoting and escaping for SQLite, MySQL, PostgreSQL, SQLServer and
Oracle (RT#90700, RT#31034)
* Add support for ALTER TABLE ... ADD CONSTRAINT to Oracle parser
* Add trigger support to Oracle parser (RT#62927)
* Fix erroneous PostgreSQL floating point type translations (RT#99725)
* Remove executable bit from Parser/JSON.pm (RT#100532)
* Update the Free Software Foundation's address (RT#100531)
* Provide default index names for SQLite (GH#45)
* Fix SQLite diffing on perl 5.8.1
* Fix multi-column indexes in Parser::DBI::PostgreSQL
* Fix array data types in Parser::PostgreSQL (GH#49)
* Fix multidimensional sizes in Parser::PostgreSQL
0.11020 2014-09-02
* Fix test failure if Test::PostgreSQL is installed but not working
0.11019 2014-09-02
* Add Json and hstore types to Pg Parser (cloudinstustrie)
* Fix DROP TABLE in SQL Server Producer
* Fix Pg DBI parser test (Dagfinn Ilmari Mannsåker)
* Remove spurious warnings (Matt Phillips, Wallace Reis)
* Fix MySQL producer for columns with scalar ref in 'ON UPDATE' (Wallace Reis)
* Fix handling of views in MySQL DBI parser
* Fix handling of renamed fields in SQLite diff (Peter Mottram)
* Check numeric equality of default values in numeric-type fields (Wallace Reis)
* Fix handling of renamed fields in renamed tables in Pg diff (Peter Mottram)
0.11018 2013-10-31 🎃
* Revert "Fix AUTOINCREMENT in SQLite"
0.11017 2013-10-30
* Apply quotes to fix tables that are reserved words, DBI::SQLServer (Jonathan C. Otsuka)
* Add DECIMAL_DIGITS to field size for scale info, DBI::SQLServer (Jonathan C. Otsuka)
* De-linkify XML namespace in docs (RT#81838)
* Allow both single and double quotes for values in MySQL parser
* Fix diff for altering two things per column - add ; at the end
* Call all diff methods in list context (it can be merged later)
* Fix Pg diff issue with drop constraint on primary keys
* SQLite support for SET NULL, SET DEFAULT and NO ACTION in FK clauses
* Clean up properly after Parser::DBI::PostgreSQL tests
* Fix typos in error messages
* Add SQL_TINYINT and SQL_BIGINT to the type map in
SQL::Translator::Schema::Field
* Add JSON parser and producer (Jon Jensen)
* Clean up TTSchema doc some (Gavin Shelley)
* Fix AUTOINCREMENT in SQLite (Rafael Porres Molina)
0.11016 2012-10-09
* Allow passing an arrayref to SQLT->filename (lost in Mooification)
0.11015 2012-10-05
* Fix stupid missing version number in SQL::Translator::Schema::Object
0.11014 2012-10-05
* Relicense under Perl 5 terms
0.11013_03 2012-09-25
* Remove SQL::Translator::Schema::Graph as announced in 0.11011
* Remove a number of no longer needed deps
0.11013_02 2012-09-23
* Fix missing dep (List::MoreUtils)
0.11013_01 2012-09-22
* Convert SQL::Translator, ::Schema and ::Schema::* to Moo
* Fix leaks by weakening circular references between schema objects
0.11013 2012-09-22
* Make MySQL producer add NULL after every nullable field, conforming to SQL
standard, and avoiding MySQL bugs
0.11012 2012-07-02
* Fix/update quoting in PostgreSQL producer
* Add missing quote function to SQLServer producer
* Fix incorrect Parser::DBI documentation (RT#60878)
0.11011 2012-05-09
[ INCOMPATIBLE CHANGES ]
* SQLT no longer supports setting separate conflicting values for the now
deprecated 'quote_table_names' and 'quote_field_names'. Instead their values
are proxied to the new 'quote_identifiers'. If 'quote_identifiers' is
supplied, the legacy settings are ignored (with a warning). If nothing is
specified the default is TRUE as before. If only one is specified - default
to its value for everything, and if both are specified with a conflicting
value an exception is thrown.
* Partial quoting support has been added in SQLite. It is currently disabled by
default, you need to request is explicitly with quote_identifiers => 1. In a
future version of SQL::Translator *THIS DEFAULT BEHAVIOR WILL CHANGE*.
If you do NOT WANT quoting, set quote_identifiers to a false value to
protect yourself from changes in a future release.
* Bump the default MySQL parser version to MySQL 4.0
[ OTHER CHANGES ]
* script/sqlt-graph now accepts a --trace option
* Fixes to SQLite foreign keys production (patch from Johan Viklund)
closes RT#16412, RT#44769
* ON DELETE/UPDATE actions for SQLite (patch from Lukas Thiemeier)
closes RT#70734, RT#71283, RT#70378
* Fix data preservation on SQLite diffs involving adding/dropping columns
* Support for triggers in PostgreSQL producer and parser
* Correct Data Type in SQLT::Parser::DBI::PostgreSQL (patch from Andrew Pam)
* Fix index issue in SQLT::Parser::DBI::PostgreSQL
* Add column and table comments in SQLT::Parser::DBI::PostgreSQL(patch from Andrew Pam)
* Stop the DBI parser from disconnecting externally supplied DBI handles (RT#35868)
* Fixed alter_drop_constraint for foreign keys and applying multiple changes
via alter_field to a column in Postgres Producer
* Added a working mechanism for naming foreign keys in the PostgreSQL producer
* Fix PostgreSQL ignoring default values with specified data type
* Fix PostgreSQL parser support for (N)::int defaults (patch by Tina Müller)
* Fix possible name duplication in SQLlite producer
* Oracle does not accept ON DELETE/UPDATE RESTRICT (though it is the actual default)
fix by not adding the ON DELETE/UPDATE clause at all
* Changed dependency on Digest::SHA1 to the core-bundled Digest::SHA (RT#67989)
* Support for double quoted and bit strings as default values in MySQL parser
* Improved VIEW support in MySQL parser
* Proper handling of CURRENT_TIMESTAMP default values in MySQL parser (RT#65844)
* Check in MySQL parser to avoid trying to parse a table defined twice in the same
file as indices (and probably other things) get messed up
* Workaround for some MySQL quirks on primary key definitions
* Fix dropping primary keys in MySQL diffs (RT#62250, patch from Nick Bertrand)
* MySQL producer does not attempt to write out non-existent unique constraint names
* MySQL parser correctly differentiates between signed and unsigned integer column
display sizes
* Replace Class::Accessor::Fast dependency with already-included Moo
* Entire codebase is now free of tabs and trailing whitespace
* Spellfixes (RT#68912)
* Fix Diagram Producer POD (RT#71397, RT#71398)
* Fix Diagram Producer to use correct binmode on output (RT#71399)
* Fix ignored option to script/sqlt-diagram (RT#5992)
* Fix t/17sqlfxml-producer.t failures due to whitespace differences introduced by
environment config snippets (RT#70786)
* Fix assembly of Table objects with numbered columns being added out of order
(RT#74771) (based on patch from Jonathan Otsuka)
* Fix syntax error in SQL::Translator::Producer::Latex (RT#74953)
* Deprecate SQL::Translator::Schema::Graph and the as_graph() schema method
* Bump minimum supported perl version to 5.8.1 (mostly due to Moo)
0.11010 2011-10-05
* Add "if exists" to drop view statements in Pg.
0.11009 2011-09-02
* Fix MySQL producer to properly quote all table names on output (patch from geistteufel)
0.11008 2011-05-04
* Correctly create and parse FK constraints in SQLite
* Correct postgis geography type insertion and linebreak fix for multiple geometry/geography columns
* made PostgreSQL producer consistent with other producers in terms of
quoting and allowing functions in constraints and indices
* Add distinction of autoinc and regular primary keys to the GraphViz producer
* Fix odd invocation of Test::More::pass() in t/36-filters.t (RT#64728)
* Quote everything in SQL Server
* Turn off constraints before dropping tables in SQL Server
* Make true unique constraints if needed in SQL Server
* Fixed Producer::PostgresSQL to output array type after type size,
i.e. varchar(64)[] rather than varchar[](64)
0.11007 2010-11-30
* Fix POD typo in SQL/Translator/Schema/Trigger.pm
* Add explicit Scalar::Util to the deplist for really old perls
* Add support for PostGIS Geometry and Geography data types in the Pg producer
* Some minor fixes to squash warnings on new perls
* Support a custom_type_name hint when creating enum types in PostgreSQL
* Fix sqlt options/pod mismatch (RT#58318)
* Oracle Producer multicolumn constraint support
* Add support for triggers in the MySQL producer
* Fix unstable order of View's in MySQL parser
0.11006 2010-06-03
* Fix Producer::Oracle varchar2 without size def (ORA-00906: missing right
parenthesis)
* Fix Producer::Oracle translate float and double to float instead of number
* Fix Producer::Oracle generation of too long unique constraint names
* Fix Producer::SQLite when generating VIEWs with add_drop_table => 1
* Fix Producer::MySQL not quoting index names when requested (RT#56173)
* Fix Producer::MySQL wrapping extra ()s around VIEW SELECT-ors (RT#56419)
* Fix Field::default_value to behave like a real accessor (allow undef as
an unsetting argument)
* Fix Mysql/Pg/SQLite/MSSQL producers to properly *not* quote numeric default
values (RT#57059)
* Producer::Oracle tests now use Test::Differences
* Prettify output of SQLite producer (less bogus newlines)
* Augment SQLite and Pg producers to accept a perl-formatted (%d.%03d%03d)
and regular no-leading-zero (X.X.X) *_version producer args
0.11005 2010-02-24
* Fix Parser::DBI::Oracle reading too many tables (RT#49413)
* Fix Parser::MySQL tripping up on PRIMARY KEY ... USING (currently value is ignored) (RT#50468)
* Fix runaway debug trace (RT#52276)
* Fix Parser::PostgreSQL choking on commit; statements in DDL (#RT52277)
* Producer::Oracle now respects quote_field|table_names, and
no longer does name munging of reserved table names
* Producer::Oracle now correctly outputs databse-unique index names
0.11004 2010-02-14
* Fix PG producer numeric precision regression (RT#49301)
* Add DB2 producer numeric/decimal precision output
* Fix Oracle producer creating numeric precision statements that the test case expects (no whitespace)
* Add Oracle producer creating drop view statements like PG producer does
* Fix SQL::Translator::Diff to use producer_args instead of producer_options
0.11003 2009-09-28
* Pg parser fixes to deal properly with MATCH
* Pg parser fixes to parse timestamp attributes correctly
* Fix broken default detection in script/sqlt (RT#27438)
* Fix dependency issues with LibXML and TT
0.11002 2009-08-30
* Depend on fixed Parse::RecDescent
* Added skip-tables and skip-tables-like options to Diagram
0.11001 2009-08-18
* Removed last use of Readonly
* Adjusted YAML dependency
0.11000 2009-08-18
* Re-add version numbers to files, else cpan's "upgrade" gets very confused
* Replaced code using Readonly, since most of the rest uses constant, and thats already a dep
* Moved YAML and XML::LibXML back to recommends, the tests for both now skip if not installed
* Bumped to 0.11000 to supercede 0.10 which has incorrect numbering scheme
0.10 2009-08-13
* Resolved the following RT bugs (thanks to everyone for reporting!):
- 25791 does not recognize PostgreSQL ON_ERROR_STOP
- 29265 sqlt-diagram: --natural-join needs Graph::Directed
- 37814 SQLite translator failing to parse schema
- 42548 Producer::PostgreSQL incorrectly inserts the size in
'time(stamp)? with(out) time zone' fields
- 43173 SQL::Translator::Parser without versionnumber - will install
old 0.09002
- 46805 (No subject)
- 47026 META.yml is not packaged due to MANIFEST.SKIP (easyfix)
- 32130 Move from XML::XPath to XML::LibXML::XPathContext
- 22261 MySQL parse
- 13915 missing optional prerequisite cause make test to fail
- 8847 Diagram.pm: BINMODE missing in printing of graphic file.
- 21065 GraphViz producer fails on tables named 'node'
- 35448 Producer::PostgreSQL types without size
- 22026 sqlt-diagram uses -f arg twice
- 47897 [PATCH] Fix uninitialized value within @_ in (uc|lc)
- 47668 Mysql Parser doesn't recognize key types
- 46448 sqlt-graph errors out on MySQL DDL with btree keys
- 47176 Add Foreign Key support to Parser::DBI::PostgreSQL.pm
- 48025 MySQL Producer: Case inconsistency between elements in
@no_length_attr and $data_type
- 48569 sqlt-diagram fails to load SQLite schema
- 48596 SQL::Translator::Diff::schema_diff should produce a list in
list context
- 44907 SQL::Translator::Producer::PostgreSQL produce() in list context
should return a list of statements
0.09007 2009-06-25
* Fixed Pg parser - caching the compiled P::RD schema is a *very*
bad idea
* Fix MSSQL handling of ON UPDATE/DELETE RESTRICT
* Delay MSSQL FK constraint deployment until after all CREATE TABLE
statements
* Coerce other engine's bytea/blob/clob datatypes to VarBinary
0.09006 2009-06-10
* Multiple test and dependency adhustments to make smokers happy
* Fix YAML producer wrt extra attribute
* Added support for "time(stamp) (p) with time zone" for Pg producer (mo)
0.09005 2009-06-08
* Add parser support for MySQL default values with a single quote
* Properly quote absolute table names in the MySQL producer
* Added CREATE VIEW subrules for mysql parser (wreis)
* Many fixes to code and tests for trigger's "database_events"
* Added semi-colon for (DROP|CREATE) TYPE statements in the Pg producer (wreis)
* ALTER TABLE/ALTER COLUMN/DROP DEFAULT support in Pg producer (mo)
* XML parser support for multi-event triggers
* SQLite producer support for multi-event triggers
* XML parser switched from XML::XPath to XML::LibXML
* Pg producer ALTER TABLE/COLUMN and DROP DEFAULT support
* MySQL producer skips length attribute for columns which do not support that
attribute. Currently following column types are added to that list:
date time timestamp datetime year
* Switch to Module::Install (mandates minimum perl 5.005)
* Major cleanup of GraphViz proucer
* Massive amount of fixes to SQLite/Pg/Mysql/MSSQL parsers/producers
Fix most of the problems uncovered by the roundtrip test framework
Some highlights:
- Rewind exhausted globs before attempting a read
- Do not add xml comment header if no_comments is set
- table/field counts are held per schema object, not globally
- no more variable table and column names in SQLite and MSSQL
- VIEW support for Pg parser, also some cleanups
- The way we generate Pg create view statements was not standards compliant
(per RhodiumToad in #postgresql)
- Disable MSSQL view/procedure production - they never worked in the first place
- SQLite/MSSQL improvements:
- Support parsing of all DROP clauses
- Support parsing of field-level comments
- When producing do not append table names to constraint/index names
0.09004 2009-02-13
* Add support for temporary tables in Pg (nachos)
* Create Trigger support for SQLite
* GraphViz producer improvements
0.09003 2009-02-07
*
0.09002 2008-12-05
* parsing MySQL CURRENT_TIMESTAMP as scalar ref so it can be produced without
quotes (jgoulah)
* Add ignore_opts parser arg (to ignore table options) in Parser::MySQL (jgoulah)
* Skip tests for buggy Spreadsheet::ParseExcel versions (rbo)
* Add support for skip tables parser arg in Parser::DBI::MySQL (jgoulah)
* Changed behaviour of ::Producer::Oracle when returning an array of statements
to make it compatible to DBI->do()
* Fixed a few bugs in ::Producer::Oracle
* Applied patch from jgoulah to support mysql's MERGE option
* Applied patch from rbo to add support of multiple database events on a trigger
* Applied patch from lukes to allow drop if exists in sqlite producer, with
version >= 3.3
* Applied patch from rjbs with minor changes, now we support scalar refs in
default values!
* Fixed SQLite producer to end index statements in newlines, in scalar context
* Decreed that all list context statements shall not end in ; or ;\n
* Fixed SQLite, Diff and MySQL producers to agree with Decree.
* Added support for CREATE VIEW + tests in the Pg producer (wreis)
* Added support for CREATE VIEW + tests in the sqlite producer (groditi)
* Added proper argument parsing and documentation to MySQL Parser and
Producer (ribasushi)
* Using DROP VIEW instead of OR REPLACE clause in the Pg producer, as replace
only allows replacement with identical set of columns (wreis)
* Added support for DROP VIEW and fixed CREATE VIEW statement in the sqlite
producer (wreis)
* Removed source_db and target_db accessors from Diff (throwback to old version,
only output_db is used)
* Support for longer varchar fields in MySQL
0.09001 2008-08-19
* Added support for CREATE VIEW + tests in the mysql producer (groditi)
* Added support for SET fields in the mysql producer + test (groditi)
* Added support for proper booleans in the mysql producer, when a mysql version
of at least 4.x is supplied
* Added support for proper enums under pg (as of 8.3), with pg version check,
and deferrable constraints
* Added support to truncate long constraint and index names in the mysql
producer, because of a change to DBIx::Class to produce such long names in
some cases.
0.09000 2008-02-25
* Fix Pg produces idea of which field types need a size param (wreis)
* Add support for COLLATE table option to MySQL parser
* Allow DEFAULT CHARACTER SET without '=' (as produced by mysqldump)
0.0899_02 2008-01-29
* Major refactoring of SQL::Translator::Diff again:
* Diff is no longer one huge monolithic function.
* Added more tests for diff
* When producing diffs for MySQL you will (by default) get single alter
statements per table
* SQLite can also do remove columns (by creating a temp table as shown in
http://sqlite.org/faq.html#q11
* Columns can be renamed if the new schema is from a form that can have metadata
(which is pretty much anything but an SQL file.) It does this by looking at
renamed_from in the $field->extra
* Updated Oracle and Postgres producers
* More tests!
0.0899_01 2007-10-21
* SQL::Translator::Diff now uses the ::Producer modules to create diffs
This *will* break back-compatibility
Use sqlt-diff-old for the previous one, and fix producers!
0.08001 2007-09-26
* Patched to ignore all TT versions >= 2.15 until TT is fixed :(
0.08 2006-12-07
* Patched 18ttschema-producer.t and 33tt-table-producter.t to skip on TT 2.15,
thanks Ash!
0.08_04 2006-11-10
* Patched MySQL producer to name constraints sanely, thanks Ash
* Added patch to Producer::DB2 to avoid dependency issues with foreign keys
* Added patch to remove single quotes for numeric default values in Producer::DB2
* Fixed Parser::SQLite to require a semicolon after a create trigger statement
* Added patch from avinash to add CASCADE to pg table drops
0.08_03
* Added patch to use default values for Pg timestamp fields
0.08_02 2006-11-03
* Added patch from Ash to separate DROP statements in mysql producer in
list-context
* Fixed up SQLites usage of no-comments
0.08_01 2006-07-23
* Made Trigger check that a give table exists in on_table - castaway
* Split some producers (DB2, MySQL, SQLite, PostgreSQL) into sub methods (others
to follow) - castaway
* Add alter_* methods to some Producers and docs to Producer.pm (for use by Diff
later) - castaway
* Made changes to allow producers to return a list of statements - castaway
* Split sqlt-diff into script and module - castaway
* Added quote_table_names and quote_field_names patch (omega, zamolxes) - castaway
* Added DB2 Producer - castaway
* Added mysql_character_set for 4.1+ -mda
* New filters, Names and Globals. -mda
* Added the initial work on a template based Dia UML producer. -mda
0.07 2005-06-10
* YAML parser supports extra attributes on tables.
* All schema objects now support the extra attribute, so can
have arbitary name/value data attached to them.
* Refactoring: Added SQL::Translator::Schema::Object - base
class for all Schema objects.
* Changes to MySQL Parser (Dave Howorth)
- ignore INSERT statements
- permit ALTER TABLE ADD FOREIGN KEY
- allow trailing comma on last field in CREATE statements
- collect the database name
* TTSchema Producer
- Can pass extra variables using tt_vars producer arg.
- Can pass extra config using tt_conf producer arg.
- Variables and config can be passed on the command line
with --tt-var and --tt-conf options to sqlt.
* Added schema filters.
* MySQL Producer
- Added 'mysql_table_type' extra attribute on tables.
- Works out InnoDB tables from constraints.
- mysql_charset and mysql_collate extra attributes for tables and fiels.
0.06 2004-05-13
* Added SQL::Translator::Manual
* Installation process now uses Module::Build
* Added new "Dumper" producer
* Changed the native SQL Fairy XML format to a fixed mapping.
*NB:* You should convert your existing XML schema. See the
SQL::Translator::Parser::XML::SQLFairy docs.
* Added producers: TT::Base and TT::Table.
0.05 2004-02-27
* Added "COMMENT ON *" syntax to PostgreSQL parser
* Some fixes to Oracle parser as reported by Gail Binkley
* Added support in PostgreSQL parser for all "ALTER TABLE" statements
* Now distributing sqlt-diff script as it's pretty usable
* Added new options to sqlt-graph and GraphViz producer (Dave Cash)
0.04 2003-11-07
* Increased version of Constants module to 1.41 to avoid a problem
where 0.02 has 1.4 of that file and 0.03 had 1.06 which confused
CPAN
* Hard-coded all the PREREQ_PM modules in Makefile.PL (rather than
setting them dynamically) so that automated tests would pass
0.03 2003-11-06
* Added parsers: XML::SQLFairy, Sybase, SQLite, DBI-MySQL,
DBI-PostgreSQL, DBI-SQLite, DBI-Sybase, Storable, YAML
* Added producers: XML::SQLFairy, TTSchema, Storable, YAML
* HTML producer now uses stylesheets to allow easy customization of colors
* Many bug fixes to most every module
* Added "sqlt-dumper" script to help create a script for dumping
a database a la "mysqldump"
* Reversed the arrowheads on the graphical producers to show the
relationships in a more standard way
* Changes all included script names to start with "sqlt"
* Added capturing and printing most embedded table and field comments
0.02 2003-06-17
* Added parsers for Excel and Oracle
* Removed Sybase parser because it didn't actually work
* Added ClassDBI, Diagram, GraphViz, HTML, POD, SQLite, Sybase producers
* Added Schema classes to represent schema as objects
* Removed "Raw" producer in favor of the Schema classes
* Removed "Validator" class as the Schema classes validate themselves
* Improved all existing parsers and producers, expanding them to
handle foreign keys much better, produce better output, etc.
* Added sqlt-diagram.pl and sqlt-graphviz.pl as CLI frontends to the
graphical producers
* Added sql_translator.cgi as a web-form frontend to graphical producers
* Expanded test suite
0.01 2003-02-27
* Added parsers: XML::SQLFairy, Sybase, SQLite, DBI-MySQL,
DBI-PostgreSQL, DBI-SQLite, DBI-Sybase, Storable, YAML
* Added producers: XML::SQLFairy, TTSchema, Storable, YAML
* HTML producer now uses stylesheets to allow easy customization of colors
* Many bug fixes to most every module
* Added "sqlt-dumper" script to help create a script for dumping
a database a la "mysqldump"
* Reversed the arrowheads on the graphical producers to show the
relationships in a more standard way
* Changes all included script names to start with "sqlt"
* Added capturing and printing most embedded table and field comments
SQL-Translator-0.11024/lib/ 0000755 0001750 0001750 00000000000 13225114407 014530 5 ustar ilmari ilmari SQL-Translator-0.11024/lib/SQL/ 0000755 0001750 0001750 00000000000 13225114407 015167 5 ustar ilmari ilmari SQL-Translator-0.11024/lib/SQL/Translator/ 0000755 0001750 0001750 00000000000 13225114407 017320 5 ustar ilmari ilmari SQL-Translator-0.11024/lib/SQL/Translator/Filter/ 0000755 0001750 0001750 00000000000 13225114407 020545 5 ustar ilmari ilmari SQL-Translator-0.11024/lib/SQL/Translator/Filter/Globals.pm 0000644 0001750 0001750 00000012063 12542755372 022505 0 ustar ilmari ilmari package SQL::Translator::Filter::Globals;
=head1 NAME
SQL::Translator::Filter::Globals - Add global fields and indices to all tables.
=head1 SYNOPSIS
# e.g. Add timestamp field to all tables.
use SQL::Translator;
my $sqlt = SQL::Translator->new(
from => 'MySQL',
to => 'MySQL',
filters => [
Globals => {
fields => [
{
name => 'modified'
data_type => 'TIMESTAMP'
}
],
indices => [
{
fields => 'modifed',
},
]
constraints => [
{
}
]
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = @_;
my $global_table = $args{global_table} ||= '_GLOBAL_';
my (@global_fields, @global_indices, @global_constraints);
push @global_fields, @{ $args{fields} } if $args{fields};
push @global_indices, @{ $args{indices} } if $args{indices};
push @global_constraints, @{ $args{constraints} } if $args{constraints};
# Pull fields and indices off global table and then remove it.
if ( my $gtbl = $schema->get_table( $global_table ) ) {
foreach ( $gtbl->get_fields ) {
# We don't copy the order attrib so the added fields should get
# pushed on the end of each table.
push @global_fields, {
name => $_->name,
comments => "".$_->comments,
data_type => $_->data_type,
default_value => $_->default_value,
size => [$_->size],
extra => scalar($_->extra),
foreign_key_reference => $_->foreign_key_reference,
is_auto_increment => $_->is_auto_increment,
is_foreign_key => $_->is_foreign_key,
is_nullable => $_->is_nullable,
is_primary_key => $_->is_primary_key,
is_unique => $_->is_unique,
is_valid => $_->is_valid,
};
}
foreach ( $gtbl->get_indices ) {
push @global_indices, {
name => $_->name,
type => $_->type,
fields => [$_->fields],
options => [$_->options],
extra => scalar($_->extra),
};
}
foreach ( $gtbl->get_constraints ) {
push @global_constraints, {
name => $_->name,
fields => [$_->fields],
deferrable => $_->deferrable,
expression => $_->expression,
match_type => $_->match_type,
options => [$_->options],
on_delete => $_->on_delete,
on_update => $_->on_update,
reference_fields => [$_->reference_fields],
reference_table => $_->reference_table,
table => $_->table,
type => $_->type,
extra => scalar($_->extra),
};
}
$schema->drop_table($gtbl);
}
# Add globals to tables
foreach my $tbl ( $schema->get_tables ) {
foreach my $new_fld ( @global_fields ) {
# Don't add if field already there
next if $tbl->get_field( $new_fld->{name} );
$tbl->add_field( %$new_fld );
}
foreach my $new_index ( @global_indices ) {
$tbl->add_index( %$new_index );
}
foreach my $new_constraint ( @global_constraints ) {
$tbl->add_constraint( %$new_constraint );
}
}
}
1;
__END__
=head1 DESCRIPTION
Adds global fields, indices and constraints to all tables in the schema.
The globals to add can either be defined in the filter args or using a _GLOBAL_
table (see below).
If a table already contains a field with the same name as a global then it is
skipped for that table.
=head2 The _GLOBAL_ Table
An alternative to using the args is to add a table called C<_GLOBAL_> to the
schema and then just use the filter. Any fields and indices defined on this table
will be added to all the tables in the schema and the _GLOBAL_ table removed.
The name of the global can be changed using a C arg to the
filter.
=head1 SEE ALSO
C, L
=head1 BUGS
Will generate duplicate indices if an index already exists on a table the same
as one added globally.
Will generate duplicate constraints if a constraint already exists on a table
the same as one added globally.
=head1 TODO
Some extra data values that can be used to control the global addition. e.g.
'skip_global'.
=head1 AUTHOR
Mark Addison
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Filter/Names.pm 0000644 0001750 0001750 00000006774 12544204454 022171 0 ustar ilmari ilmari package SQL::Translator::Filter::Names;
=head1 NAME
SQL::Translator::Filter::Names - Tweak the names of schema objects.
=head1 SYNOPSIS
#! /usr/bin/perl -w
use SQL::Translator;
# Lowercase all table names and upper case the first letter of all field
# names. (MySql style!)
#
my $sqlt = SQL::Translator->new(
filename => \@ARGV,
from => 'MySQL',
to => 'MySQL',
filters => [
Names => {
'tables' => 'lc',
'fields' => 'ucfirst',
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
print($sqlt->translate) || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = %{$_[0]};
# Tables
#if ( my $func = $args{tables} ) {
# _filtername($_,$func) foreach ( $schema->get_tables );
#}
# ,
foreach my $type ( qw/tables procedures triggers views/ ) {
if ( my $func = $args{$type} ) {
my $meth = "get_$type";
_filtername($_,$func) foreach $schema->$meth;
}
}
# Fields
if ( my $func = $args{fields} ) {
_filtername($_,$func)
foreach map { $_->get_fields } $schema->get_tables ;
}
}
# _filtername( OBJ, FUNC_NAME )
# Update the name attribute on the schema object given using the named filter.
# Objects with no name are skipped.
# Returns true if the name was changed. Dies if there is an error running func.
sub _filtername {
my ($obj,$func) = @_;
return unless my $name = $obj->name;
$func = _getfunc($func);
my $newname = eval { $func->($name) };
die "$@" if $@; # TODO - Better message!
return if $name eq $newname;
$_->name($newname);
}
# _getfunc( NAME ) - Returns code ref to func NAME or dies.
sub _getfunc {
my ($name) = @_;
no strict 'refs';
my $func = "SQL::Translator::Filter::Names::$name";
die "Table name filter - unknown function '$name'\n" unless exists &$func;
\&$func;
}
# The name munging functions
#=============================================================================
# Get called with name to munge as first arg and return the new name. Die on
# errors.
sub lc { lc shift; }
sub uc { uc shift; }
sub ucfirst { ucfirst shift; }
1; #==========================================================================
__END__
=head1 DESCRIPTION
Tweak the names of schema objects by providing functions to filter the names
from the given into the desired forms.
=head1 SEE ALSO
C, L
=over 4
=item Name Groups
Define a bunch of useful groups to run the name filters over. e.g. all, fkeys,
pkeys etc.
=item More Functions
e.g. camelcase, titlecase, single word etc.
Also a way to pass in a regexp.
May also want a way to pass in arguments for the func e.g. prefix.
=item Multiple Filters on the same name (filter order)?
Do we actually need this, you could just run lots of filters. Would make adding
func args to the interface easier.
filters => [
[ 'Names', { all => 'lc' } ],
[ 'Names', {
tables => 'lc',
fields => 'ucfirst',
} ],
],
Mind you if you could give the filter a list this wouldn't be a problem!
filters => [
[ 'Names',
all => 'lc'
fields => 'ucfirst',
],
],
Which is nice. Might have to change the calling conventions for filters.
Would also provide an order to run the filters in rather than having to hard
code it into the filter it's self.
=back
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Filter/DefaultExtra.pm 0000644 0001750 0001750 00000003026 12544204454 023501 0 ustar ilmari ilmari package SQL::Translator::Filter::DefaultExtra;
=head1 NAME
SQL::Translator::Filter::DefaultExtra - Set default extra data values for schema
objects.
=head1 SYNOPSIS
use SQL::Translator;
my $sqlt = SQL::Translator->new(
from => 'MySQL',
to => 'MySQL',
filters => [
DefaultExtra => {
# XXX - These should really be ordered
# Default widget for fields to basic text edit.
'field.widget' => 'text',
# idea:
'field(data_type=BIT).widget' => 'yesno',
# Default label (human formated name) for fields and tables
'field.label' => '=ucfirst($name)',
'table.label' => '=ucfirst($name)',
},
],
) || die "SQLFairy error : ".SQL::Translator->error;
my $sql = $sqlt->translate || die "SQLFairy error : ".$sqlt->error;
=cut
use strict;
use warnings;
our $VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = { +shift };
# Tables
foreach ( $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
$_->extra( %extra );
}
# Fields
foreach ( map { $_->get_fields } $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
$_->extra( %extra );
}
}
1;
__END__
=head1 DESCRIPTION
Maybe I'm trying to do too much in one go. Args set a match and then an update,
if you want to set lots of things, use lots of filters!
=head1 SEE ALSO
C, L
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/ 0000755 0001750 0001750 00000000000 13225114407 021103 5 ustar ilmari ilmari SQL-Translator-0.11024/lib/SQL/Translator/Producer/HTML.pm 0000644 0001750 0001750 00000024701 12163313615 022213 0 ustar ilmari ilmari package SQL::Translator::Producer::HTML;
use strict;
use warnings;
use Data::Dumper;
our $VERSION = '1.59';
our $NAME = __PACKAGE__;
our $NOWRAP = 0 unless defined $NOWRAP;
our $NOLINKTABLE = 0 unless defined $NOLINKTABLE;
# Emit XHTML by default
$CGI::XHTML = $CGI::XHTML = 42;
use SQL::Translator::Schema::Constants;
# -------------------------------------------------------------------
# Main entry point. Returns a string containing HTML.
# -------------------------------------------------------------------
sub produce {
my $t = shift;
my $args = $t->producer_args;
my $schema = $t->schema;
my $schema_name = $schema->name || 'Schema';
my $title = $args->{'title'} || "Description of $schema_name";
my $wrap = ! (defined $args->{'nowrap'}
? $args->{'nowrap'}
: $NOWRAP);
my $linktable = ! (defined $args->{'nolinktable'}
? $args->{'nolinktable'}
: $NOLINKTABLE);
my %stylesheet = defined $args->{'stylesheet'}
? ( -style => { src => $args->{'stylesheet'} } )
: ( );
my @html;
my $q = defined $args->{'pretty'}
? do { require CGI::Pretty;
import CGI::Pretty;
CGI::Pretty->new }
: do { require CGI;
import CGI;
CGI->new };
my ($table, @table_names);
if ($wrap) {
push @html,
$q->start_html({
-title => $title,
%stylesheet,
-meta => { generator => $NAME },
}),
$q->h1({ -class => 'SchemaDescription' }, $title),
$q->hr;
}
@table_names = grep { length $_->name } $schema->get_tables;
if ($linktable) {
# Generate top menu, with links to full table information
my $count = scalar(@table_names);
$count = sprintf "%d table%s", $count, $count == 1 ? '' : 's';
# Leading table of links
push @html,
$q->comment("Table listing ($count)"),
$q->a({ -name => 'top' }),
$q->start_table({ -width => '100%', -class => 'LinkTable'}),
# XXX This needs to be colspan="$#{$table->fields}" class="LinkTableHeader"
$q->Tr(
$q->td({ -class => 'LinkTableCell' },
$q->h2({ -class => 'LinkTableTitle' },
'Tables'
),
),
);
for my $table (@table_names) {
my $table_name = $table->name;
push @html,
$q->comment("Start link to table '$table_name'"),
$q->Tr({ -class => 'LinkTableRow' },
$q->td({ -class => 'LinkTableCell' },
qq[$table_name]
)
),
$q->comment("End link to table '$table_name'");
}
push @html, $q->end_table;
}
for my $table ($schema->get_tables) {
my $table_name = $table->name or next;
my @fields = $table->get_fields or next;
push @html,
$q->comment("Starting table '$table_name'"),
$q->a({ -name => $table_name }),
$q->table({ -class => 'TableHeader', -width => '100%' },
$q->Tr({ -class => 'TableHeaderRow' },
$q->td({ -class => 'TableHeaderCell' }, $q->h3($table_name)),
qq[],
$q->td({ -class => 'TableHeaderCell', -align => 'right' },
qq[Top]
)
)
);
if ( my @comments = map { $_ ? $_ : () } $table->comments ) {
push @html,
$q->b("Comments:"),
$q->br,
$q->em(map { $q->br, $_ } @comments);
}
#
# Fields
#
push @html,
$q->start_table({ -border => 1 }),
$q->Tr(
$q->th({ -class => 'FieldHeader' },
[
'Field Name',
'Data Type',
'Size',
'Default Value',
'Other',
'Foreign Key'
]
)
);
my $i = 0;
for my $field ( @fields ) {
my $name = $field->name || '';
$name = qq[$name];
my $data_type = $field->data_type || '';
my $size = defined $field->size ? $field->size : '';
my $default = defined $field->default_value
? $field->default_value : '';
my $comment = $field->comments || '';
my $fk = '';
if ($field->is_foreign_key) {
my $c = $field->foreign_key_reference;
my $ref_table = $c->reference_table || '';
my $ref_field = ($c->reference_fields)[0] || '';
$fk =
qq[$ref_table.$ref_field];
}
my @other = ();
push @other, 'PRIMARY KEY' if $field->is_primary_key;
push @other, 'UNIQUE' if $field->is_unique;
push @other, 'NOT NULL' unless $field->is_nullable;
push @other, $comment if $comment;
my $class = $i++ % 2 ? 'even' : 'odd';
push @html,
$q->Tr(
{ -class => "tr-$class" },
$q->td({ -class => "FieldCellName" }, $name),
$q->td({ -class => "FieldCellType" }, $data_type),
$q->td({ -class => "FieldCellSize" }, $size),
$q->td({ -class => "FieldCellDefault" }, $default),
$q->td({ -class => "FieldCellOther" }, join(', ', @other)),
$q->td({ -class => "FieldCellFK" }, $fk),
);
}
push @html, $q->end_table;
#
# Indices
#
if ( my @indices = $table->get_indices ) {
push @html,
$q->h3('Indices'),
$q->start_table({ -border => 1 }),
$q->Tr({ -class => 'IndexRow' },
$q->th([ 'Name', 'Fields' ])
);
for my $index ( @indices ) {
my $name = $index->name || '';
my $fields = join( ', ', $index->fields ) || '';
push @html,
$q->Tr({ -class => 'IndexCell' },
$q->td( [ $name, $fields ] )
);
}
push @html, $q->end_table;
}
#
# Constraints
#
my @constraints =
grep { $_->type ne PRIMARY_KEY } $table->get_constraints;
if ( @constraints ) {
push @html,
$q->h3('Constraints'),
$q->start_table({ -border => 1 }),
$q->Tr({ -class => 'IndexRow' },
$q->th([ 'Type', 'Fields' ])
);
for my $c ( @constraints ) {
my $type = $c->type || '';
my $fields = join( ', ', $c->fields ) || '';
push @html,
$q->Tr({ -class => 'IndexCell' },
$q->td( [ $type, $fields ] )
);
}
push @html, $q->end_table;
}
push @html, $q->hr;
}
my $sqlt_version = $t->version;
if ($wrap) {
push @html,
qq[Created by ],
qq[SQL::Translator $sqlt_version],
$q->end_html;
}
return join "\n", @html;
}
1;
# -------------------------------------------------------------------
# Always be ready to speak your mind,
# and a base man will avoid you.
# William Blake
# -------------------------------------------------------------------
=head1 NAME
SQL::Translator::Producer::HTML - HTML producer for SQL::Translator
=head1 SYNOPSIS
use SQL::Translator::Producer::HTML;
=head1 DESCRIPTION
Creates an HTML document describing the tables.
The HTML produced is composed of a number of tables:
=over 4
=item Links
A link table sits at the top of the output, and contains anchored
links to elements in the rest of the document.
If the I producer arg is present, then this table is not
produced.
=item Tables
Each table in the schema has its own HTML table. The top row is a row
of EthE elements, with a class of B; these
elements are I, I, I, I,
I and I. Each successive row describes one field
in the table, and has a class of B, where $item id
corresponds to the label of the column. For example:
| id |
int |
11 |
|
PRIMARY KEY, NOT NULL |
|
| foo |
varchar |
255 |
|
NOT NULL |
|
| updated |
timestamp |
0 |
|
|
|
=back
Unless the I producer arg is present, the HTML will be
enclosed in a basic HTML header and footer.
If the I producer arg is present, the generated HTML will be
nicely spaced and human-readable. Otherwise, it will have very little
insignificant whitespace and be generally smaller.
=head1 AUTHORS
Ken Youens-Clark Ekclark@cpan.orgE,
Darren Chamberlain Edarren@cpan.orgE.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/DB2.pm 0000644 0001750 0001750 00000034377 12163313615 022030 0 ustar ilmari ilmari package SQL::Translator::Producer::DB2;
=head1 NAME
SQL::Translator::Producer::DB2 - DB2 SQL producer
=head1 SYNOPSIS
use SQL::Translator;
my $t = SQL::Translator->new( parser => '...', producer => 'DB2' );
print $translator->translate( $file );
=head1 DESCRIPTION
Creates an SQL DDL suitable for DB2.
=cut
use warnings;
use strict;
use warnings;
our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
# http://publib.boulder.ibm.com/infocenter/db2help/topic/com.ibm.db2.udb.doc/ad/r0006844.htm
# This is a terrible WTDI, each Parser should parse down to some standard set
# of SQL data types, with field->extra entries being used to convert back to
# weird types like "polygon" if needed (IMO anyway)
my %dt_translate;
BEGIN {
%dt_translate = (
#
# MySQL types
#
int => 'integer',
mediumint => 'integer',
tinyint => 'smallint',
char => 'char',
tinyblob => 'blob',
mediumblob => 'blob',
longblob => 'long varchar for bit data',
tinytext => 'varchar',
text => 'varchar',
longtext => 'varchar',
mediumtext => 'varchar',
enum => 'varchar',
set => 'varchar',
date => 'date',
datetime => 'timestamp',
time => 'time',
year => 'date',
#
# PostgreSQL types
#
'double precision' => 'double',
serial => 'integer',
bigserial => 'integer',
money => 'double',
character => 'char',
'character varying' => 'varchar',
bytea => 'BLOB',
interval => 'integer',
boolean => 'smallint',
point => 'integer',
line => 'integer',
lseg => 'integer',
box => 'integer',
path => 'integer',
polygon => 'integer',
circle => 'integer',
cidr => 'integer',
inet => 'varchar',
macaddr => 'varchar',
bit => 'number',
'bit varying' => 'number',
#
# DB types
#
number => 'integer',
varchar2 => 'varchar',
long => 'clob',
);
}
my %db2_reserved = map { $_ => 1} qw/
ADD DETERMINISTIC LEAVE RESTART
AFTER DISALLOW LEFT RESTRICT
ALIAS DISCONNECT LIKE RESULT
ALL DISTINCT LINKTYPE RESULT_SET_LOCATOR
ALLOCATE DO LOCAL RETURN
ALLOW DOUBLE LOCALE RETURNS
ALTER DROP LOCATOR REVOKE
AND DSNHATTR LOCATORS RIGHT
ANY DSSIZE LOCK ROLLBACK
APPLICATION DYNAMIC LOCKMAX ROUTINE
AS EACH LOCKSIZE ROW
ASSOCIATE EDITPROC LONG ROWS
ASUTIME ELSE LOOP RRN
AUDIT ELSEIF MAXVALUE RUN
AUTHORIZATION ENCODING MICROSECOND SAVEPOINT
AUX END MICROSECONDS SCHEMA
AUXILIARY END-EXEC MINUTE SCRATCHPAD
BEFORE END-EXEC1 MINUTES SECOND
BEGIN ERASE MINVALUE SECONDS
BETWEEN ESCAPE MODE SECQTY
BINARY EXCEPT MODIFIES SECURITY
BUFFERPOOL EXCEPTION MONTH SELECT
BY EXCLUDING MONTHS SENSITIVE
CACHE EXECUTE NEW SET
CALL EXISTS NEW_TABLE SIGNAL
CALLED EXIT NO SIMPLE
CAPTURE EXTERNAL NOCACHE SOME
CARDINALITY FENCED NOCYCLE SOURCE
CASCADED FETCH NODENAME SPECIFIC
CASE FIELDPROC NODENUMBER SQL
CAST FILE NOMAXVALUE SQLID
CCSID FINAL NOMINVALUE STANDARD
CHAR FOR NOORDER START
CHARACTER FOREIGN NOT STATIC
CHECK FREE NULL STAY
CLOSE FROM NULLS STOGROUP
CLUSTER FULL NUMPARTS STORES
COLLECTION FUNCTION OBID STYLE
COLLID GENERAL OF SUBPAGES
COLUMN GENERATED OLD SUBSTRING
COMMENT GET OLD_TABLE SYNONYM
COMMIT GLOBAL ON SYSFUN
CONCAT GO OPEN SYSIBM
CONDITION GOTO OPTIMIZATION SYSPROC
CONNECT GRANT OPTIMIZE SYSTEM
CONNECTION GRAPHIC OPTION TABLE
CONSTRAINT GROUP OR TABLESPACE
CONTAINS HANDLER ORDER THEN
CONTINUE HAVING OUT TO
COUNT HOLD OUTER TRANSACTION
COUNT_BIG HOUR OVERRIDING TRIGGER
CREATE HOURS PACKAGE TRIM
CROSS IDENTITY PARAMETER TYPE
CURRENT IF PART UNDO
CURRENT_DATE IMMEDIATE PARTITION UNION
CURRENT_LC_CTYPE IN PATH UNIQUE
CURRENT_PATH INCLUDING PIECESIZE UNTIL
CURRENT_SERVER INCREMENT PLAN UPDATE
CURRENT_TIME INDEX POSITION USAGE
CURRENT_TIMESTAMP INDICATOR PRECISION USER
CURRENT_TIMEZONE INHERIT PREPARE USING
CURRENT_USER INNER PRIMARY VALIDPROC
CURSOR INOUT PRIQTY VALUES
CYCLE INSENSITIVE PRIVILEGES VARIABLE
DATA INSERT PROCEDURE VARIANT
DATABASE INTEGRITY PROGRAM VCAT
DAY INTO PSID VIEW
DAYS IS QUERYNO VOLUMES
DB2GENERAL ISOBID READ WHEN
DB2GENRL ISOLATION READS WHERE
DB2SQL ITERATE RECOVERY WHILE
DBINFO JAR REFERENCES WITH
DECLARE JAVA REFERENCING WLM
DEFAULT JOIN RELEASE WRITE
DEFAULTS KEY RENAME YEAR
DEFINITION LABEL REPEAT YEARS
DELETE LANGUAGE RESET
DESCRIPTOR LC_CTYPE RESIGNAL
/;
sub produce
{
my ($translator) = @_;
$DEBUG = $translator->debug;
$WARN = $translator->show_warnings;
my $no_comments = $translator->no_comments;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
my $output = '';
my $indent = ' ';
$output .= header_comment unless($no_comments);
my (@table_defs, @fks, @index_defs);
foreach my $table ($schema->get_tables)
{
push @table_defs, 'DROP TABLE ' . $table->name . ";" if $add_drop_table;
my ($table_def, $fks) = create_table($table, {
no_comments => $no_comments});
push @table_defs, $table_def;
push @fks, @$fks;
foreach my $index ($table->get_indices)
{
push @index_defs, create_index($index);
}
}
my (@view_defs);
foreach my $view ( $schema->get_views )
{
push @view_defs, create_view($view);
}
my (@trigger_defs);
foreach my $trigger ( $schema->get_triggers )
{
push @trigger_defs, create_trigger($trigger);
}
return wantarray ? (@table_defs, @fks, @index_defs, @view_defs, @trigger_defs) :
$output . join("\n\n", @table_defs, @fks, @index_defs, @view_defs, @trigger_defs) . "\n";
}
{ my %objnames;
sub check_name
{
my ($name, $type, $length) = @_;
my $newname = $name;
if(length($name) > $length) ## Maximum table name length is 18
{
warn "Table name $name is longer than $length characters, truncated" if $WARN;
# if(grep {$_ eq substr($name, 0, $length) }
# values(%{$objnames{$type}}))
# {
# die "Got multiple matching table names when truncated";
# }
# $objnames{$type}{$name} = substr($name, 0,$length);
# $newname = $objnames{$type}{$name};
}
if($db2_reserved{uc($newname)})
{
warn "$newname is a reserved word in DB2!" if $WARN;
}
# return sprintf("%-*s", $length-5, $newname);
return $newname;
}
}
sub create_table
{
my ($table, $options) = @_;
my $table_name = check_name($table->name, 'tables', 128);
# this limit is 18 in older DB2s ! (<= 8)
my (@field_defs, @comments);
push @comments, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
foreach my $field ($table->get_fields)
{
push @field_defs, create_field($field);
}
my (@con_defs, @fks);
foreach my $con ($table->get_constraints)
{
my ($cdefs, $fks) = create_constraint($con);
push @con_defs, @$cdefs;
push @fks, @$fks;
}
my $tablespace = $table->extra()->{'TABLESPACE'} || '';
my $table_def = "CREATE TABLE $table_name (\n";
$table_def .= join (",\n", map { " $_" } @field_defs, @con_defs);
$table_def .= "\n)";
$table_def .= $tablespace ? "IN $tablespace;" : ';';
return $table_def, \@fks;
}
sub create_field
{
my ($field) = @_;
my $field_name = check_name($field->name, 'fields', 30);
# use Data::Dumper;
# print Dumper(\%dt_translate);
# print $field->data_type, " ", $dt_translate{lc($field->data_type)}, "\n";
my $data_type = uc($dt_translate{lc($field->data_type)} || $field->data_type);
my $size = $field->size();
my $field_def = "$field_name $data_type";
$field_def .= $field->is_auto_increment ?
' GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1)' : '';
$field_def .= $data_type =~ /(CHAR|CLOB|NUMERIC|DECIMAL)/i ? "(${size})" : '';
$field_def .= !$field->is_nullable ? ' NOT NULL':'';
# $field_def .= $field->is_primary_key ? ' PRIMARY KEY':'';
$field_def .= !defined $field->default_value ? '' :
$field->default_value =~ /current( |_)timestamp/i ||
$field->default_value =~ /\Qnow()\E/i ?
' DEFAULT CURRENT TIMESTAMP' : defined $field->default_value ?
(" DEFAULT " . ($data_type =~ /(INT|DOUBLE)/i ?
$field->default_value : "'" . $field->default_value . "'")
) : '';
return $field_def;
}
sub create_index
{
my ($index) = @_;
my $out = sprintf('CREATE %sINDEX %s ON %s ( %s );',
$index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '',
$index->name,
$index->table->name,
join(', ', $index->fields) );
return $out;
}
sub create_constraint
{
my ($constraint) = @_;
my (@con_defs, @fks);
my $ctype = $constraint->type =~ /^PRIMARY(_|\s)KEY$/i ? 'PRIMARY KEY' :
$constraint->type =~ /^UNIQUE$/i ? 'UNIQUE' :
$constraint->type =~ /^CHECK_C$/i ? 'CHECK' :
$constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? 'FOREIGN KEY' : '';
my $expr = $constraint->type =~ /^CHECK_C$/i ? $constraint->expression :
'';
my $ref = $constraint->type =~ /^FOREIGN(_|\s)KEY$/i ? ('REFERENCES ' . $constraint->reference_table . '(' . join(', ', $constraint->reference_fields) . ')') : '';
my $update = $constraint->on_update ? $constraint->on_update : '';
my $delete = $constraint->on_delete ? $constraint->on_delete : '';
my $out = join(' ', grep { $_ }
$constraint->name ? ('CONSTRAINT ' . $constraint->name) : '',
$ctype,
'(' . join (', ', $constraint->fields) . ')',
$expr ? $expr : $ref,
$update,
$delete);
if ($constraint->type eq FOREIGN_KEY) {
my $table_name = $constraint->table->name;
$out = "ALTER TABLE $table_name ADD $out;";
push @fks, $out;
}
else {
push @con_defs, $out;
}
return \@con_defs, \@fks;
}
sub create_view
{
my ($view) = @_;
my $out = sprintf("CREATE VIEW %s AS\n%s;",
$view->name,
$view->sql);
return $out;
}
sub create_trigger
{
my ($trigger) = @_;
# create: CREATE TRIGGER trigger_name before type /ON/i table_name reference_b(?) /FOR EACH ROW/i 'MODE DB2SQL' triggered_action
my $db_events = join ', ', $trigger->database_events;
my $out = sprintf('CREATE TRIGGER %s %s %s ON %s %s %s MODE DB2SQL %s',
$trigger->name,
$trigger->perform_action_when || 'AFTER',
$db_events =~ /update_on/i ?
('UPDATE OF '. join(', ', $trigger->fields)) :
$db_events || 'UPDATE',
$trigger->table->name,
$trigger->extra->{reference} || 'REFERENCING OLD AS oldrow NEW AS newrow',
$trigger->extra->{granularity} || 'FOR EACH ROW',
$trigger->action );
return $out;
}
sub alter_field
{
my ($from_field, $to_field) = @_;
my $data_type = uc($dt_translate{lc($to_field->data_type)} || $to_field->data_type);
my $size = $to_field->size();
$data_type .= $data_type =~ /CHAR/i ? "(${size})" : '';
# DB2 will only allow changing of varchar/vargraphic datatypes
# to extend their lengths. Or changing of text types to other
# texttypes, and numeric types to larger numeric types. (v8)
# We can also drop/add keys, checks and constraints, but not
# columns !?
my $out = sprintf('ALTER TABLE %s ALTER %s SET DATATYPE %s',
$to_field->table->name,
$to_field->name,
$data_type);
}
sub add_field
{
my ($new_field) = @_;
my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
$new_field->table->name,
create_field($new_field));
return $out;
}
sub drop_field
{
my ($field) = @_;
return '';
}
1;
SQL-Translator-0.11024/lib/SQL/Translator/Producer/Latex.pm 0000644 0001750 0001750 00000003571 12542755372 022541 0 ustar ilmari ilmari package SQL::Translator::Producer::Latex;
=pod
=head1 NAME
SQL::Translator::Producer::Latex -
Produces latex formatted tables ready for import from schema.
=head1 SYNOPSIS
use SQL::Translator;
my $translator = SQL::Translator->new(
from => 'MySQL',
filename => 'foo_schema.sql',
to => 'Latex',
);
print $translator->translate;
=head1 DESCRIPTION
Currently you will get one class (with the a table
stereotype) generated per table in the schema. The fields are added as
attributes of the classes and their datatypes set. It doesn't currently set any
of the relationships. It doesn't do any layout, all the classes are in one big
stack. However it is still useful as you can use the layout tools in Dia to
automatically arrange them horizontally or vertically.
=head2 Producer Args
=cut
use strict;
use warnings;
our @EXPORT_OK;
our $VERSION = '1.59';
use SQL::Translator::Utils 'debug';
sub produce {
my $translator = shift;
my $schema = $translator->schema;
my $o = '';
for my $table ( $schema->get_tables ) {
my $table_name = $table->name or next;
my $n = latex($table_name);
$o .=
sprintf '
\subsubsection{%s}
%s
\begin{table}[htb]
\caption{%s}
\label{tab:%s}
\center
{ \small
\begin{tabular}{l l p{8cm}}
Column & Datatype & Description \\\\ \hline
',
$n, latex($table->comments), $n, $table_name;
foreach my $f ($table->get_fields) {
$o .= sprintf '%s & %s & %s \\\\', map {latex($_)} ($f->name, $f->data_type, $f->comments || '');
$o .= "\n";
}
$o .= sprintf '
\end{tabular}
}
\end{table}
\clearpage
';
}
return $o;
}
sub latex {
my $s = shift;
return '' unless defined $s;
$s =~ s/([\&\_\$\{\#])/\\$1/g;
return $s;
}
1;
=pod
=head1 AUTHOR
Chris Mungall
=head1 SEE ALSO
SQL::Translator.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/XML.pm 0000644 0001750 0001750 00000001244 12221056401 022074 0 ustar ilmari ilmari package SQL::Translator::Producer::XML;
=pod
=head1 NAME
SQL::Translator::Producer::XML - Alias to XML::SQLFairy producer
=head1 DESCRIPTION
Previous versions of SQL::Translator included an XML producer, but the
namespace has since been further subdivided. Therefore, this module is
now just an alias to the XML::SQLFairy producer.
=head1 SEE ALSO
SQL::Translator::Producer::XML::SQLFairy.
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
use strict;
use warnings;
our $DEBUG;
our $VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Producer::XML::SQLFairy;
*produce = \&SQL::Translator::Producer::XML::SQLFairy::produce;
1;
SQL-Translator-0.11024/lib/SQL/Translator/Producer/POD.pm 0000644 0001750 0001750 00000010102 12544204454 022062 0 ustar ilmari ilmari package SQL::Translator::Producer::POD;
=head1 NAME
SQL::Translator::Producer::POD - POD producer for SQL::Translator
=head1 SYNOPSIS
use SQL::Translator;
my $t = SQL::Translator->new( parser => '...', producer => 'POD', '...' );
print $t->translate;
=head1 DESCRIPTION
Creates a POD description of each table, field, index, and constraint.
A good starting point for text documentation of a schema. You can
easily convert the output to HTML or text using "perldoc" or other
interesting formats using Pod::POM or Template::Toolkit's POD plugin.
=cut
use strict;
use warnings;
our $VERSION = '1.59';
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
sub produce {
my $t = shift;
my $schema = $t->schema;
my $schema_name = $schema->name || 'Schema';
my $args = $t->producer_args;
my $title = $args->{'title'} || $schema_name;
my $pod = "=pod\n\n=head1 DESCRIPTION\n\n$title\n\n=head1 TABLES\n\n";
for my $table ( $schema->get_tables ) {
my $table_name = $table->name or next;
my @fields = $table->get_fields or next;
$pod .= "=head2 $table_name\n\n=head3 FIELDS\n\n";
#
# Fields
#
for my $field ( @fields ) {
$pod .= "=head4 " . $field->name . "\n\n=over 4\n\n";
my $data_type = $field->data_type;
my $size = $field->size;
$data_type .= "($size)" if $size;
$pod .= "=item * $data_type\n\n";
$pod .= "=item * PRIMARY KEY\n\n" if $field->is_primary_key;
my $default = $field->default_value;
$pod .= "=item * Default '$default' \n\n" if defined $default;
$pod .= sprintf( "=item * Nullable '%s' \n\n",
$field->is_nullable ? 'Yes' : 'No' );
$pod .= "=back\n\n";
}
#
# Indices
#
if ( my @indices = $table->get_indices ) {
$pod .= "=head3 INDICES\n\n";
for my $index ( @indices ) {
$pod .= "=head4 " . $index->type . "\n\n=over 4\n\n";
$pod .= "=item * Fields = " .
join(', ', $index->fields ) . "\n\n";
$pod .= "=back\n\n";
}
}
#
# Constraints
#
if ( my @constraints = $table->get_constraints ) {
$pod .= "=head3 CONSTRAINTS\n\n";
for my $c ( @constraints ) {
$pod .= "=head4 " . $c->type . "\n\n=over 4\n\n";
if($c->type eq CHECK_C) {
$pod .= "=item * Expression = " . $c->expression . "\n\n";
} else {
$pod .= "=item * Fields = " .
join(', ', $c->fields ) . "\n\n";
if ( $c->type eq FOREIGN_KEY ) {
$pod .= "=item * Reference Table = Lreference_table . ">\n\n";
$pod .= "=item * Reference Fields = " .
join(', ', map {"L"} $c->reference_fields ) .
"\n\n";
}
if ( my $update = $c->on_update ) {
$pod .= "=item * On update = $update\n\n";
}
if ( my $delete = $c->on_delete ) {
$pod .= "=item * On delete = $delete\n\n";
}
}
$pod .= "=back\n\n";
}
}
}
my $header = ( map { $_ || () } split( /\n/, header_comment('', '') ) )[0];
$header =~ s/^Created by //;
$pod .= "=head1 PRODUCED BY\n\n$header\n\n=cut";
return $pod;
}
1;
# -------------------------------------------------------------------
# Expect poison from the standing water.
# William Blake
# -------------------------------------------------------------------
=pod
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=head2 CONTRIBUTORS
Jonathan Yu Efrequency@cpan.orgE
=head1 SEE ALSO
perldoc, perlpod, Pod::POM, Template::Manual::Plugins.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/Sybase.pm 0000644 0001750 0001750 00000031543 12163313615 022677 0 ustar ilmari ilmari package SQL::Translator::Producer::Sybase;
=head1 NAME
SQL::Translator::Producer::Sybase - Sybase producer for SQL::Translator
=head1 SYNOPSIS
use SQL::Translator;
my $t = SQL::Translator->new( parser => '...', producer => 'Sybase' );
$t->translate;
=head1 DESCRIPTION
This module will produce text output of the schema suitable for Sybase.
=cut
use strict;
use warnings;
our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment);
my %translate = (
#
# Sybase types
#
integer => 'numeric',
int => 'numeric',
number => 'numeric',
money => 'money',
varchar => 'varchar',
varchar2 => 'varchar',
timestamp => 'datetime',
text => 'varchar',
real => 'double precision',
comment => 'text',
bit => 'bit',
tinyint => 'smallint',
float => 'double precision',
serial => 'numeric',
boolean => 'varchar',
char => 'char',
long => 'varchar',
);
my %reserved = map { $_, 1 } qw[
ALL ANALYSE ANALYZE AND ANY AS ASC
BETWEEN BINARY BOTH
CASE CAST CHECK COLLATE COLUMN CONSTRAINT CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER
DEFAULT DEFERRABLE DESC DISTINCT DO
ELSE END EXCEPT
FALSE FOR FOREIGN FREEZE FROM FULL
GROUP HAVING
ILIKE IN INITIALLY INNER INTERSECT INTO IS ISNULL
JOIN LEADING LEFT LIKE LIMIT
NATURAL NEW NOT NOTNULL NULL
OFF OFFSET OLD ON ONLY OR ORDER OUTER OVERLAPS
PRIMARY PUBLIC REFERENCES RIGHT
SELECT SESSION_USER SOME TABLE THEN TO TRAILING TRUE
UNION UNIQUE USER USING VERBOSE WHEN WHERE
];
my $max_id_length = 30;
my %used_identifiers = ();
my %global_names;
my %unreserve;
my %truncated;
=pod
=head1 Sybase Create Table Syntax
CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
{ column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
| table_constraint } [, ... ]
)
[ INHERITS ( parent_table [, ... ] ) ]
[ WITH OIDS | WITHOUT OIDS ]
where column_constraint is:
[ CONSTRAINT constraint_name ]
{ NOT NULL | NULL | UNIQUE | PRIMARY KEY |
CHECK (expression) |
REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
[ ON DELETE action ] [ ON UPDATE action ] }
[ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
and table_constraint is:
[ CONSTRAINT constraint_name ]
{ UNIQUE ( column_name [, ... ] ) |
PRIMARY KEY ( column_name [, ... ] ) |
CHECK ( expression ) |
FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
[ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
[ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
=head1 Create Index Syntax
CREATE [ UNIQUE ] INDEX index_name ON table
[ USING acc_method ] ( column [ ops_name ] [, ...] )
[ WHERE predicate ]
CREATE [ UNIQUE ] INDEX index_name ON table
[ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
[ WHERE predicate ]
=cut
sub produce {
my $translator = shift;
$DEBUG = $translator->debug;
$WARN = $translator->show_warnings;
my $no_comments = $translator->no_comments;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
my $output;
$output .= header_comment unless ($no_comments);
for my $table ( $schema->get_tables ) {
my $table_name = $table->name or next;
$table_name = mk_name( $table_name, '', undef, 1 );
my $table_name_ur = unreserve($table_name) || '';
my ( @comments, @field_defs, @index_defs, @constraint_defs );
push @comments, "--\n-- Table: $table_name_ur\n--" unless $no_comments;
push @comments, map { "-- $_" } $table->comments;
#
# Fields
#
my %field_name_scope;
for my $field ( $table->get_fields ) {
my $field_name = mk_name(
$field->name, '', \%field_name_scope, undef,1
);
my $field_name_ur = unreserve( $field_name, $table_name );
my $field_def = qq["$field_name_ur"];
$field_def =~ s/\"//g;
if ( $field_def =~ /identity/ ){
$field_def =~ s/identity/pidentity/;
}
#
# Datatype
#
my $data_type = lc $field->data_type;
my $orig_data_type = $data_type;
my %extra = $field->extra;
my $list = $extra{'list'} || [];
# \todo deal with embedded quotes
my $commalist = join( ', ', map { qq['$_'] } @$list );
my $seq_name;
if ( $data_type eq 'enum' ) {
my $check_name = mk_name(
$table_name.'_'.$field_name, 'chk' ,undef, 1
);
push @constraint_defs,
"CONSTRAINT $check_name CHECK ($field_name IN ($commalist))";
$data_type .= 'character varying';
}
elsif ( $data_type eq 'set' ) {
$data_type .= 'character varying';
}
elsif ( $field->is_auto_increment ) {
$field_def .= ' IDENTITY';
}
else {
if ( defined $translate{ $data_type } ) {
$data_type = $translate{ $data_type };
}
else {
warn "Unknown datatype: $data_type ",
"($table_name.$field_name)\n" if $WARN;
}
}
my $size = $field->size;
unless ( $size ) {
if ( $data_type =~ /numeric/ ) {
$size = '9,0';
}
elsif ( $orig_data_type eq 'text' ) {
#interpret text fields as long varchars
$size = '255';
}
elsif (
$data_type eq 'varchar' &&
$orig_data_type eq 'boolean'
) {
$size = '6';
}
elsif ( $data_type eq 'varchar' ) {
$size = '255';
}
}
$field_def .= " $data_type";
$field_def .= "($size)" if $size;
#
# Default value
#
my $default = $field->default_value;
if ( defined $default ) {
$field_def .= sprintf( ' DEFAULT %s',
( $field->is_auto_increment && $seq_name )
? qq[nextval('"$seq_name"'::text)] :
( $default =~ m/null/i ) ? 'NULL' : "'$default'"
);
}
#
# Not null constraint
#
unless ( $field->is_nullable ) {
$field_def .= ' NOT NULL';
}
else {
$field_def .= ' NULL' if $data_type ne 'bit';
}
push @field_defs, $field_def;
}
#
# Constraint Declarations
#
my @constraint_decs = ();
my $c_name_default;
for my $constraint ( $table->get_constraints ) {
my $name = $constraint->name || '';
my $type = $constraint->type || NORMAL;
my @fields = map { unreserve( $_, $table_name ) }
$constraint->fields;
my @rfields = map { unreserve( $_, $table_name ) }
$constraint->reference_fields;
next unless @fields;
if ( $type eq PRIMARY_KEY ) {
$name ||= mk_name( $table_name, 'pk', undef,1 );
push @constraint_defs,
"CONSTRAINT $name PRIMARY KEY ".
'(' . join( ', ', @fields ) . ')';
}
elsif ( $type eq FOREIGN_KEY ) {
$name ||= mk_name( $table_name, 'fk', undef,1 );
push @constraint_defs,
"CONSTRAINT $name FOREIGN KEY".
' (' . join( ', ', @fields ) . ') REFERENCES '.
$constraint->reference_table.
' (' . join( ', ', @rfields ) . ')';
}
elsif ( $type eq UNIQUE ) {
$name ||= mk_name(
$table_name,
$name || ++$c_name_default,undef, 1
);
push @constraint_defs,
"CONSTRAINT $name UNIQUE " .
'(' . join( ', ', @fields ) . ')';
}
}
#
# Indices
#
for my $index ( $table->get_indices ) {
push @index_defs,
'CREATE INDEX ' . $index->name .
" ON $table_name (".
join( ', ', $index->fields ) . ");";
}
my $create_statement;
$create_statement = qq[DROP TABLE $table_name_ur;\n]
if $add_drop_table;
$create_statement .= qq[CREATE TABLE $table_name_ur (\n].
join( ",\n",
map { " $_" } @field_defs, @constraint_defs
).
"\n);"
;
$output .= join( "\n\n",
@comments,
$create_statement,
@index_defs,
''
);
}
foreach my $view ( $schema->get_views ) {
my (@comments, $view_name);
$view_name = $view->name();
push @comments, "--\n-- View: $view_name\n--" unless $no_comments;
# text of view is already a 'create view' statement so no need
# to do anything fancy.
$output .= join("\n\n",
@comments,
$view->sql(),
);
}
foreach my $procedure ( $schema->get_procedures ) {
my (@comments, $procedure_name);
$procedure_name = $procedure->name();
push @comments,
"--\n-- Procedure: $procedure_name\n--" unless $no_comments;
# text of procedure already has the 'create procedure' stuff
# so there is no need to do anything fancy. However, we should
# think about doing fancy stuff with granting permissions and
# so on.
$output .= join("\n\n",
@comments,
$procedure->sql(),
);
}
if ( $WARN ) {
if ( %truncated ) {
warn "Truncated " . keys( %truncated ) . " names:\n";
warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
}
if ( %unreserve ) {
warn "Encounted " . keys( %unreserve ) .
" unsafe names in schema (reserved or invalid):\n";
warn "\t" . join( "\n\t", sort keys %unreserve ) . "\n";
}
}
return $output;
}
sub mk_name {
my $basename = shift || '';
my $type = shift || '';
my $scope = shift || '';
my $critical = shift || '';
my $basename_orig = $basename;
my $max_name = $type
? $max_id_length - (length($type) + 1)
: $max_id_length;
$basename = substr( $basename, 0, $max_name )
if length( $basename ) > $max_name;
my $name = $type ? "${type}_$basename" : $basename;
if ( $basename ne $basename_orig and $critical ) {
my $show_type = $type ? "+'$type'" : "";
warn "Truncating '$basename_orig'$show_type to $max_id_length ",
"character limit to make '$name'\n" if $WARN;
$truncated{ $basename_orig } = $name;
}
$scope ||= \%global_names;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
$name .= sprintf( "%02d", ++$prev );
substr($name, $max_id_length - 3) = "00"
if length( $name ) > $max_id_length;
warn "The name '$name_orig' has been changed to ",
"'$name' to make it unique.\n" if $WARN;
$scope->{ $name_orig }++;
}
$name = substr( $name, 0, $max_id_length )
if ((length( $name ) > $max_id_length) && $critical);
$scope->{ $name }++;
return $name;
}
sub unreserve {
my $name = shift || '';
my $schema_obj_name = shift || '';
my ( $suffix ) = ( $name =~ s/(\W.*)$// ) ? $1 : '';
# also trap fields that don't begin with a letter
return $name if !$reserved{ uc $name } && $name =~ /^[a-z]/i;
if ( $schema_obj_name ) {
++$unreserve{"$schema_obj_name.$name"};
}
else {
++$unreserve{"$name (table name)"};
}
my $unreserve = sprintf '%s_', $name;
return $unreserve.$suffix;
}
1;
=pod
=head1 SEE ALSO
SQL::Translator.
=head1 AUTHORS
Sam Angiuoli Eangiuoli@users.sourceforge.netE,
Paul Harrington Eharringp@deshaw.comE,
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/Oracle.pm 0000644 0001750 0001750 00000063240 13064457450 022664 0 ustar ilmari ilmari package SQL::Translator::Producer::Oracle;
=head1 NAME
SQL::Translator::Producer::Oracle - Oracle SQL producer
=head1 SYNOPSIS
use SQL::Translator;
my $t = SQL::Translator->new( parser => '...', producer => 'Oracle' );
print $translator->translate( $file );
=head1 DESCRIPTION
Creates an SQL DDL suitable for Oracle.
=head1 producer_args
=over
=item delay_constraints
This option remove the primary key and other key constraints from the
CREATE TABLE statement and adds ALTER TABLEs at the end with it.
=item quote_field_names
Controls whether quotes are being used around column names in generated DDL.
=item quote_table_names
Controls whether quotes are being used around table, sequence and trigger names in
generated DDL.
=back
=head1 NOTES
=head2 Autoincremental primary keys
This producer uses sequences and triggers to autoincrement primary key
columns, if necessary. SQLPlus and DBI expect a slightly different syntax
of CREATE TRIGGER statement. You might have noticed that this
producer returns a scalar containing all statements concatenated by
newlines or an array of single statements depending on the context
(scalar, array) it has been called in.
SQLPlus expects following trigger syntax:
CREATE OR REPLACE TRIGGER ai_person_id
BEFORE INSERT ON person
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_person_id.nextval
INTO :new.id
FROM dual;
END;
/
Whereas if you want to create the same trigger using L, you need
to omit the last slash:
my $dbh = DBI->connect('dbi:Oracle:mysid', 'scott', 'tiger');
$dbh->do("
CREATE OR REPLACE TRIGGER ai_person_id
BEFORE INSERT ON person
FOR EACH ROW WHEN (
new.id IS NULL OR new.id = 0
)
BEGIN
SELECT sq_person_id.nextval
INTO :new.id
FROM dual;
END;
");
If you call this producer in array context, we expect you want to process
the returned array of statements using L like
L does.
To get this working we removed the slash in those statements in version
0.09002 of L when called in array context. In scalar
context the slash will be still there to ensure compatibility with SQLPlus.
=cut
use strict;
use warnings;
our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use base 'SQL::Translator::Producer';
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
my %translate = (
#
# MySQL types
#
bigint => 'number',
double => 'float',
decimal => 'number',
float => 'float',
int => 'number',
integer => 'number',
mediumint => 'number',
smallint => 'number',
tinyint => 'number',
char => 'char',
varchar => 'varchar2',
tinyblob => 'blob',
blob => 'blob',
mediumblob => 'blob',
longblob => 'blob',
tinytext => 'varchar2',
text => 'clob',
longtext => 'clob',
mediumtext => 'clob',
enum => 'varchar2',
set => 'varchar2',
date => 'date',
datetime => 'date',
time => 'date',
timestamp => 'date',
year => 'date',
#
# PostgreSQL types
#
numeric => 'number',
'double precision' => 'number',
serial => 'number',
bigserial => 'number',
money => 'number',
character => 'char',
'character varying' => 'varchar2',
bytea => 'BLOB',
interval => 'number',
boolean => 'number',
point => 'number',
line => 'number',
lseg => 'number',
box => 'number',
path => 'number',
polygon => 'number',
circle => 'number',
cidr => 'number',
inet => 'varchar2',
macaddr => 'varchar2',
bit => 'number',
'bit varying' => 'number',
#
# Oracle types
#
number => 'number',
varchar2 => 'varchar2',
long => 'clob',
);
#
# Oracle 8/9 max size of data types from:
# http://www.ss64.com/orasyntax/datatypes.html
#
my %max_size = (
char => 2000,
float => 126,
nchar => 2000,
nvarchar2 => 4000,
number => [ 38, 127 ],
raw => 2000,
varchar => 4000, # only synonym for varchar2
varchar2 => 4000,
);
my $max_id_length = 30;
my %used_identifiers = ();
my %global_names;
my %truncated;
# Quote used to escape table, field, sequence and trigger names
my $quote_char = '"';
sub produce {
my $translator = shift;
$DEBUG = $translator->debug;
$WARN = $translator->show_warnings || 0;
my $no_comments = $translator->no_comments;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
my $oracle_version = $translator->producer_args->{oracle_version} || 0;
my $delay_constraints = $translator->producer_args->{delay_constraints};
my ($output, $create, @table_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs);
$create .= header_comment unless ($no_comments);
my $qt = 1 if $translator->quote_table_names;
my $qf = 1 if $translator->quote_field_names;
if ( $translator->parser_type =~ /mysql/i ) {
$create .=
"-- We assume that default NLS_DATE_FORMAT has been changed\n".
"-- but we set it here anyway to be self-consistent.\n"
unless $no_comments;
$create .=
"ALTER SESSION SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS';\n\n";
}
for my $table ( $schema->get_tables ) {
my ( $table_def, $fk_def, $trigger_def, $index_def, $constraint_def ) = create_table(
$table,
{
add_drop_table => $add_drop_table,
show_warnings => $WARN,
no_comments => $no_comments,
delay_constraints => $delay_constraints,
quote_table_names => $qt,
quote_field_names => $qf,
}
);
push @table_defs, @$table_def;
push @fk_defs, @$fk_def;
push @trigger_defs, @$trigger_def;
push @index_defs, @$index_def;
push @constraint_defs, @$constraint_def;
}
my (@view_defs);
foreach my $view ( $schema->get_views ) {
my ( $view_def ) = create_view(
$view,
{
add_drop_view => $add_drop_table,
quote_table_names => $qt,
}
);
push @view_defs, @$view_def;
}
if (wantarray) {
return defined $create ? $create : (), @table_defs, @view_defs, @fk_defs, @trigger_defs, @index_defs, @constraint_defs;
}
else {
$create .= join (";\n\n", @table_defs, @view_defs, @fk_defs, @index_defs, @constraint_defs);
$create .= ";\n\n";
# If wantarray is not set we have to add "/" in this statement
# DBI->do() needs them omitted
# triggers may NOT end with a semicolon but a "/" instead
$create .= "$_/\n\n"
for @trigger_defs;
return $create;
}
}
sub create_table {
my ($table, $options) = @_;
my $qt = $options->{quote_table_names};
my $qf = $options->{quote_field_names};
my $table_name = $table->name;
my $table_name_q = quote($table_name,$qt);
my $item = '';
my $drop;
my (@create, @field_defs, @constraint_defs, @fk_defs, @trigger_defs);
push @create, "--\n-- Table: $table_name\n--" unless $options->{no_comments};
push @create, qq[DROP TABLE $table_name_q CASCADE CONSTRAINTS] if $options->{add_drop_table};
my ( %field_name_scope, @field_comments );
for my $field ( $table->get_fields ) {
my ($field_create, $field_defs, $trigger_defs, $field_comments) =
create_field($field, $options, \%field_name_scope);
push @create, @$field_create if ref $field_create;
push @field_defs, @$field_defs if ref $field_defs;
push @trigger_defs, @$trigger_defs if ref $trigger_defs;
push @field_comments, @$field_comments if ref $field_comments;
}
#
# Table options
#
my @table_options;
for my $opt ( $table->options ) {
if ( ref $opt eq 'HASH' ) {
my ( $key, $value ) = each %$opt;
if ( ref $value eq 'ARRAY' ) {
push @table_options, "$key\n(\n". join ("\n",
map { " $_->[0]\t$_->[1]" }
map { [ each %$_ ] }
@$value
)."\n)";
}
elsif ( !defined $value ) {
push @table_options, $key;
}
else {
push @table_options, "$key $value";
}
}
}
#
# Table constraints
#
for my $c ( $table->get_constraints ) {
my $name = $c->name || '';
my @fields = map { quote($_,$qf) } $c->fields;
my @rfields = map { quote($_,$qf) } $c->reference_fields;
next if !@fields && $c->type ne CHECK_C;
if ( $c->type eq PRIMARY_KEY ) {
# create a name if delay_constraints
$name ||= mk_name( $table_name, 'pk' )
if $options->{delay_constraints};
$name = quote($name,$qf);
push @constraint_defs, ($name ? "CONSTRAINT $name " : '') .
'PRIMARY KEY (' . join( ', ', @fields ) . ')';
}
elsif ( $c->type eq UNIQUE ) {
# Don't create UNIQUE constraints identical to the primary key
if ( my $pk = $table->primary_key ) {
my $u_fields = join(":", @fields);
my $pk_fields = join(":", $pk->fields);
next if $u_fields eq $pk_fields;
}
if ($name) {
# Force prepend of table_name as ORACLE doesn't allow duplicate
# CONSTRAINT names even for different tables (ORA-02264)
$name = mk_name( "${table_name}_$name", 'u' ) unless $name =~ /^$table_name/;
}
else {
$name = mk_name( $table_name, 'u' );
}
$name = quote($name, $qf);
for my $f ( $c->fields ) {
my $field_def = $table->get_field( $f ) or next;
my $dtype = $translate{ ref $field_def->data_type eq "ARRAY" ? $field_def->data_type->[0] : $field_def->data_type} or next;
if ( $WARN && $dtype =~ /clob/i ) {
warn "Oracle will not allow UNIQUE constraints on " .
"CLOB field '" . $field_def->table->name . '.' .
$field_def->name . ".'\n"
}
}
push @constraint_defs, "CONSTRAINT $name UNIQUE " .
'(' . join( ', ', @fields ) . ')';
}
elsif ( $c->type eq CHECK_C ) {
$name ||= mk_name( $name || $table_name, 'ck' );
$name = quote($name, $qf);
my $expression = $c->expression || '';
push @constraint_defs, "CONSTRAINT $name CHECK ($expression)";
}
elsif ( $c->type eq FOREIGN_KEY ) {
$name = mk_name( join('_', $table_name, $c->fields). '_fk' );
$name = quote($name, $qf);
my $on_delete = uc ($c->on_delete || '');
my $def = "CONSTRAINT $name FOREIGN KEY ";
if ( @fields ) {
$def .= '(' . join( ', ', @fields ) . ')';
}
my $ref_table = quote($c->reference_table,$qt);
$def .= " REFERENCES $ref_table";
if ( @rfields ) {
$def .= ' (' . join( ', ', @rfields ) . ')';
}
if ( $c->match_type ) {
$def .= ' MATCH ' .
( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
}
if ( $on_delete && $on_delete ne "RESTRICT") {
$def .= ' ON DELETE '.$c->on_delete;
}
# disabled by plu 2007-12-29 - doesn't exist for oracle
#if ( $c->on_update ) {
# $def .= ' ON UPDATE '. $c->on_update;
#}
push @fk_defs, sprintf("ALTER TABLE %s ADD %s", $table_name_q, $def);
}
}
#
# Index Declarations
#
my @index_defs = ();
for my $index ( $table->get_indices ) {
my $index_name = $index->name || '';
my $index_type = $index->type || NORMAL;
my @fields = map { quote($_, $qf) } $index->fields;
next unless @fields;
my @index_options;
for my $opt ( $index->options ) {
if ( ref $opt eq 'HASH' ) {
my ( $key, $value ) = each %$opt;
if ( ref $value eq 'ARRAY' ) {
push @table_options, "$key\n(\n". join ("\n",
map { " $_->[0]\t$_->[1]" }
map { [ each %$_ ] }
@$value
)."\n)";
}
elsif ( !defined $value ) {
push @index_options, $key;
}
else {
push @index_options, "$key $value";
}
}
}
my $index_options = @index_options
? "\n".join("\n", @index_options) : '';
if ( $index_type eq PRIMARY_KEY ) {
$index_name = $index_name ? mk_name( $index_name )
: mk_name( $table_name, 'pk' );
$index_name = quote($index_name, $qf);
push @field_defs, 'CONSTRAINT '.$index_name.' PRIMARY KEY '.
'(' . join( ', ', @fields ) . ')';
}
elsif ( $index_type eq NORMAL ) {
$index_name = $index_name ? mk_name( $index_name )
: mk_name( $table_name, $index_name || 'i' );
$index_name = quote($index_name, $qf);
push @index_defs,
"CREATE INDEX $index_name on $table_name_q (".
join( ', ', @fields ).
")$index_options";
}
elsif ( $index_type eq UNIQUE ) {
$index_name = $index_name ? mk_name( $index_name )
: mk_name( $table_name, $index_name || 'i' );
$index_name = quote($index_name, $qf);
push @index_defs,
"CREATE UNIQUE INDEX $index_name on $table_name_q (".
join( ', ', @fields ).
")$index_options";
}
else {
warn "Unknown index type ($index_type) on table $table_name.\n"
if $WARN;
}
}
if ( my @table_comments = $table->comments ) {
for my $comment ( @table_comments ) {
next unless $comment;
$comment = __PACKAGE__->_quote_string($comment);
push @field_comments, "COMMENT ON TABLE $table_name_q is\n $comment"
unless $options->{no_comments};
}
}
my $table_options = @table_options
? "\n".join("\n", @table_options) : '';
push @create, "CREATE TABLE $table_name_q (\n" .
join( ",\n", map { " $_" } @field_defs,
($options->{delay_constraints} ? () : @constraint_defs) ) .
"\n)$table_options";
@constraint_defs = map { "ALTER TABLE $table_name_q ADD $_" }
@constraint_defs;
if ( $WARN ) {
if ( %truncated ) {
warn "Truncated " . keys( %truncated ) . " names:\n";
warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
}
}
return \@create, \@fk_defs, \@trigger_defs, \@index_defs, ($options->{delay_constraints} ? \@constraint_defs : []);
}
sub alter_field {
my ($from_field, $to_field, $options) = @_;
my $qt = $options->{quote_table_names};
my ($field_create, $field_defs, $trigger_defs, $field_comments) =
create_field($to_field, $options, {});
# Fix ORA-01442
if ($to_field->is_nullable && !$from_field->is_nullable) {
die 'Cannot remove NOT NULL from table field';
} elsif (!$from_field->is_nullable && !$to_field->is_nullable) {
@$field_defs = map { s/ NOT NULL//; $_} @$field_defs;
}
my $table_name = quote($to_field->table->name,$qt);
return 'ALTER TABLE '.$table_name.' MODIFY ( '.join('', @$field_defs).' )';
}
sub add_field {
my ($new_field, $options) = @_;
my $qt = $options->{quote_table_names};
my ($field_create, $field_defs, $trigger_defs, $field_comments) =
create_field($new_field, $options, {});
my $table_name = quote($new_field->table->name,$qt);
my $out = sprintf('ALTER TABLE %s ADD ( %s )',
$table_name,
join('', @$field_defs));
return $out;
}
sub create_field {
my ($field, $options, $field_name_scope) = @_;
my $qf = $options->{quote_field_names};
my $qt = $options->{quote_table_names};
my (@create, @field_defs, @trigger_defs, @field_comments);
my $table_name = $field->table->name;
my $table_name_q = quote($table_name, $qt);
#
# Field name
#
my $field_name = mk_name(
$field->name, '', $field_name_scope, 1
);
my $field_name_q = quote($field_name, $qf);
my $field_def = quote($field_name, $qf);
$field->name( $field_name );
#
# Datatype
#
my $check;
my $data_type = lc $field->data_type;
my @size = $field->size;
my %extra = $field->extra;
my $list = $extra{'list'} || [];
my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
if ( $data_type eq 'enum' ) {
$check = "CHECK ($field_name_q IN ($commalist))";
$data_type = 'varchar2';
}
elsif ( $data_type eq 'set' ) {
# XXX add a CHECK constraint maybe
# (trickier and slower, than enum :)
$data_type = 'varchar2';
}
else {
if (defined $translate{ $data_type }) {
if (ref $translate{ $data_type } eq "ARRAY") {
($data_type,$size[0]) = @{$translate{ $data_type }};
} else {
$data_type = $translate{ $data_type };
}
}
$data_type ||= 'varchar2';
}
# ensure size is not bigger than max size oracle allows for data type
if ( defined $max_size{$data_type} ) {
for ( my $i = 0 ; $i < scalar @size ; $i++ ) {
my $max =
ref( $max_size{$data_type} ) eq 'ARRAY'
? $max_size{$data_type}->[$i]
: $max_size{$data_type};
$size[$i] = $max if $size[$i] > $max;
}
}
#
# Fixes ORA-02329: column of datatype LOB cannot be
# unique or a primary key
#
if ( $data_type eq 'clob' && $field->is_primary_key ) {
$data_type = 'varchar2';
$size[0] = 4000;
warn "CLOB cannot be a primary key, changing to VARCHAR2\n"
if $WARN;
}
if ( $data_type eq 'clob' && $field->is_unique ) {
$data_type = 'varchar2';
$size[0] = 4000;
warn "CLOB cannot be a unique key, changing to VARCHAR2\n"
if $WARN;
}
#
# Fixes ORA-00907: missing right parenthesis
#
if ( $data_type =~ /(date|clob)/i ) {
undef @size;
}
#
# Fixes ORA-00906: missing right parenthesis
# if size is 0 or undefined
#
for (qw/varchar2/) {
if ( $data_type =~ /^($_)$/i ) {
$size[0] ||= $max_size{$_};
}
}
$field_def .= " $data_type";
if ( defined $size[0] && $size[0] > 0 ) {
$field_def .= '(' . join( ',', @size ) . ')';
}
#
# Default value
#
my $default = $field->default_value;
if ( defined $default ) {
#
# Wherein we try to catch a string being used as
# a default value for a numerical field. If "true/false,"
# then sub "1/0," otherwise just test the truthity of the
# argument and use that (naive?).
#
if (ref $default and defined $$default) {
$default = $$default;
} elsif (ref $default) {
$default = 'NULL';
} elsif (
$data_type =~ /^number$/i &&
$default !~ /^-?\d+$/ &&
$default !~ m/null/i
) {
if ( $default =~ /^true$/i ) {
$default = "'1'";
} elsif ( $default =~ /^false$/i ) {
$default = "'0'";
} else {
$default = $default ? "'1'" : "'0'";
}
} elsif (
$data_type =~ /date/ && (
$default eq 'current_timestamp'
||
$default eq 'now()'
)
) {
$default = 'SYSDATE';
} else {
$default = $default =~ m/null/i ? 'NULL' : __PACKAGE__->_quote_string($default);
}
$field_def .= " DEFAULT $default",
}
#
# Not null constraint
#
unless ( $field->is_nullable ) {
$field_def .= ' NOT NULL';
}
$field_def .= " $check" if $check;
#
# Auto_increment
#
if ( $field->is_auto_increment ) {
my $base_name = $table_name . "_". $field_name;
my $seq_name = quote(mk_name( $base_name, 'sq' ),$qt);
my $trigger_name = quote(mk_name( $base_name, 'ai' ),$qt);
push @create, qq[DROP SEQUENCE $seq_name] if $options->{add_drop_table};
push @create, "CREATE SEQUENCE $seq_name";
my $trigger =
"CREATE OR REPLACE TRIGGER $trigger_name\n" .
"BEFORE INSERT ON $table_name_q\n" .
"FOR EACH ROW WHEN (\n" .
" new.$field_name_q IS NULL".
" OR new.$field_name_q = 0\n".
")\n".
"BEGIN\n" .
" SELECT $seq_name.nextval\n" .
" INTO :new." . $field_name_q."\n" .
" FROM dual;\n" .
"END;\n";
push @trigger_defs, $trigger;
}
if ( lc $field->data_type eq 'timestamp' ) {
my $base_name = $table_name . "_". $field_name;
my $trig_name = quote(mk_name( $base_name, 'ts' ), $qt);
my $trigger =
"CREATE OR REPLACE TRIGGER $trig_name\n".
"BEFORE INSERT OR UPDATE ON $table_name_q\n".
"FOR EACH ROW WHEN (new.$field_name_q IS NULL)\n".
"BEGIN\n".
" SELECT sysdate INTO :new.$field_name_q FROM dual;\n".
"END;\n";
push @trigger_defs, $trigger;
}
push @field_defs, $field_def;
if ( my $comment = $field->comments ) {
$comment =~ __PACKAGE__->_quote_string($comment);
push @field_comments,
"COMMENT ON COLUMN $table_name_q.$field_name_q is\n $comment;"
unless $options->{no_comments};
}
return \@create, \@field_defs, \@trigger_defs, \@field_comments;
}
sub create_view {
my ($view, $options) = @_;
my $qt = $options->{quote_table_names};
my $view_name = quote($view->name,$qt);
my @create;
push @create, qq[DROP VIEW $view_name]
if $options->{add_drop_view};
push @create, sprintf("CREATE VIEW %s AS\n%s",
$view_name,
$view->sql);
return \@create;
}
sub mk_name {
my $basename = shift || '';
my $type = shift || '';
$type = '' if $type =~ /^\d/;
my $scope = shift || '';
my $critical = shift || '';
my $basename_orig = $basename;
my $max_name = $type
? $max_id_length - (length($type) + 1)
: $max_id_length;
$basename = substr( $basename, 0, $max_name )
if length( $basename ) > $max_name;
my $name = $type ? "${type}_$basename" : $basename;
if ( $basename ne $basename_orig and $critical ) {
my $show_type = $type ? "+'$type'" : "";
warn "Truncating '$basename_orig'$show_type to $max_id_length ",
"character limit to make '$name'\n" if $WARN;
$truncated{ $basename_orig } = $name;
}
$scope ||= \%global_names;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
substr($name, $max_id_length - 2) = ""
if length( $name ) >= $max_id_length - 1;
$name .= sprintf( "%02d", $prev++ );
warn "The name '$name_orig' has been changed to ",
"'$name' to make it unique.\n" if $WARN;
$scope->{ $name_orig }++;
}
$scope->{ $name }++;
return $name;
}
1;
sub quote {
my ($name, $q) = @_;
return $name unless $q && $name;
$name =~ s/\Q$quote_char/$quote_char$quote_char/g;
return "$quote_char$name$quote_char";
}
# -------------------------------------------------------------------
# All bad art is the result of good intentions.
# Oscar Wilde
# -------------------------------------------------------------------
=pod
=head1 CREDITS
Mad props to Tim Bunce for much of the logic stolen from his "mysql2ora"
script.
=head1 AUTHORS
Ken Youens-Clark Ekclark@cpan.orgE,
Alexander Hartmaier Eabraxxa@cpan.orgE,
Fabien Wernli Efaxmodem@cpan.orgE.
=head1 SEE ALSO
SQL::Translator, DDL::Oracle, mysql2ora.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/PostgreSQL.pm 0000644 0001750 0001750 00000076622 12701472034 023462 0 ustar ilmari ilmari package SQL::Translator::Producer::PostgreSQL;
=head1 NAME
SQL::Translator::Producer::PostgreSQL - PostgreSQL producer for SQL::Translator
=head1 SYNOPSIS
my $t = SQL::Translator->new( parser => '...', producer => 'PostgreSQL' );
$t->translate;
=head1 DESCRIPTION
Creates a DDL suitable for PostgreSQL. Very heavily based on the Oracle
producer.
Now handles PostGIS Geometry and Geography data types on table definitions.
Does not yet support PostGIS Views.
=cut
use strict;
use warnings;
our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use base qw(SQL::Translator::Producer);
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements normalize_quote_options);
use SQL::Translator::Generator::DDL::PostgreSQL;
use Data::Dumper;
use constant MAX_ID_LENGTH => 62;
{
my ($quoting_generator, $nonquoting_generator);
sub _generator {
my $options = shift;
return $options->{generator} if exists $options->{generator};
return normalize_quote_options($options)
? $quoting_generator ||= SQL::Translator::Generator::DDL::PostgreSQL->new
: $nonquoting_generator ||= SQL::Translator::Generator::DDL::PostgreSQL->new(
quote_chars => [],
);
}
}
my ( %translate );
BEGIN {
%translate = (
#
# MySQL types
#
double => 'double precision',
decimal => 'numeric',
int => 'integer',
mediumint => 'integer',
tinyint => 'smallint',
char => 'character',
varchar => 'character varying',
longtext => 'text',
mediumtext => 'text',
tinytext => 'text',
tinyblob => 'bytea',
blob => 'bytea',
mediumblob => 'bytea',
longblob => 'bytea',
enum => 'character varying',
set => 'character varying',
datetime => 'timestamp',
year => 'date',
#
# Oracle types
#
number => 'integer',
varchar2 => 'character varying',
long => 'text',
clob => 'text',
#
# Sybase types
#
comment => 'text',
#
# MS Access types
#
memo => 'text',
);
}
my %truncated;
=pod
=head1 PostgreSQL Create Table Syntax
CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
{ column_name data_type [ DEFAULT default_expr ] [ column_constraint [, ... ] ]
| table_constraint } [, ... ]
)
[ INHERITS ( parent_table [, ... ] ) ]
[ WITH OIDS | WITHOUT OIDS ]
where column_constraint is:
[ CONSTRAINT constraint_name ]
{ NOT NULL | NULL | UNIQUE | PRIMARY KEY |
CHECK (expression) |
REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
[ ON DELETE action ] [ ON UPDATE action ] }
[ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
and table_constraint is:
[ CONSTRAINT constraint_name ]
{ UNIQUE ( column_name [, ... ] ) |
PRIMARY KEY ( column_name [, ... ] ) |
CHECK ( expression ) |
FOREIGN KEY ( column_name [, ... ] ) REFERENCES reftable [ ( refcolumn [, ... ] ) ]
[ MATCH FULL | MATCH PARTIAL ] [ ON DELETE action ] [ ON UPDATE action ] }
[ DEFERRABLE | NOT DEFERRABLE ] [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
=head1 Create Index Syntax
CREATE [ UNIQUE ] INDEX index_name ON table
[ USING acc_method ] ( column [ ops_name ] [, ...] )
[ WHERE predicate ]
CREATE [ UNIQUE ] INDEX index_name ON table
[ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
[ WHERE predicate ]
=cut
sub produce {
my $translator = shift;
local $DEBUG = $translator->debug;
local $WARN = $translator->show_warnings;
my $no_comments = $translator->no_comments;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
my $pargs = $translator->producer_args;
my $postgres_version = parse_dbms_version(
$pargs->{postgres_version}, 'perl'
);
my $generator = _generator({ quote_identifiers => $translator->quote_identifiers });
my @output;
push @output, header_comment unless ($no_comments);
my (@table_defs, @fks);
my %type_defs;
for my $table ( $schema->get_tables ) {
my ($table_def, $fks) = create_table($table, {
generator => $generator,
no_comments => $no_comments,
postgres_version => $postgres_version,
add_drop_table => $add_drop_table,
type_defs => \%type_defs,
});
push @table_defs, $table_def;
push @fks, @$fks;
}
for my $view ( $schema->get_views ) {
push @table_defs, create_view($view, {
postgres_version => $postgres_version,
add_drop_view => $add_drop_table,
generator => $generator,
no_comments => $no_comments,
});
}
for my $trigger ( $schema->get_triggers ) {
push @table_defs, create_trigger( $trigger, {
add_drop_trigger => $add_drop_table,
generator => $generator,
no_comments => $no_comments,
});
}
push @output, map { "$_;\n\n" } values %type_defs;
push @output, map { "$_;\n\n" } @table_defs;
if ( @fks ) {
push @output, "--\n-- Foreign Key Definitions\n--\n\n" unless $no_comments;
push @output, map { "$_;\n\n" } @fks;
}
if ( $WARN ) {
if ( %truncated ) {
warn "Truncated " . keys( %truncated ) . " names:\n";
warn "\t" . join( "\n\t", sort keys %truncated ) . "\n";
}
}
return wantarray
? @output
: join ('', @output);
}
{
my %global_names;
sub mk_name {
my $basename = shift || '';
my $type = shift || '';
my $scope = shift || '';
my $critical = shift || '';
my $basename_orig = $basename;
my $max_name = $type
? MAX_ID_LENGTH - (length($type) + 1)
: MAX_ID_LENGTH;
$basename = substr( $basename, 0, $max_name )
if length( $basename ) > $max_name;
my $name = $type ? "${type}_$basename" : $basename;
if ( $basename ne $basename_orig and $critical ) {
my $show_type = $type ? "+'$type'" : "";
warn "Truncating '$basename_orig'$show_type to ", MAX_ID_LENGTH,
" character limit to make '$name'\n" if $WARN;
$truncated{ $basename_orig } = $name;
}
$scope ||= \%global_names;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
$name .= sprintf( "%02d", ++$prev );
substr($name, MAX_ID_LENGTH - 3) = "00"
if length( $name ) > MAX_ID_LENGTH;
warn "The name '$name_orig' has been changed to ",
"'$name' to make it unique.\n" if $WARN;
$scope->{ $name_orig }++;
}
$scope->{ $name }++;
return $name;
}
}
sub is_geometry {
my $field = shift;
return 1 if $field->data_type eq 'geometry';
}
sub is_geography {
my $field = shift;
return 1 if $field->data_type eq 'geography';
}
sub create_table
{
my ($table, $options) = @_;
my $generator = _generator($options);
my $no_comments = $options->{no_comments} || 0;
my $add_drop_table = $options->{add_drop_table} || 0;
my $postgres_version = $options->{postgres_version} || 0;
my $type_defs = $options->{type_defs} || {};
my $table_name = $table->name or next;
my $table_name_qt = $generator->quote($table_name);
my ( @comments, @field_defs, @index_defs, @constraint_defs, @fks );
push @comments, "--\n-- Table: $table_name\n--\n" unless $no_comments;
if ( !$no_comments and my $comments = $table->comments ) {
$comments =~ s/^/-- /mg;
push @comments, "-- Comments:\n$comments\n--\n";
}
#
# Fields
#
for my $field ( $table->get_fields ) {
push @field_defs, create_field($field, {
generator => $generator,
postgres_version => $postgres_version,
type_defs => $type_defs,
constraint_defs => \@constraint_defs,
});
}
#
# Index Declarations
#
for my $index ( $table->get_indices ) {
my ($idef, $constraints) = create_index($index, {
generator => $generator,
});
$idef and push @index_defs, $idef;
push @constraint_defs, @$constraints;
}
#
# Table constraints
#
for my $c ( $table->get_constraints ) {
my ($cdefs, $fks) = create_constraint($c, {
generator => $generator,
});
push @constraint_defs, @$cdefs;
push @fks, @$fks;
}
my $create_statement = join("\n", @comments);
if ($add_drop_table) {
if ($postgres_version >= 8.002) {
$create_statement .= "DROP TABLE IF EXISTS $table_name_qt CASCADE;\n";
} else {
$create_statement .= "DROP TABLE $table_name_qt CASCADE;\n";
}
}
my $temporary = $table->extra->{temporary} ? "TEMPORARY " : "";
$create_statement .= "CREATE ${temporary}TABLE $table_name_qt (\n" .
join( ",\n", map { " $_" } @field_defs, @constraint_defs ).
"\n)"
;
$create_statement .= @index_defs ? ';' : q{};
$create_statement .= ( $create_statement =~ /;$/ ? "\n" : q{} )
. join(";\n", @index_defs);
#
# Geometry
#
if (my @geometry_columns = grep { is_geometry($_) } $table->get_fields) {
$create_statement .= join(";\n", '', map{ drop_geometry_column($_, $options) } @geometry_columns) if $options->{add_drop_table};
$create_statement .= join(";\n", '', map{ add_geometry_column($_, $options) } @geometry_columns);
}
return $create_statement, \@fks;
}
sub create_view {
my ($view, $options) = @_;
my $generator = _generator($options);
my $postgres_version = $options->{postgres_version} || 0;
my $add_drop_view = $options->{add_drop_view};
my $view_name = $view->name;
debug("PKG: Looking at view '${view_name}'\n");
my $create = '';
$create .= "--\n-- View: " . $generator->quote($view_name) . "\n--\n"
unless $options->{no_comments};
if ($add_drop_view) {
if ($postgres_version >= 8.002) {
$create .= "DROP VIEW IF EXISTS " . $generator->quote($view_name) . ";\n";
} else {
$create .= "DROP VIEW " . $generator->quote($view_name) . ";\n";
}
}
$create .= 'CREATE';
my $extra = $view->extra;
$create .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
$create .= " VIEW " . $generator->quote($view_name);
if ( my @fields = $view->fields ) {
my $field_list = join ', ', map { $generator->quote($_) } @fields;
$create .= " ( ${field_list} )";
}
if ( my $sql = $view->sql ) {
$create .= " AS\n ${sql}\n";
}
if ( $extra->{check_option} ) {
$create .= ' WITH ' . uc $extra->{check_option} . ' CHECK OPTION';
}
return $create;
}
{
my %field_name_scope;
sub create_field
{
my ($field, $options) = @_;
my $generator = _generator($options);
my $table_name = $field->table->name;
my $constraint_defs = $options->{constraint_defs} || [];
my $postgres_version = $options->{postgres_version} || 0;
my $type_defs = $options->{type_defs} || {};
$field_name_scope{$table_name} ||= {};
my $field_name = $field->name;
my $field_comments = '';
if (my $comments = $field->comments) {
$comments =~ s/(?quote($field_name);
#
# Datatype
#
my $data_type = lc $field->data_type;
my %extra = $field->extra;
my $list = $extra{'list'} || [];
my $commalist = join( ', ', map { __PACKAGE__->_quote_string($_) } @$list );
if ($postgres_version >= 8.003 && $data_type eq 'enum') {
my $type_name = $extra{'custom_type_name'} || $field->table->name . '_' . $field->name . '_type';
$field_def .= ' '. $type_name;
my $new_type_def = "DROP TYPE IF EXISTS $type_name CASCADE;\n" .
"CREATE TYPE $type_name AS ENUM ($commalist)";
if (! exists $type_defs->{$type_name} ) {
$type_defs->{$type_name} = $new_type_def;
} elsif ( $type_defs->{$type_name} ne $new_type_def ) {
die "Attempted to redefine type name '$type_name' as a different type.\n";
}
} else {
$field_def .= ' '. convert_datatype($field);
}
#
# Default value
#
__PACKAGE__->_apply_default_value(
$field,
\$field_def,
[
'NULL' => \'NULL',
'now()' => 'now()',
'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
],
);
#
# Not null constraint
#
$field_def .= ' NOT NULL' unless $field->is_nullable;
#
# Geometry constraints
#
if (is_geometry($field)) {
foreach ( create_geometry_constraints($field, $options) ) {
my ($cdefs, $fks) = create_constraint($_, $options);
push @$constraint_defs, @$cdefs;
push @$fks, @$fks;
}
}
return $field_def;
}
}
sub create_geometry_constraints {
my ($field, $options) = @_;
my $fname = _generator($options)->quote($field);
my @constraints;
push @constraints, SQL::Translator::Schema::Constraint->new(
name => "enforce_dims_".$field->name,
expression => "(ST_NDims($fname) = ".$field->extra->{dimensions}.")",
table => $field->table,
type => CHECK_C,
);
push @constraints, SQL::Translator::Schema::Constraint->new(
name => "enforce_srid_".$field->name,
expression => "(ST_SRID($fname) = ".$field->extra->{srid}.")",
table => $field->table,
type => CHECK_C,
);
push @constraints, SQL::Translator::Schema::Constraint->new(
name => "enforce_geotype_".$field->name,
expression => "(GeometryType($fname) = ". __PACKAGE__->_quote_string($field->extra->{geometry_type}) ."::text OR $fname IS NULL)",
table => $field->table,
type => CHECK_C,
);
return @constraints;
}
{
my %index_name;
sub create_index
{
my ($index, $options) = @_;
my $generator = _generator($options);
my $table_name = $index->table->name;
my ($index_def, @constraint_defs);
my $name
= $index->name
|| join('_', $table_name, 'idx', ++$index_name{ $table_name });
my $type = $index->type || NORMAL;
my @fields = $index->fields;
return unless @fields;
my $index_using;
my $index_where;
for my $opt ( $index->options ) {
if ( ref $opt eq 'HASH' ) {
foreach my $key (keys %$opt) {
my $value = $opt->{$key};
next unless defined $value;
if ( uc($key) eq 'USING' ) {
$index_using = "USING $value";
}
elsif ( uc($key) eq 'WHERE' ) {
$index_where = "WHERE $value";
}
}
}
}
my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' ';
my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
if ( $type eq PRIMARY_KEY ) {
push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
}
elsif ( $type eq UNIQUE ) {
push @constraint_defs, "${def_start}UNIQUE " .$field_names;
}
elsif ( $type eq NORMAL ) {
$index_def =
'CREATE INDEX ' . $generator->quote($name) . ' on ' . $generator->quote($table_name) . ' ' .
join ' ', grep { defined } $index_using, $field_names, $index_where;
}
else {
warn "Unknown index type ($type) on table $table_name.\n"
if $WARN;
}
return $index_def, \@constraint_defs;
}
}
sub create_constraint
{
my ($c, $options) = @_;
my $generator = _generator($options);
my $table_name = $c->table->name;
my (@constraint_defs, @fks);
my $name = $c->name || '';
my @fields = grep { defined } $c->fields;
my @rfields = grep { defined } $c->reference_fields;
next if !@fields && $c->type ne CHECK_C;
my $def_start = $name ? 'CONSTRAINT ' . $generator->quote($name) . ' ' : '';
my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')';
if ( $c->type eq PRIMARY_KEY ) {
push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names;
}
elsif ( $c->type eq UNIQUE ) {
push @constraint_defs, "${def_start}UNIQUE " .$field_names;
}
elsif ( $c->type eq CHECK_C ) {
my $expression = $c->expression;
push @constraint_defs, "${def_start}CHECK ($expression)";
}
elsif ( $c->type eq FOREIGN_KEY ) {
my $def .= "ALTER TABLE " . $generator->quote($table_name) . " ADD ${def_start}FOREIGN KEY $field_names"
. "\n REFERENCES " . $generator->quote($c->reference_table);
if ( @rfields ) {
$def .= ' (' . join( ', ', map { $generator->quote($_) } @rfields ) . ')';
}
if ( $c->match_type ) {
$def .= ' MATCH ' .
( $c->match_type =~ /full/i ) ? 'FULL' : 'PARTIAL';
}
if ( $c->on_delete ) {
$def .= ' ON DELETE '. $c->on_delete;
}
if ( $c->on_update ) {
$def .= ' ON UPDATE '. $c->on_update;
}
if ( $c->deferrable ) {
$def .= ' DEFERRABLE';
}
push @fks, "$def";
}
return \@constraint_defs, \@fks;
}
sub create_trigger {
my ($trigger,$options) = @_;
my $generator = _generator($options);
my @statements;
push @statements, sprintf( 'DROP TRIGGER IF EXISTS %s', $generator->quote($trigger->name) )
if $options->{add_drop_trigger};
my $scope = $trigger->scope || '';
$scope = " FOR EACH $scope" if $scope;
push @statements, sprintf(
'CREATE TRIGGER %s %s %s ON %s%s %s',
$generator->quote($trigger->name),
$trigger->perform_action_when,
join( ' OR ', @{ $trigger->database_events } ),
$generator->quote($trigger->on_table),
$scope,
$trigger->action,
);
return @statements;
}
sub convert_datatype
{
my ($field) = @_;
my @size = $field->size;
my $data_type = lc $field->data_type;
my $array = $data_type =~ s/\[\]$//;
if ( $data_type eq 'enum' ) {
# my $len = 0;
# $len = ($len < length($_)) ? length($_) : $len for (@$list);
# my $chk_name = mk_name( $table_name.'_'.$field_name, 'chk' );
# push @$constraint_defs,
# 'CONSTRAINT "$chk_name" CHECK (' . $generator->quote(field_name) .
# qq[IN ($commalist))];
$data_type = 'character varying';
}
elsif ( $data_type eq 'set' ) {
$data_type = 'character varying';
}
elsif ( $field->is_auto_increment ) {
if ( (defined $size[0] && $size[0] > 11) or $data_type eq 'bigint' ) {
$data_type = 'bigserial';
}
else {
$data_type = 'serial';
}
undef @size;
}
else {
$data_type = defined $translate{ lc $data_type } ?
$translate{ lc $data_type } :
$data_type;
}
if ( $data_type =~ /^time/i || $data_type =~ /^interval/i ) {
if ( defined $size[0] && $size[0] > 6 ) {
$size[0] = 6;
}
}
if ( $data_type eq 'integer' ) {
if ( defined $size[0] && $size[0] > 0) {
if ( $size[0] > 10 ) {
$data_type = 'bigint';
}
elsif ( $size[0] < 5 ) {
$data_type = 'smallint';
}
else {
$data_type = 'integer';
}
}
else {
$data_type = 'integer';
}
}
my $type_with_size = join('|',
'bit', 'varbit', 'character', 'bit varying', 'character varying',
'time', 'timestamp', 'interval', 'numeric', 'float'
);
if ( $data_type !~ /$type_with_size/ ) {
@size = ();
}
if (defined $size[0] && $size[0] > 0 && $data_type =~ /^time/i ) {
$data_type =~ s/^(time.*?)( with.*)?$/$1($size[0])/;
$data_type .= $2 if(defined $2);
} elsif ( defined $size[0] && $size[0] > 0 ) {
$data_type .= '(' . join( ',', @size ) . ')';
}
if($array)
{
$data_type .= '[]';
}
#
# Geography
#
if($data_type eq 'geography'){
$data_type .= '('.$field->extra->{geography_type}.','. $field->extra->{srid} .')'
}
return $data_type;
}
sub alter_field
{
my ($from_field, $to_field, $options) = @_;
die "Can't alter field in another table"
if($from_field->table->name ne $to_field->table->name);
my $generator = _generator($options);
my @out;
# drop geometry column and constraints
push @out,
drop_geometry_column($from_field, $options),
drop_geometry_constraints($from_field, $options),
if is_geometry($from_field);
# it's necessary to start with rename column cause this would affect
# all of the following statements which would be broken if do the
# rename later
# BUT: drop geometry is done before the rename, cause it work's on the
# $from_field directly
push @out, sprintf('ALTER TABLE %s RENAME COLUMN %s TO %s',
map($generator->quote($_),
$to_field->table->name,
$from_field->name,
$to_field->name,
),
)
if($from_field->name ne $to_field->name);
push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET NOT NULL',
map($generator->quote($_),
$to_field->table->name,
$to_field->name
),
)
if(!$to_field->is_nullable and $from_field->is_nullable);
push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP NOT NULL',
map($generator->quote($_),
$to_field->table->name,
$to_field->name
),
)
if (!$from_field->is_nullable and $to_field->is_nullable);
my $from_dt = convert_datatype($from_field);
my $to_dt = convert_datatype($to_field);
push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s TYPE %s',
map($generator->quote($_),
$to_field->table->name,
$to_field->name
),
$to_dt,
)
if($to_dt ne $from_dt);
my $old_default = $from_field->default_value;
my $new_default = $to_field->default_value;
my $default_value = $to_field->default_value;
# fixes bug where output like this was created:
# ALTER TABLE users ALTER COLUMN column SET DEFAULT ThisIsUnescaped;
if(ref $default_value eq "SCALAR" ) {
$default_value = $$default_value;
} elsif( defined $default_value && $to_dt =~ /^(character|text)/xsmi ) {
$default_value = __PACKAGE__->_quote_string($default_value);
}
push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s SET DEFAULT %s',
map($generator->quote($_),
$to_field->table->name,
$to_field->name,
),
$default_value,
)
if ( defined $new_default &&
(!defined $old_default || $old_default ne $new_default) );
# fixes bug where removing the DEFAULT statement of a column
# would result in no change
push @out, sprintf('ALTER TABLE %s ALTER COLUMN %s DROP DEFAULT',
map($generator->quote($_),
$to_field->table->name,
$to_field->name,
),
)
if ( !defined $new_default && defined $old_default );
# add geometry column and constraints
push @out,
add_geometry_column($to_field, $options),
add_geometry_constraints($to_field, $options),
if is_geometry($to_field);
return wantarray ? @out : join(";\n", @out);
}
sub rename_field { alter_field(@_) }
sub add_field
{
my ($new_field,$options) = @_;
my $out = sprintf('ALTER TABLE %s ADD COLUMN %s',
_generator($options)->quote($new_field->table->name),
create_field($new_field, $options));
$out .= ";\n".add_geometry_column($new_field, $options)
. ";\n".add_geometry_constraints($new_field, $options)
if is_geometry($new_field);
return $out;
}
sub drop_field
{
my ($old_field, $options) = @_;
my $generator = _generator($options);
my $out = sprintf('ALTER TABLE %s DROP COLUMN %s',
$generator->quote($old_field->table->name),
$generator->quote($old_field->name));
$out .= ";\n".drop_geometry_column($old_field, $options)
if is_geometry($old_field);
return $out;
}
sub add_geometry_column {
my ($field, $options) = @_;
return sprintf(
"INSERT INTO geometry_columns VALUES (%s,%s,%s,%s,%s,%s,%s)",
map(__PACKAGE__->_quote_string($_),
'',
$field->table->schema->name,
$options->{table} ? $options->{table} : $field->table->name,
$field->name,
$field->extra->{dimensions},
$field->extra->{srid},
$field->extra->{geometry_type},
),
);
}
sub drop_geometry_column {
my ($field) = @_;
return sprintf(
"DELETE FROM geometry_columns WHERE f_table_schema = %s AND f_table_name = %s AND f_geometry_column = %s",
map(__PACKAGE__->_quote_string($_),
$field->table->schema->name,
$field->table->name,
$field->name,
),
);
}
sub add_geometry_constraints {
my ($field, $options) = @_;
return join(";\n", map { alter_create_constraint($_, $options) }
create_geometry_constraints($field, $options));
}
sub drop_geometry_constraints {
my ($field, $options) = @_;
return join(";\n", map { alter_drop_constraint($_, $options) }
create_geometry_constraints($field, $options));
}
sub alter_table {
my ($to_table, $options) = @_;
my $generator = _generator($options);
my $out = sprintf('ALTER TABLE %s %s',
$generator->quote($to_table->name),
$options->{alter_table_action});
$out .= ";\n".$options->{geometry_changes} if $options->{geometry_changes};
return $out;
}
sub rename_table {
my ($old_table, $new_table, $options) = @_;
my $generator = _generator($options);
$options->{alter_table_action} = "RENAME TO " . $generator->quote($new_table);
my @geometry_changes = map {
drop_geometry_column($_, $options),
add_geometry_column($_, { %{$options}, table => $new_table }),
} grep { is_geometry($_) } $old_table->get_fields;
$options->{geometry_changes} = join (";\n",@geometry_changes) if @geometry_changes;
return alter_table($old_table, $options);
}
sub alter_create_index {
my ($index, $options) = @_;
my $generator = _generator($options);
my ($idef, $constraints) = create_index($index, $options);
return $index->type eq NORMAL ? $idef
: sprintf('ALTER TABLE %s ADD %s',
$generator->quote($index->table->name),
join(q{}, @$constraints)
);
}
sub alter_drop_index {
my ($index, $options) = @_;
return 'DROP INDEX '. _generator($options)->quote($index->name);
}
sub alter_drop_constraint {
my ($c, $options) = @_;
my $generator = _generator($options);
# attention: Postgres has a very special naming structure for naming
# foreign keys and primary keys. It names them using the name of the
# table as prefix and fkey or pkey as suffix, concatenated by an underscore
my $c_name;
if( $c->name ) {
# Already has a name, just use it
$c_name = $c->name;
} elsif ( $c->type eq FOREIGN_KEY ) {
# Doesn't have a name, and is foreign key, append '_fkey'
$c_name = $c->table->name . '_' . ($c->fields)[0] . '_fkey';
} elsif ( $c->type eq PRIMARY_KEY ) {
# Doesn't have a name, and is primary key, append '_pkey'
$c_name = $c->table->name . '_pkey';
}
return sprintf(
'ALTER TABLE %s DROP CONSTRAINT %s',
map { $generator->quote($_) } $c->table->name, $c_name,
);
}
sub alter_create_constraint {
my ($index, $options) = @_;
my $generator = _generator($options);
my ($defs, $fks) = create_constraint(@_);
# return if there are no constraint definitions so we don't run
# into output like this:
# ALTER TABLE users ADD ;
return unless(@{$defs} || @{$fks});
return $index->type eq FOREIGN_KEY ? join(q{}, @{$fks})
: join( ' ', 'ALTER TABLE', $generator->quote($index->table->name),
'ADD', join(q{}, @{$defs}, @{$fks})
);
}
sub drop_table {
my ($table, $options) = @_;
my $generator = _generator($options);
my $out = "DROP TABLE " . $generator->quote($table) . " CASCADE";
my @geometry_drops = map { drop_geometry_column($_); } grep { is_geometry($_) } $table->get_fields;
$out .= join(";\n", '', @geometry_drops) if @geometry_drops;
return $out;
}
sub batch_alter_table {
my ( $table, $diff_hash, $options ) = @_;
# as long as we're not renaming the table we don't need to be here
if ( @{$diff_hash->{rename_table}} == 0 ) {
return batch_alter_table_statements($diff_hash, $options);
}
# first we need to perform drops which are on old table
my @sql = batch_alter_table_statements($diff_hash, $options, qw(
alter_drop_constraint
alter_drop_index
drop_field
));
# next comes the rename_table
my $old_table = $diff_hash->{rename_table}[0][0];
push @sql, rename_table( $old_table, $table, $options );
# for alter_field (and so also rename_field) we need to make sure old
# field has table name set to new table otherwise calling alter_field dies
$diff_hash->{alter_field} =
[map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
$diff_hash->{rename_field} =
[map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
# now add everything else
push @sql, batch_alter_table_statements($diff_hash, $options, qw(
add_field
alter_field
rename_field
alter_create_index
alter_create_constraint
alter_table
));
return @sql;
}
1;
# -------------------------------------------------------------------
# Life is full of misery, loneliness, and suffering --
# and it's all over much too soon.
# Woody Allen
# -------------------------------------------------------------------
=pod
=head1 SEE ALSO
SQL::Translator, SQL::Translator::Producer::Oracle.
=head1 AUTHOR
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/SQLite.pm 0000644 0001750 0001750 00000035320 12542755372 022622 0 ustar ilmari ilmari package SQL::Translator::Producer::SQLite;
=head1 NAME
SQL::Translator::Producer::SQLite - SQLite producer for SQL::Translator
=head1 SYNOPSIS
use SQL::Translator;
my $t = SQL::Translator->new( parser => '...', producer => 'SQLite' );
$t->translate;
=head1 DESCRIPTION
This module will produce text output of the schema suitable for SQLite.
=cut
use strict;
use warnings;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
use SQL::Translator::Generator::DDL::SQLite;
our ( $DEBUG, $WARN );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
$WARN = 0 unless defined $WARN;
our $max_id_length = 30;
my %global_names;
# HIDEOUS TEMPORARY DEFAULT WITHOUT QUOTING!
our $NO_QUOTES = 1;
{
my ($quoting_generator, $nonquoting_generator);
sub _generator {
$NO_QUOTES
? $nonquoting_generator ||= SQL::Translator::Generator::DDL::SQLite->new(quote_chars => [])
: $quoting_generator ||= SQL::Translator::Generator::DDL::SQLite->new
}
}
sub produce {
my $translator = shift;
local $DEBUG = $translator->debug;
local $WARN = $translator->show_warnings;
my $no_comments = $translator->no_comments;
my $add_drop_table = $translator->add_drop_table;
my $schema = $translator->schema;
my $producer_args = $translator->producer_args;
my $sqlite_version = parse_dbms_version(
$producer_args->{sqlite_version}, 'perl'
);
my $no_txn = $producer_args->{no_transaction};
debug("PKG: Beginning production\n");
%global_names = (); #reset
# only quote if quotes were requested for real
# 0E0 indicates "the default of true" was assumed
local $NO_QUOTES = 0
if $translator->quote_identifiers and $translator->quote_identifiers ne '0E0';
my $head = (header_comment() . "\n") unless $no_comments;
my @create = ();
push @create, "BEGIN TRANSACTION" unless $no_txn;
for my $table ( $schema->get_tables ) {
push @create, create_table($table, { no_comments => $no_comments,
sqlite_version => $sqlite_version,
add_drop_table => $add_drop_table,});
}
for my $view ( $schema->get_views ) {
push @create, create_view($view, {
add_drop_view => $add_drop_table,
no_comments => $no_comments,
});
}
for my $trigger ( $schema->get_triggers ) {
push @create, create_trigger($trigger, {
add_drop_trigger => $add_drop_table,
no_comments => $no_comments,
});
}
push @create, "COMMIT" unless $no_txn;
if (wantarray) {
return ($head||(), @create);
} else {
return join ('',
$head||(),
join(";\n\n", @create ),
";\n",
);
}
}
sub mk_name {
my ($name, $scope, $critical) = @_;
$scope ||= \%global_names;
if ( my $prev = $scope->{ $name } ) {
my $name_orig = $name;
$name .= sprintf( "%02d", ++$prev );
substr($name, $max_id_length - 3) = "00"
if length( $name ) > $max_id_length;
warn "The name '$name_orig' has been changed to ",
"'$name' to make it unique.\n" if $WARN;
$scope->{ $name_orig }++;
}
$scope->{ $name }++;
return _generator()->quote($name);
}
sub create_view {
my ($view, $options) = @_;
my $add_drop_view = $options->{add_drop_view};
my $view_name = _generator()->quote($view->name);
$global_names{$view->name} = 1;
debug("PKG: Looking at view '${view_name}'\n");
# Header. Should this look like what mysqldump produces?
my $extra = $view->extra;
my @create;
push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view;
my $create_view = 'CREATE';
$create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
$create_view .= ' VIEW';
$create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists};
$create_view .= " ${view_name}";
if( my $sql = $view->sql ){
$create_view .= " AS\n ${sql}";
}
push @create, $create_view;
# Tack the comment onto the first statement.
unless ($options->{no_comments}) {
$create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0];
}
return @create;
}
sub create_table
{
my ($table, $options) = @_;
my $table_name = _generator()->quote($table->name);
$global_names{$table->name} = 1;
my $no_comments = $options->{no_comments};
my $add_drop_table = $options->{add_drop_table};
my $sqlite_version = $options->{sqlite_version} || 0;
debug("PKG: Looking at table '$table_name'\n");
my ( @index_defs, @constraint_defs );
my @fields = $table->get_fields or die "No fields in $table_name";
my $temp = $options->{temporary_table} ? 'TEMPORARY ' : '';
#
# Header.
#
my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : '';
my @create;
my ($comment, $create_table) = "";
$comment = "--\n-- Table: $table_name\n--\n" unless $no_comments;
if ($add_drop_table) {
push @create, $comment . qq[DROP TABLE$exists $table_name];
} else {
$create_table = $comment;
}
$create_table .= "CREATE ${temp}TABLE $table_name (\n";
#
# Comments
#
if ( $table->comments and !$no_comments ){
$create_table .= "-- Comments: \n-- ";
$create_table .= join "\n-- ", $table->comments;
$create_table .= "\n--\n\n";
}
#
# How many fields in PK?
#
my $pk = $table->primary_key;
my @pk_fields = $pk ? $pk->fields : ();
#
# Fields
#
my ( @field_defs, $pk_set );
for my $field ( @fields ) {
push @field_defs, create_field($field);
}
if (
scalar @pk_fields > 1
||
( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs )
) {
push @field_defs, 'PRIMARY KEY (' . join(', ', map _generator()->quote($_), @pk_fields ) . ')';
}
#
# Indices
#
for my $index ( $table->get_indices ) {
push @index_defs, create_index($index);
}
#
# Constraints
#
for my $c ( $table->get_constraints ) {
if ($c->type eq "FOREIGN KEY") {
push @field_defs, create_foreignkey($c);
}
elsif ($c->type eq "CHECK") {
push @field_defs, create_check_constraint($c);
}
next unless $c->type eq UNIQUE;
push @constraint_defs, create_constraint($c);
}
$create_table .= join(",\n", map { " $_" } @field_defs ) . "\n)";
return (@create, $create_table, @index_defs, @constraint_defs );
}
sub create_check_constraint {
my $c = shift;
my $check = '';
$check .= 'CONSTRAINT ' . _generator->quote( $c->name ) . ' ' if $c->name;
$check .= 'CHECK(' . $c->expression . ')';
return $check;
}
sub create_foreignkey {
my $c = shift;
my @fields = $c->fields;
my @rfields = map { $_ || () } $c->reference_fields;
unless ( @rfields ) {
my $rtable_name = $c->reference_table;
if ( my $ref_table = $c->schema->get_table( $rtable_name ) ) {
push @rfields, $ref_table->primary_key;
die "FK constraint on " . $rtable_name . '.' . join('', @fields) . " has no reference fields\n"
unless @rfields;
}
else {
die "Can't find reference table '$rtable_name' in schema\n";
}
}
my $fk_sql = sprintf 'FOREIGN KEY (%s) REFERENCES %s(%s)',
join (', ', map { _generator()->quote($_) } @fields ),
_generator()->quote($c->reference_table),
join (', ', map { _generator()->quote($_) } @rfields )
;
$fk_sql .= " ON DELETE " . $c->{on_delete} if $c->{on_delete};
$fk_sql .= " ON UPDATE " . $c->{on_update} if $c->{on_update};
return $fk_sql;
}
sub create_field { return _generator()->field($_[0]) }
sub create_index
{
my ($index, $options) = @_;
(my $index_table_name = $index->table->name) =~ s/^.+?\.//; # table name may not specify schema
my $name = mk_name($index->name || "${index_table_name}_idx");
my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : '';
# strip any field size qualifiers as SQLite doesn't like these
my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->fields;
$index_table_name = _generator()->quote($index_table_name);
warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN;
my $index_def =
"CREATE ${type}INDEX $name ON " . $index_table_name .
' (' . join( ', ', @fields ) . ')';
return $index_def;
}
sub create_constraint
{
my ($c, $options) = @_;
(my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema
my $name = mk_name($c->name || "${index_table_name}_idx");
my @fields = map _generator()->quote($_), $c->fields;
$index_table_name = _generator()->quote($index_table_name);
warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN;
my $c_def =
"CREATE UNIQUE INDEX $name ON " . $index_table_name .
' (' . join( ', ', @fields ) . ')';
return $c_def;
}
sub create_trigger {
my ($trigger, $options) = @_;
my $add_drop = $options->{add_drop_trigger};
my @statements;
my $trigger_name = $trigger->name;
$global_names{$trigger_name} = 1;
my $events = $trigger->database_events;
for my $evt ( @$events ) {
my $trig_name = $trigger_name;
if (@$events > 1) {
$trig_name .= "_$evt";
warn "Multiple database events supplied for trigger '$trigger_name', ",
"creating trigger '$trig_name' for the '$evt' event.\n" if $WARN;
}
$trig_name = _generator()->quote($trig_name);
push @statements, "DROP TRIGGER IF EXISTS $trig_name" if $add_drop;
$DB::single = 1;
my $action = "";
if (not ref $trigger->action) {
$action = $trigger->action;
$action = "BEGIN " . $action . " END"
unless $action =~ /^ \s* BEGIN [\s\;] .*? [\s\;] END [\s\;]* $/six;
}
else {
$action = $trigger->action->{for_each} . " "
if $trigger->action->{for_each};
$action = $trigger->action->{when} . " "
if $trigger->action->{when};
my $steps = $trigger->action->{steps} || [];
$action .= "BEGIN ";
$action .= $_ . "; " for (@$steps);
$action .= "END";
}
push @statements, sprintf (
'CREATE TRIGGER %s %s %s on %s %s',
$trig_name,
$trigger->perform_action_when,
$evt,
_generator()->quote($trigger->on_table),
$action
);
}
return @statements;
}
sub alter_table { () } # Noop
sub add_field {
my ($field) = @_;
return sprintf("ALTER TABLE %s ADD COLUMN %s",
_generator()->quote($field->table->name), create_field($field))
}
sub alter_create_index {
my ($index) = @_;
# This might cause name collisions
return create_index($index);
}
sub alter_create_constraint {
my ($constraint) = @_;
return create_constraint($constraint) if $constraint->type eq 'UNIQUE';
}
sub alter_drop_constraint { alter_drop_index(@_) }
sub alter_drop_index {
my ($constraint) = @_;
return sprintf("DROP INDEX %s",
_generator()->quote($constraint->name));
}
sub batch_alter_table {
my ($table, $diffs, $options) = @_;
# If we have any of the following
#
# rename_field
# alter_field
# drop_field
#
# we need to do the following
#
# BEGIN TRANSACTION;
# CREATE TEMPORARY TABLE t1_backup(a,b);
# INSERT INTO t1_backup SELECT a,b FROM t1;
# DROP TABLE t1;
# CREATE TABLE t1(a,b);
# INSERT INTO t1 SELECT a,b FROM t1_backup;
# DROP TABLE t1_backup;
# COMMIT;
#
# Fun, eh?
#
# If we have rename_field we do similarly.
#
# We create the temporary table as a copy of the new table, copy all data
# to temp table, create new table and then copy as appropriate taking note
# of renamed fields.
my $table_name = $table->name;
if ( @{$diffs->{rename_field}} == 0 &&
@{$diffs->{alter_field}} == 0 &&
@{$diffs->{drop_field}} == 0
) {
return batch_alter_table_statements($diffs, $options);
}
my @sql;
# $table is the new table but we may need an old one
# TODO: this is NOT very well tested at the moment so add more tests
my $old_table = $table;
if ( $diffs->{rename_table} && @{$diffs->{rename_table}} ) {
$old_table = $diffs->{rename_table}[0][0];
}
my $temp_table_name = $table_name . '_temp_alter';
# CREATE TEMPORARY TABLE t1_backup(a,b);
my %temp_table_fields;
do {
local $table->{name} = $temp_table_name;
# We only want the table - don't care about indexes on tmp table
my ($table_sql) = create_table($table, {no_comments => 1, temporary_table => 1});
push @sql,$table_sql;
%temp_table_fields = map { $_ => 1} $table->get_fields;
};
# record renamed fields for later
my %rename_field = map { $_->[1]->name => $_->[0]->name } @{$diffs->{rename_field}};
# drop added fields from %temp_table_fields
delete @temp_table_fields{@{$diffs->{add_field}}};
# INSERT INTO t1_backup SELECT a,b FROM t1;
push @sql, sprintf( 'INSERT INTO %s( %s) SELECT %s FROM %s',
_generator()->quote( $temp_table_name ),
join( ', ',
map _generator()->quote($_),
grep { $temp_table_fields{$_} } $table->get_fields ),
join( ', ',
map _generator()->quote($_),
map { $rename_field{$_} ? $rename_field{$_} : $_ }
grep { $temp_table_fields{$_} } $table->get_fields ),
_generator()->quote( $old_table->name )
);
# DROP TABLE t1;
push @sql, sprintf('DROP TABLE %s', _generator()->quote($old_table->name));
# CREATE TABLE t1(a,b);
push @sql, create_table($table, { no_comments => 1 });
# INSERT INTO t1 SELECT a,b FROM t1_backup;
push @sql, sprintf('INSERT INTO %s SELECT %s FROM %s',
_generator()->quote($table_name),
join(', ', map _generator()->quote($_), $table->get_fields),
_generator()->quote($temp_table_name)
);
# DROP TABLE t1_backup;
push @sql, sprintf('DROP TABLE %s', _generator()->quote($temp_table_name));
return wantarray ? @sql : join(";\n", @sql);
}
sub drop_table {
my ($table) = @_;
$table = _generator()->quote($table);
return "DROP TABLE $table";
}
sub rename_table {
my ($old_table, $new_table, $options) = @_;
$old_table = _generator()->quote($old_table);
$new_table = _generator()->quote($new_table);
return "ALTER TABLE $old_table RENAME TO $new_table";
}
# No-op. Just here to signify that we are a new style parser.
sub preproces_schema { }
1;
=pod
=head1 SEE ALSO
SQL::Translator, http://www.sqlite.org/.
=head1 AUTHOR
Ken Youens-Clark C<< >>.
Diff code added by Ash Berlin C<< >>.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/YAML.pm 0000644 0001750 0001750 00000013713 13070420670 022210 0 ustar ilmari ilmari package SQL::Translator::Producer::YAML;
=head1 NAME
SQL::Translator::Producer::YAML - A YAML producer for SQL::Translator
=head1 SYNOPSIS
use SQL::Translator;
my $translator = SQL::Translator->new(producer => 'YAML');
=head1 DESCRIPTION
This module uses YAML to serialize a schema to a string so that it
can be saved to disk. Serializing a schema and then calling producers
on the stored can realize significant performance gains when parsing
takes a long time.
=cut
use strict;
use warnings;
our $VERSION = '1.59';
use YAML qw(Dump);
sub produce {
my $translator = shift;
my $schema = $translator->schema;
return Dump({
schema => {
tables => {
map { ($_->name => view_table($_)) }
$schema->get_tables,
},
views => {
map { ($_->name => view_view($_)) }
$schema->get_views,
},
triggers => {
map { ($_->name => view_trigger($_)) }
$schema->get_triggers,
},
procedures => {
map { ($_->name => view_procedure($_)) }
$schema->get_procedures,
},
},
translator => {
add_drop_table => $translator->add_drop_table,
filename => $translator->filename,
no_comments => $translator->no_comments,
parser_args => $translator->parser_args,
producer_args => $translator->producer_args,
parser_type => $translator->parser_type,
producer_type => $translator->producer_type,
show_warnings => $translator->show_warnings,
trace => $translator->trace,
version => $translator->version,
},
keys %{$schema->extra} ? ('extra' => { $schema->extra } ) : (),
});
}
sub view_table {
my $table = shift;
return {
'name' => $table->name,
'order' => $table->order,
'options' => $table->options || [],
$table->comments ? ('comments' => [ $table->comments ] ) : (),
'constraints' => [
map { view_constraint($_) } $table->get_constraints
],
'indices' => [
map { view_index($_) } $table->get_indices
],
'fields' => {
map { ($_->name => view_field($_)) }
$table->get_fields
},
keys %{$table->extra} ? ('extra' => { $table->extra } ) : (),
};
}
sub view_constraint {
my $constraint = shift;
return {
'deferrable' => scalar $constraint->deferrable,
'expression' => scalar $constraint->expression,
'fields' => [ map { ref $_ ? $_->name : $_ } $constraint->field_names ],
'match_type' => scalar $constraint->match_type,
'name' => scalar $constraint->name,
'options' => scalar $constraint->options,
'on_delete' => scalar $constraint->on_delete,
'on_update' => scalar $constraint->on_update,
'reference_fields' => [ map { ref $_ ? $_->name : $_ } $constraint->reference_fields ],
'reference_table' => scalar $constraint->reference_table,
'type' => scalar $constraint->type,
keys %{$constraint->extra} ? ('extra' => { $constraint->extra } ) : (),
};
}
sub view_field {
my $field = shift;
return {
'order' => scalar $field->order,
'name' => scalar $field->name,
'data_type' => scalar $field->data_type,
'size' => [ $field->size ],
'default_value' => scalar $field->default_value,
'is_nullable' => scalar $field->is_nullable,
'is_primary_key' => scalar $field->is_primary_key,
'is_unique' => scalar $field->is_unique,
$field->is_auto_increment ? ('is_auto_increment' => 1) : (),
$field->comments ? ('comments' => [ $field->comments ]) : (),
keys %{$field->extra} ? ('extra' => { $field->extra } ) : (),
};
}
sub view_procedure {
my $procedure = shift;
return {
'order' => scalar $procedure->order,
'name' => scalar $procedure->name,
'sql' => scalar $procedure->sql,
'parameters' => scalar $procedure->parameters,
'owner' => scalar $procedure->owner,
'comments' => scalar $procedure->comments,
keys %{$procedure->extra} ? ('extra' => { $procedure->extra } ) : (),
};
}
sub view_trigger {
my $trigger = shift;
return {
'order' => scalar $trigger->order,
'name' => scalar $trigger->name,
'perform_action_when' => scalar $trigger->perform_action_when,
'database_events' => scalar $trigger->database_events,
'fields' => scalar $trigger->fields,
'on_table' => scalar $trigger->on_table,
'action' => scalar $trigger->action,
(defined $trigger->scope ? (
'scope' => scalar $trigger->scope,
) : ()),
keys %{$trigger->extra} ? ('extra' => { $trigger->extra } ) : (),
};
}
sub view_view {
my $view = shift;
return {
'order' => scalar $view->order,
'name' => scalar $view->name,
'sql' => scalar $view->sql,
'fields' => scalar $view->fields,
keys %{$view->extra} ? ('extra' => { $view->extra } ) : (),
};
}
sub view_index {
my $index = shift;
return {
'name' => scalar $index->name,
'type' => scalar $index->type,
'fields' => scalar $index->fields,
'options' => scalar $index->options,
keys %{$index->extra} ? ('extra' => { $index->extra } ) : (),
};
}
1;
=head1 SEE ALSO
SQL::Translator, YAML, http://www.yaml.org/.
=head1 AUTHORS
darren chamberlain Edarren@cpan.orgE,
Ken Youens-Clark Ekclark@cpan.orgE.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/DiaUml.pm 0000644 0001750 0001750 00000003011 12542755372 022624 0 ustar ilmari ilmari package SQL::Translator::Producer::DiaUml;
=pod
=head1 NAME
SQL::Translator::Producer::DiaUml -
Produces dia UML diagrams from schema.
=head1 SYNOPSIS
use SQL::Translator;
my $translator = SQL::Translator->new(
from => 'MySQL',
filename => 'foo_schema.sql',
to => 'DiaUml',
);
print $translator->translate;
=head1 DESCRIPTION
Currently you will get one class (with the a table
stereotype) generated per table in the schema. The fields are added as
attributes of the classes and their datatypes set. It doesn't currently set any
of the relationships. It doesn't do any layout, all the classes are in one big
stack. However it is still useful as you can use the layout tools in Dia to
automatically arrange them horizontally or vertically.
=head2 Producer Args
=cut
use strict;
use warnings;
our ( $DEBUG, @EXPORT_OK );
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use File::ShareDir qw/dist_dir/;
use SQL::Translator::Utils 'debug';
use base qw/SQL::Translator::Producer::TT::Base/;
# Convert produce call into a method call on our class
sub produce { return __PACKAGE__->new( translator => shift )->run; };
sub tt_config {
( INCLUDE_PATH => File::Spec->catdir (dist_dir('SQL-Translator'), 'DiaUml') );
}
sub tt_schema { 'schema.tt2' }
1;
=pod
=head1 AUTHOR
Mark Addison Egrommit@users.sourceforge.netE.
=head1 TODO
* Add the foreign keys from the schema as UML relations.
* Layout the classes.
=head1 SEE ALSO
SQL::Translator.
=cut
SQL-Translator-0.11024/lib/SQL/Translator/Producer/ClassDBI.pm 0000644 0001750 0001750 00000033664 12221056401 023033 0 ustar ilmari ilmari package SQL::Translator::Producer::ClassDBI;
use strict;
use warnings;
our $DEBUG;
our $VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment);
use Data::Dumper;
my %CDBI_auto_pkgs = (
MySQL => 'mysql',
PostgreSQL => 'Pg',
Oracle => 'Oracle',
);
sub produce {
my $t = shift;
local $DEBUG = $t->debug;
my $no_comments = $t->no_comments;
my $schema = $t->schema;
my $args = $t->producer_args;
my @create;
if ( my $fmt = $args->{'format_pkg_name'} ) {
$t->format_package_name( $fmt );
}
if ( my $fmt = $args->{'format_fk_name'} ) {
$t->format_fk_name( $fmt );
}
my $db_user = $args->{'db_user'} || '';
my $db_pass = $args->{'db_password'} || '';
my $main_pkg_name = $args->{'package_name'} ||
# $args->{'main_pkg_name'} || # keep this? undocumented
$t->format_package_name('DBI');
my $header = header_comment( __PACKAGE__, "# " );
my $parser_type = ( split /::/, $t->parser_type )[-1];
my $from = $CDBI_auto_pkgs{$parser_type} || '';
my $dsn = $args->{'dsn'} || sprintf( 'dbi:%s:_',
$CDBI_auto_pkgs{ $parser_type }
? $CDBI_auto_pkgs{ $parser_type } : $parser_type
);
my $sep = '# ' . '-' x 67;
#
# Identify "link tables" (have only PK and FK fields).
#
my %linkable;
my %linktable;
for my $table ( $schema->get_tables ) {
debug("PKG: Table = ", $table->name, "\n");
my $is_link = 1;
for my $field ( $table->get_fields ) {
unless ( $field->is_primary_key or $field->is_foreign_key ) {
$is_link = 0;
last;
}
}
next unless $is_link;
foreach my $left ( $table->get_fields ) {
next unless $left->is_foreign_key;
my $lfk = $left->foreign_key_reference or next;
my $lr_table = $schema->get_table( $lfk->reference_table )
or next;
my $lr_field_name = ( $lfk->reference_fields )[0];
my $lr_field = $lr_table->get_field($lr_field_name);
next unless $lr_field->is_primary_key;
foreach my $right ( $table->get_fields ) {
next if $left->name eq $right->name;
my $rfk = $right->foreign_key_reference or next;
my $rr_table = $schema->get_table( $rfk->reference_table )
or next;
my $rr_field_name = ( $rfk->reference_fields )[0];
my $rr_field = $rr_table->get_field($rr_field_name);
next unless $rr_field->is_primary_key;
$linkable{ $lr_table->name }{ $rr_table->name } = $table;
$linkable{ $rr_table->name }{ $lr_table->name } = $table;
$linktable{ $table->name } = $table;
}
}
}
#
# Iterate over all tables
#
my ( %packages, $order );
for my $table ( $schema->get_tables ) {
my $table_name = $table->name or next;
my $table_pkg_name = join '::', $main_pkg_name, $t->format_package_name($table_name);
$packages{ $table_pkg_name } = {
order => ++$order,
pkg_name => $table_pkg_name,
base => $main_pkg_name,
table => $table_name,
};
#
# Primary key may have a different accessor method name
#
# if ( my $constraint = $table->primary_key ) {
# my $field = ( $constraint->fields )[0];
# $packages{ $table_pkg_name }{'_columns_primary'} = $field;
#
# if ( my $pk_xform = $t->format_pk_name ) {
# my $pk_name = $pk_xform->( $table_pkg_name, $field );
#
# $packages{$table_pkg_name}{'pk_accessor'} =
# "#\n# Primary key accessor\n#\n"
# . "sub $pk_name {\n shift->$field\n}\n\n";
# }
# }
my $is_data = 0;
foreach my $field ( $table->get_fields ) {
if ( !$field->is_foreign_key and !$field->is_primary_key ) {
push @{ $packages{$table_pkg_name}{'_columns_essential'} },
$field->name;
$is_data++;
}
elsif ( !$field->is_primary_key ) {
push @{ $packages{$table_pkg_name}{'_columns_others'} },
$field->name;
}
}
my %linked;
if ($is_data) {
foreach my $link ( keys %{ $linkable{$table_name} } ) {
my $linkmethodname;
if ( my $fk_xform = $t->format_fk_name ) {
# ADD CALLBACK FOR PLURALIZATION MANGLING HERE
$linkmethodname = $fk_xform->(
$linkable{ $table_name }{ $link }->name,
( $schema->get_table( $link )->primary_key->fields )[0]
)
. 's';
}
else {
# ADD CALLBACK FOR PLURALIZATION MANGLING HERE
$linkmethodname =
$linkable{ $table_name }{ $link }->name . '_'
. ( $schema->get_table( $link )->primary_key->fields )[0]
. 's';
}
my @rk_fields = ();
my @lk_fields = ();
foreach my $field ( $linkable{$table_name}{$link}->get_fields )
{
next unless $field->is_foreign_key;
next unless (
$field->foreign_key_reference->reference_table eq
$table_name
||
$field->foreign_key_reference->reference_table eq $link
);
push @lk_fields,
( $field->foreign_key_reference->reference_fields )[0]
if $field->foreign_key_reference->reference_table eq
$link;
push @rk_fields, $field->name
if $field->foreign_key_reference->reference_table eq
$table_name;
}
#
# If one possible traversal via link table.
#
if ( scalar(@rk_fields) == 1 and scalar(@lk_fields) == 1 ) {
foreach my $rk_field (@rk_fields) {
push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
"sub "
. $linkmethodname
. " { my \$self = shift; "
. "return map \$_->"
. ( $schema->get_table($link)->primary_key->fields )
[0]
. ", \$self->"
. $linkable{$table_name}{$link}->name . "_"
. $rk_field
. " }\n\n";
}
#
# Else there is more than one way to traverse it.
# ack! Let's treat these types of link tables as
# a many-to-one (easier)
#
# NOTE: we need to rethink the link method name,
# as the cardinality has shifted on us.
#
}
elsif ( scalar(@rk_fields) == 1 ) {
foreach my $rk_field (@rk_fields) {
#
# ADD CALLBACK FOR PLURALIZATION MANGLING HERE
#
push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
"sub "
. $linkable{$table_name}{$link}->name
. "s { my \$self = shift; return \$self->"
. $linkable{$table_name}{$link}->name . "_"
. $rk_field
. "(\@_) }\n\n";
}
}
elsif ( scalar(@lk_fields) == 1 ) {
#
# These will be taken care of on the other end...
#
}
else {
#
# Many many many. Need multiple iterations here,
# data structure revision to handle N FK sources.
# This code has not been tested and likely doesn't
# work here.
#
foreach my $rk_field (@rk_fields) {
# ADD CALLBACK FOR PLURALIZATION MANGLING HERE
push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
"sub "
. $linkable{$table_name}{$link}->name . "_"
. $rk_field
. "s { my \$self = shift; return \$self->"
. $linkable{$table_name}{$link}->name . "_"
. $rk_field
. "(\@_) }\n\n";
}
}
}
}
#
# Use foreign keys to set up "has_a/has_many" relationships.
#
foreach my $field ( $table->get_fields ) {
if ( $field->is_foreign_key ) {
my $table_name = $table->name;
my $field_name = $field->name;
# my $fk_method = $t->format_fk_name( $table_name, $field_name );
my $fk_method = join('::', $table_pkg_name,
$t->format_fk_name( $table_name, $field_name )
);
my $fk = $field->foreign_key_reference;
my $ref_table = $fk->reference_table;
my $ref_pkg = $t->format_package_name($ref_table);
my $ref_field = ( $fk->reference_fields )[0];
# my $fk_method = join('::',
# $table_pkg_name, $t->format_fk_name( $ref_table )
# );
push @{ $packages{$table_pkg_name}{'has_a'} },
"$table_pkg_name->has_a(\n"
. " $field_name => '$ref_pkg'\n);\n\n"
. "sub $fk_method {\n"
. " return shift->$field_name\n}\n\n"
;
# if there weren't M-M relationships via the has_many
# being set up here, create nice pluralized method alias
# rather for user as alt. to ugly tablename_fieldname name
#
# if ( !$packages{$ref_pkg}{'has_many'}{$table_name} ) {
# #
# # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
# #
# push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
# "sub ${table_name}s {\n " .
# "return shift->$table_name\_$field_name\n}\n\n";
# # else ugly
# }
# else {
# }
push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
"$ref_pkg->has_many(\n '${table_name}_${field_name}', "
. "'$table_pkg_name' => '$field_name'\n);\n\n";
}
}
}
#
# Now build up text of package.
#
my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
push @create, join ( "\n",
"package $main_pkg_name;\n",
$header,
"use strict;",
"use base '$base_pkg';\n",
"$main_pkg_name->set_db('Main', '$dsn', '$db_user', '$db_pass');\n\n",
);
for my $pkg_name (
sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} }
keys %packages
) {
my $pkg = $packages{$pkg_name} or next;
next unless $pkg->{'pkg_name'};
push @create, join ( "\n",
$sep,
"package " . $pkg->{'pkg_name'} . ";",
"use base '" . $pkg->{'base'} . "';",
"use Class::DBI::Pager;\n\n",
);
if ( $from ) {
push @create, join('',
$pkg->{'pkg_name'},
"->set_up_table('",
$pkg->{'table'},
"');\n\n"
);
}
else {
my $table = $schema->get_table( $pkg->{'table'} );
my @field_names = map { $_->name } $table->get_fields;
push @create, join("\n",
$pkg_name."->table('".$pkg->{'table'}."');\n",
$pkg_name."->columns(All => qw/".
join(' ', @field_names)."/);\n\n",
);
}
push @create, "\n";
if ( my $pk = $pkg->{'pk_accessor'} ) {
push @create, $pk;
}
if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) {
push @create, $_ for @has_a;
}
foreach my $has_many_key ( keys %{ $pkg->{'has_many'} } ) {
if ( my @has_many = @{ $pkg->{'has_many'}{$has_many_key} || [] } ) {
push @create, $_ for @has_many;
}
}
}
push @create, "1;\n";
return wantarray
? @create
: join('', @create);
}
1;
=pod
=head1 NAME
SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema
=head1 SYNOPSIS
Use this producer as you would any other from SQL::Translator. See
L for details.
This package uses SQL::Translator's formatting methods
format_package_name(), format_pk_name(), format_fk_name(), and
format_table_name() as it creates classes, one per table in the schema
provided. An additional base class is also created for database connectivity
configuration. See L for details on how this works.
=head1 AUTHORS
Allen Day Eallenday@ucla.eduE,
Ying Zhang Ezyolive@yahoo.comE,
Ken Youens-Clark Ekclark@cpan.orgE.
SQL-Translator-0.11024/lib/SQL/Translator/Producer/Diagram.pm 0000644 0001750 0001750 00000047751 12542755372 023040 0 ustar ilmari ilmari package SQL::Translator::Producer::Diagram;
=head1 NAME
SQL::Translator::Producer::Diagram - ER diagram producer for SQL::Translator
=head1 SYNOPSIS
Use via SQL::Translator:
use SQL::Translator;
my $t = SQL::Translator->new(
from => 'MySQL',
to => 'Diagram',
producer_args => {
# All args are optional
out_file => 'schema.png',# if not provided will return from translate()
output_type => 'png', # is default or 'jpeg'
title => 'My Schema', # default is filename
font_size => 'medium', # is default or 'small,' 'large'
imap_file => '', # filename to write image map coords
imap_url => '', # base URL for image map
gutter => 30 # is default, px distance b/w cols
num_columns => 5, # the number of columns
no_lines => 1, # do not draw lines to show FKs
add_color => 1, # give it some color
show_fk_only => 1, # show only fields used in FKs
join_pk_only => 1, # use only primary keys to figure PKs
natural_join => 1, # intuit FKs if not defined
skip_fields => [...], # list* of field names to exclude
skip_tables => [...], # list* of table names to exclude
skip_tables_like => [...], # list* of regexen to exclude tables
}
) or die SQL::Translator->error;
$t->translate;
* "list" can be either an array-ref or a comma-separated string
=cut
use strict;
use warnings;
use GD;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug);
our $DEBUG;
our $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use constant VALID_FONT_SIZE => {
small => 1,
medium => 1,
large => 1,
huge => 1,
};
use constant VALID_IMAGE_TYPE => {
png => 1,
jpeg => 1,
};
sub produce {
my $t = shift;
my $schema = $t->schema;
my $args = $t->producer_args;
local $DEBUG = $t->debug;
debug("Schema =\n", Dumper( $schema )) if $DEBUG;
debug("Producer args =\n", Dumper( $args )) if $DEBUG;
my $out_file = $args->{'out_file'} || '';
my $output_type = $args->{'output_type'} || 'png';
my $title = $args->{'title'} || $t->filename;
my $font_size = $args->{'font_size'} || 'medium';
my $imap_file = $args->{'imap_file'} || '';
my $imap_url = $args->{'imap_url'} || '';
my $gutter = $args->{'gutter'} || 30; # distance b/w columns
my $num_columns = $args->{'num_columns'} || $args->{'no_columns'} || '';
my $no_lines = $args->{'no_lines'};
my $add_color = $args->{'add_color'};
my $show_fk_only = $args->{'show_fk_only'};
my $join_pk_only = $args->{'join_pk_only'};
my $natural_join = $args->{'natural_join'} || $join_pk_only;
my %skip_field = map { $_, 1 } (
ref $args->{'skip_fields'} eq 'ARRAY'
? @{ $args->{'skip_fields'} }
: split ( /\s*,\s*/, $args->{'skip_fields'}||'' )
);
my %skip_table = map { $_, 1 } (
ref $args->{'skip_tables'} eq 'ARRAY'
? @{ $args->{'skip_tables'} }
: split ( /\s*,\s*/, $args->{'skip_tables'}||'' )
);
my @skip_tables_like = map { qr/$_/ } (
ref $args->{'skip_tables_like'} eq 'ARRAY'
? @{ $args->{'skip_tables_like'} }
: split ( /\s*,\s*/, $args->{'skip_tables_like'}||'' )
);
my @table_names;
if ( $natural_join ) {
$schema->make_natural_joins(
join_pk_only => $join_pk_only,
skip_fields => $args->{'skip_fields'},
);
my $g = $schema->as_graph_pm;
my $d = Graph::Traversal::DFS->new( $g, next_alphabetic => 1 );
$d->preorder;
@table_names = $d->dfs;
}
else {
@table_names = map { $_->name } $schema->get_tables;
}
die "Invalid image type '$output_type'"
unless VALID_IMAGE_TYPE->{ $output_type };
die "Invalid font size '$font_size'"
unless VALID_FONT_SIZE->{ $font_size };
#
# Layout the image.
#
my $font
= $font_size eq 'small' ? gdTinyFont
: $font_size eq 'medium' ? gdSmallFont
: $font_size eq 'large' ? gdLargeFont
: gdGiantFont;
my $num_tables = scalar @table_names;
$num_columns = 0 unless $num_columns =~ /^\d+$/;
$num_columns ||= sprintf( "%.0f", sqrt( $num_tables ) + .5 );
$num_columns ||= .5;
my $no_per_col = sprintf( "%.0f", $num_tables/$num_columns + .5 );
my @shapes;
my ( $max_x, $max_y ); # the furthest x and y used
my $orig_y = 40; # used to reset y for each column
my ( $x, $y ) = (30,$orig_y); # where to start
my $cur_col = 1; # the current column
my $no_this_col = 0; # number of tables in current column
my $this_col_x = $x; # current column's x
my %nj_registry; # for locations of fields for natural joins
my @fk_registry; # for locations of fields for foreign keys
my %table_x; # for max x of each table
my $field_no; # counter to give distinct no. to each field
my %coords; # holds fields coordinates
my @imap_coords; # for making clickable image map
my %legend;
TABLE:
for my $table_name ( @table_names ) {
my $table = $schema->get_table( $table_name );
if ( @skip_tables_like or keys %skip_table ) {
next TABLE if $skip_table{ $table_name };
for my $regex ( @skip_tables_like ) {
next TABLE if $table_name =~ $regex;
}
}
my $top = $y;
push @shapes,
[ 'string', $font, $this_col_x, $y, $table_name, 'black' ];
$y += $font->height + 2;
my $below_table_name = $y;
$y += 2;
my $this_max_x =
$this_col_x + ($font->width * length($table_name));
debug("Processing table '$table_name'");
my @fields = $table->get_fields;
debug("Fields = ", join(', ', map { $_->name } @fields)) if $DEBUG;
my ( @fld_desc, $max_name, $max_desc );
for my $f ( @fields ) {
my $name = $f->name or next;
my $is_pk = $f->is_primary_key;
my @attr;
#
# Decide if we should skip this field.
#
if ( $show_fk_only ) {
next unless $is_pk || $f->is_foreign_key;
}
if ( $is_pk ) {
push @attr, 'PK';
$legend{'Primary key'} = '[PK]';
}
if ( $f->is_unique ) {
push @attr, 'U';
$legend{'Unique constraint'} = '[U]';
}
if ( $f->is_foreign_key ) {
push @attr, 'FK';
$legend{'Foreign Key'} = '[FK]';
}
my $attr = '';
if ( @attr ) {
$attr .= '[' . join(', ', @attr) . ']';
}
my $desc = $f->data_type;
$desc .= '('.$f->size.')' if $f->size &&
$f->data_type =~ /^(VAR)?CHAR2?$/i;
my $nlen = length $name;
my $dlen = length $desc;
$max_name = $nlen if $nlen > ($max_name||0);
$max_desc = $dlen if $dlen > ($max_desc||0);
push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk, $attr ];
}
$max_name += 2;
$max_desc += 2;
for my $fld_desc ( @fld_desc ) {
my ( $name, $desc, $orig_name, $is_pk, $attr ) = @$fld_desc;
my $diff1 = $max_name - length $name;
my $diff2 = $max_desc - length $desc;
$name .= ' ' x $diff1;
$desc .= ' ' x $diff2;
$desc = $name . $desc . $attr;
push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ];
$y += $font->height + 2;
my $length = $this_col_x + ( $font->width * length( $desc ) );
$this_max_x = $length if $length > $this_max_x;
my $constraints = $table->{'fields'}{ $orig_name }{'constraints'};
if ( $natural_join && !$skip_field{ $orig_name } ) {
push @{ $nj_registry{ $orig_name } }, $table_name;
}
my $y_link = $y - $font->height/2;
$coords{ $table_name }{ $orig_name }{'coords'} = {
left => [ $this_col_x - 6, $y_link ],
right => [ $length + 2 , $y_link ],
table => $table_name,
field_no => ++$field_no,
is_pk => $is_pk,
fld_name => $orig_name,
};
push @imap_coords, [
$imap_url."#$table_name-$orig_name",
$this_col_x, $y - $font->height, $length, $y_link,
];
}
unless ( $natural_join ) {
for my $c ( $table->get_constraints ) {
next unless $c->type eq FOREIGN_KEY;
my $fk_table = $c->reference_table or next;
for my $field_name ( $c->fields ) {
for my $fk_field ( $c->reference_fields ) {
next unless defined $schema->get_table( $fk_table );
push @fk_registry, [
[ $fk_table , $fk_field ],
[ $table_name, $field_name ],
];
}
}
}
}
$this_max_x += 5;
$table_x{ $table_name } = $this_max_x + 5;
push @shapes, [ 'line', $this_col_x - 5, $below_table_name,
$this_max_x, $below_table_name, 'black' ];
my @bounds = ( $this_col_x - 5, $top - 5, $this_max_x, $y + 5 );
if ( $add_color ) {
unshift @shapes, [
'filledRectangle',
$bounds[0], $bounds[1],
$this_max_x, $below_table_name,
'khaki'
];
unshift @shapes, [ 'filledRectangle', @bounds, 'white' ];
}
push @imap_coords, [
$imap_url."#$table_name",
$bounds[0], $bounds[1], $this_max_x, $below_table_name,
];
push @shapes, [ 'rectangle', @bounds, 'black' ];
$max_x = $this_max_x if $this_max_x > ($max_x||0);
$y += 25;
if ( ++$no_this_col == $no_per_col ) {# if we've filled up this column
$cur_col++; # up the column number
$no_this_col = 0; # reset the number of tables
$max_x += $gutter; # push the x over for next column
$this_col_x = $max_x; # remember the max x for this col
$max_y = $y if $y > ($max_y||0); # note the max y
$y = $orig_y; # reset the y for next column
}
}
#
# Connect the lines.
#
my %horz_taken;
my %done;
unless ( $no_lines ) {
my @position_bunches;
if ( $natural_join ) {
for my $field_name ( keys %nj_registry ) {
my @positions;
my @table_names =
@{ $nj_registry{ $field_name } || [] } or next;
next if scalar @table_names == 1;
for my $table_name ( @table_names ) {
push @positions,
$coords{ $table_name }{ $field_name }{'coords'};
}
push @position_bunches, [ @positions ];
}
}
else {
for my $pair ( @fk_registry ) {
push @position_bunches, [
$coords{$pair->[0][0]}{ $pair->[0][1] }{'coords'},
$coords{$pair->[1][0]}{ $pair->[1][1] }{'coords'},
];
}
}
my $is_directed = $natural_join ? 0 : 1;
for my $bunch ( @position_bunches ) {
my @positions = @$bunch;
for my $i ( 0 .. $#positions ) {
my $pos1 = $positions[ $i ];
my ( $ax, $ay ) = @{ $pos1->{'left'} || [] } or next;
my ( $bx, $by ) = @{ $pos1->{'right'} || [] } or next;
my $table1 = $pos1->{'table'};
my $fno1 = $pos1->{'field_no'};
my $is_pk = $pos1->{'is_pk'};
next if $join_pk_only and !$is_pk;
for my $j ( 0 .. $#positions ) {
my $pos2 = $positions[ $j ];
my ( $cx, $cy ) = @{ $pos2->{'left'} || [] } or next;
my ( $dx, $dy ) = @{ $pos2->{'right'} || [] } or next;
my $table2 = $pos2->{'table'};
my $fno2 = $pos2->{'field_no'};
next if $table1 eq $table2;
next if $done{ $fno1 }{ $fno2 };
next if $fno1 == $fno2;
my @distances = ();
push @distances, [
abs ( $ax - $cx ) + abs ( $ay - $cy ),
[ $ax, $ay, $cx, $cy ],
[ 'left', 'left' ]
];
push @distances, [
abs ( $ax - $dx ) + abs ( $ay - $dy ),
[ $ax, $ay, $dx, $dy ],
[ 'left', 'right' ],
];
push @distances, [
abs ( $bx - $cx ) + abs ( $by - $cy ),
[ $bx, $by, $cx, $cy ],
[ 'right', 'left' ],
];
push @distances, [
abs ( $bx - $dx ) + abs ( $by - $dy ),
[ $bx, $by, $dx, $dy ],
[ 'right', 'right' ],
];
@distances = sort { $a->[0] <=> $b->[0] } @distances;
my $shortest = $distances[0];
my ( $x1, $y1, $x2, $y2 ) = @{ $shortest->[1] };
my ( $side1, $side2 ) = @{ $shortest->[2] };
my ( $start, $end );
my $offset = 9;
my $col1_right = $table_x{ $table1 };
my $col2_right = $table_x{ $table2 };
my $diff = 0;
if ( $x1 == $x2 ) {
while ( $horz_taken{ $x1 + $diff } ) {
$diff = $side1 eq 'left' ? $diff - 2 : $diff + 2;
}
$horz_taken{ $x1 + $diff } = 1;
}
if ( $side1 eq 'left' ) {
$start = $x1 - $offset + $diff;
}
else {
$start = $col1_right + $diff;
}
if ( $side2 eq 'left' ) {
$end = $x2 - $offset + $diff;
}
else {
$end = $col2_right + $diff;
}
push @shapes,
[ 'line', $x1, $y1, $start, $y1, 'cadetblue' ];
push @shapes,
[ 'line', $start, $y1, $end, $y2, 'cadetblue' ];
push @shapes,
[ 'line', $end, $y2, $x2, $y2, 'cadetblue' ];
if ( $is_directed ) {
if (
$side1 eq 'right' && $side2 eq 'left'
||
$side1 eq 'left' && $side2 eq 'left'
) {
push @shapes, [
'line', $x2 - 3, $y2 - 3, $x2, $y2, 'cadetblue'
];
push @shapes, [
'line', $x2 - 3, $y2 + 3, $x2, $y2, 'cadetblue'
];
push @shapes, [
'line', $x2 - 3, $y2 - 3, $x2 - 3, $y2 +3,
'cadetblue'
];
}
else {
push @shapes, [
'line', $x2 + 3, $y2 - 3, $x2, $y2, 'cadetblue'
];
push @shapes, [
'line', $x2 + 3, $y2 + 3, $x2, $y2, 'cadetblue'
];
push @shapes, [
'line', $x2 + 3, $y2 - 3, $x2 + 3, $y2 +3,
'cadetblue'
];
}
}
$done{ $fno1 }{ $fno2 } = 1;
$done{ $fno2 }{ $fno1 } = 1;
}
}
}
}
#
# Add the title, legend and signature.
#
my $large_font = gdLargeFont;
my $title_len = $large_font->width * length $title;
push @shapes, [
'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black'
];
if ( %legend ) {
$max_y += 5;
push @shapes, [
'string', $font, $x, $max_y - $font->height - 4, 'Legend', 'black'
];
$max_y += $font->height + 4;
my $longest;
for my $len ( map { length $_ } values %legend ) {
$longest = $len if $len > ($longest||0);
}
$longest += 2;
while ( my ( $key, $shape ) = each %legend ) {
my $space = $longest - length $shape;
push @shapes, [
'string', $font, $x, $max_y - $font->height - 4,
join( '', $shape, ' ' x $space, $key ), 'black'
];
$max_y += $font->height + 4;
}
}
my $sig = 'Created by SQL::Translator ' . $t->version;
my $sig_len = $font->width * length $sig;
push @shapes, [
'string', $font, $max_x - $sig_len, $max_y - $font->height - 4,
$sig, 'black'
];
#
# Render the image.
#
my $gd = GD::Image->new( $max_x + 30, $max_y );
unless ( $gd->can( $output_type ) ) {
die "GD can't create images of type '$output_type'\n";
}
my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } (
[ white => [ 255, 255, 255 ] ],
[ beige => [ 245, 245, 220 ] ],
[ black => [ 0, 0, 0 ] ],
[ lightblue => [ 173, 216, 230 ] ],
[ cadetblue => [ 95, 158, 160 ] ],
[ lightgoldenrodyellow => [ 250, 250, 210 ] ],
[ khaki => [ 240, 230, 140 ] ],
[ red => [ 255, 0, 0 ] ],
);
$gd->interlaced( 'true' );
my $background_color = $add_color ? 'lightgoldenrodyellow' : 'white';
$gd->fill( 0, 0, $colors{ $background_color } );
for my $shape ( @shapes ) {
my $method = shift @$shape;
my $color = pop @$shape;
$gd->$method( @$shape, $colors{ $color } );
}
#
# Make image map.
#
debug("imap file = '$imap_file'");
if ( $imap_file && @imap_coords ) {
open my $fh, '>', $imap_file or die "Can't write '$imap_file': $!\n";
print $fh qq[![]()
\n].
qq[