DBIx-Class-Schema-Config-0.001011/000755 000765 000024 00000000000 12404416303 016636 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/Changes000644 000765 000024 00000007136 12404415410 020136 0ustar00symkatstaff000000 000000 0.1.11 - Using dbh_maker in a hash to connect() will not result in connect() passing through your arguments after merging into a single hash. - Using a code ref for the first argument will now result in connect() passing through your arguments as-is. - README.pod symlink replaces pod2markdown use (YAY!) - namespace::clean used to prevent methods from leaking - Merge functionality replaced with Hash::Merge - Additional attributes passed to connect() will now overwrite the loaded configuration file. - Removed Test::MockObject as a dependency - Improved caching layer to prevent stale cache - Changed tests to use the correct password attribute - Updated Documentation 0.1.10 - Introduce a public config() getter to allow access to the loaded Config::Any object. 0.1.9 - Fix perl 5.17 hash randomisation breakage (RT#83309) 0.1.8 - Added class accessor config_files to use Config::Any's load_files method and reduce stat() calls for those who like that kind of thing. - Moved the Config::Any parser to its own private function. - DBIX_CONFIG_DIR environment allows run-time injection of a directory that contains a dbic.* file. 0.1.7 - Use File::HomeDir instead of env, thanks @ Christian Walde - CHANGELOG -> Changes - BSD License -> Perl License - README.pod -> Readme.md - Contributor Addition (Christian Walde) 0.1.6 - Once more with feeling. 0.1.5 - Re-release due to broken MANIFEST.skip and outdated README.pod 0.1.4 - Config::Any added as a requirement - Tests now use the included .perl format (No more YAML::XS requirement) - Tests changed to support DBIx::Class 0.80123 - Document Changes - Linked to tutorial - Added CONTRIBUTOR section - Thanks mst and ribasushi for the constant reviews! - Pushed to CPAN as a stable release 0.1.3 - connect() now handles passing through valid-looking DBI connect structures. - _make_config now checks for $user and $pass to be hashrefs, this adds support for structures like ->connect( 'CONFIG', { hostname => 'db.foo.com' } ); - Added tests to 01_*.t to ensure the new signatures work correctly. - Updated tests in 06_*.t to use ->connect ('CONFIG', { dbname => ":memory:" ) to be more clear, as opposed to riding ->{user} - Updated documentation to reflect the changes to the code, namely the hashref as the second argument, and the statements referring to load_credentials having responsibility to return normal DBI connect structures. - Config::Any is only loaded when it's needed. 0.1.2 - Makefile.PL depends on DBD::SQLite not DBD::SQLite3 - _make_config has a less annoying return - connection() no longer tries to block ->load_credentials, it is load_credential's responsablity to to check for credentials it should allow to fall through. - Added accessor on_credential_load, it provides access to the config structure that load_credentials creates, and expects it as the return. It can be used to make changes to the credentials, such as decrypting passwords from the config file. - A new Schema base was created for testing on_credential_load - New tests added for on_credential_load 0.1.1: - Replace SUPER:: with next::method - Don't call load_credentials unless we're actually going to load some - Move Config::Any into load_credentials to be lazy - Allow handling of a normal hashref, no ->{options} (Should make handling cleaner) - Add Testing schema for integration tests 0.1.0: - Inital Version DBIx-Class-Schema-Config-0.001011/inc/000755 000765 000024 00000000000 12404416303 017407 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/lib/000755 000765 000024 00000000000 12404416303 017404 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/Makefile.PL000644 000765 000024 00000001210 12404416044 020604 0ustar00symkatstaff000000 000000 use inc::Module::Install; # Define metadata name 'DBIx-Class-Schema-Config'; all_from 'lib/DBIx/Class/Schema/Config.pm'; license 'perl'; # Specific dependencies requires 'DBIx::Class' => '0.08100'; requires 'Config::Any' => '0.23'; requires 'File::HomeDir' => '0'; requires 'Hash::Merge' => '0'; requires 'namespace::clean' => '0'; requires 'Storable' => '0'; test_requires 'Test::More' => '0.42'; test_requires 'DBD::SQLite' => '0'; test_requires 'Config::Any' => '0.23'; WriteAll; DBIx-Class-Schema-Config-0.001011/MANIFEST000644 000765 000024 00000001640 12404416061 017771 0ustar00symkatstaff000000 000000 Changes inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/DBIx/Class/Schema/Config.pm Makefile.PL MANIFEST This list of files META.yml t/00_load.t t/01_pass_through.t t/02_load_credentials.t t/03_config_paths.t t/04_integration_test.t t/05_integration_plugin.t t/06_on_credential_load.t t/07_integration_config_files.t t/08_integration_env.t t/09_no_modify_config.t t/etc/config.perl t/etc/dbic.perl t/lib/DBIx/Class/Schema/Config/ConfigFiles.pm t/lib/DBIx/Class/Schema/Config/ConfigFiles/Hash.pm t/lib/DBIx/Class/Schema/Config/ENV.pm t/lib/DBIx/Class/Schema/Config/ENV/Hash.pm t/lib/DBIx/Class/Schema/Config/Plugin.pm t/lib/DBIx/Class/Schema/Config/Plugin/Hash.pm t/lib/DBIx/Class/Schema/Config/Test.pm t/lib/DBIx/Class/Schema/Config/Test/Hash.pm DBIx-Class-Schema-Config-0.001011/META.yml000644 000765 000024 00000001417 12404416266 020122 0ustar00symkatstaff000000 000000 --- abstract: 'Credential Management for DBIx::Class' author: - 'Kaitlyn Parkhurst (SymKat) I<> ( Blog: L )' build_requires: Config::Any: '0.23' DBD::SQLite: 0 ExtUtils::MakeMaker: 6.36 Test::More: '0.42' configure_requires: ExtUtils::MakeMaker: 6.36 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.10' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DBIx-Class-Schema-Config no_index: directory: - inc - t requires: Config::Any: '0.23' DBIx::Class: '0.08100' File::HomeDir: 0 Hash::Merge: 0 Storable: 0 namespace::clean: 0 perl: '5.005' resources: license: http://dev.perl.org/licenses/ version: '0.001011' DBIx-Class-Schema-Config-0.001011/t/000755 000765 000024 00000000000 12404416303 017101 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/00_load.t000644 000765 000024 00000000374 12403520545 020513 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; my @want_modules = qw/ DBI DBIx::Class Hash::Merge namespace::clean DBIx::Class::Schema DBIx::Class::Schema::Config /; use_ok( $_ ) for @want_modules; done_testing(); DBIx-Class-Schema-Config-0.001011/t/01_pass_through.t000644 000765 000024 00000004516 12403453455 022312 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use DBIx::Class::Schema::Config; my $tests = [ { put => { dsn => 'dbi:mysql:somedb', user => 'username', password => 'password', }, get => { dsn => 'dbi:mysql:somedb', user => 'username', password => 'password', }, title => "Hashref connections work.", }, { put => [ 'dbi:mysql:somedb', 'username', 'password' ], get => { dsn => 'dbi:mysql:somedb', user => 'username', password => 'password', }, title => "Array connections work.", }, { put => [ 'DATABASE' ], get => { dsn => 'DATABASE', user => undef, password => undef }, title => "DSN gets the first element name.", }, { put => [ 'dbi:mysql:somedb', 'username', 'password', { PrintError => 1 } ], get => { dsn => 'dbi:mysql:somedb', user => 'username', password => 'password', PrintError => 1, }, title => "Normal option hashes pass through.", }, { put => [ 'DATABASE', 'USERNAME', { hostname => 'hostname' } ], get => { dsn => 'DATABASE', user => 'USERNAME', hostname => 'hostname' }, title => "Ensure (string, string, hashref) format works correctly.", }, { put => [ 'DATABASE', 'USERNAME', 'PASSWORD', { hostname => 'hostname' } ], get => { dsn => 'DATABASE', user => 'USERNAME', password => 'PASSWORD', hostname => 'hostname' }, title => "Ensure (string, string, string, hashref) format works correctly.", }, { put => [ 'DATABASE', 'U', 'P', { foo => "bar" }, { hostname => 'hostname' } ], get => { dsn => 'DATABASE', user => 'U', password => 'P', foo => "bar", hostname => 'hostname' }, title => "Ensure (string, string, string, hashref, hashref) format works correctly.", }, ]; for my $test ( @$tests ) { is_deeply( DBIx::Class::Schema::Config->_make_connect_attrs( ref $test->{put} eq 'ARRAY' ? @{$test->{put}} : $test->{put} ), $test->{get}, $test->{title} ); } done_testing; DBIx-Class-Schema-Config-0.001011/t/02_load_credentials.t000644 000765 000024 00000012630 12403460102 023060 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use DBIx::Class::Schema::Config; { package Config::Any; $INC{"Config/Any.pm"} = __FILE__; sub load_stems { return [ { 'some_file' => { SOME_DATABASE => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'MyUser', password => 'MyPass', }, AWESOME_DB => { dsn => 'dbi:mysql:dbname=epsilon', user => 'Bravo', password => 'ShiJulIanDav', }, OPTIONS => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 5, } }, }, { 'some_other_file' => { SOME_DATABASE => { dsn => 'dbi:mysql:dbname=acronym', user => 'YawnyPants', password => 'WhyDoYouHateUs?', }, }, } ] } } my $tests = [ { put => { dsn => 'SOME_DATABASE', user => '', password => '' }, get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'MyUser', password => 'MyPass', }, title => "Get DB info from hashref.", }, { put => [ 'SOME_DATABASE' ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'MyUser', password => 'MyPass', }, title => "Get DB info from array.", }, { put => { dsn => 'AWESOME_DB' }, get => { dsn => 'dbi:mysql:dbname=epsilon', user => 'Bravo', password => 'ShiJulIanDav', }, title => "Get DB from hashref without user and pass.", }, { put => [ 'dbi:mysql:dbname=foo', 'username', 'password' ], get => { dsn => 'dbi:mysql:dbname=foo', user => 'username', password => 'password', }, title => "Pass through of normal ->connect as array.", }, { put => { dsn => 'dbi:mysql:dbname=foo', user => 'username', password => 'password' }, get => { dsn => 'dbi:mysql:dbname=foo', user => 'username', password => 'password', }, title => "Pass through of normal ->connect as hashref.", }, { put => [ 'OPTIONS' ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 5, }, title => "Default loading", }, { put => [ 'OPTIONS', undef, undef, { TRACE_LEVEL => 10 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 10, }, title => "Override of replaced key works.", }, { put => [ 'OPTIONS', undef, undef, { TRACE_LEVEL => 10, MAGIC => 1 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 10, MAGIC => 1, }, title => "Override for non-replaced key works.", }, { put => [ 'OPTIONS', { TRACE_LEVEL => 10, MAGIC => 1 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 10, MAGIC => 1, }, title => "Override for non-replaced key works, without undefing", }, { put => [ 'OPTIONS', "Foobar", undef, { TRACE_LEVEL => 10 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Foobar', password => 'User', TRACE_LEVEL => 10, }, title => "Overriding the username works.", }, { put => [ 'OPTIONS', "Foobar", { TRACE_LEVEL => 10 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Foobar', password => 'User', TRACE_LEVEL => 10, }, title => "Overriding the username works without undefing password.", }, { put => [ 'OPTIONS', undef, "Foobar", { TRACE_LEVEL => 10 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'Foobar', TRACE_LEVEL => 10, }, title => "Overriding the password works.", }, { put => [ 'OPTIONS', "BleeBaz", "Foobar", { TRACE_LEVEL => 10 } ], get => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'BleeBaz', password => 'Foobar', TRACE_LEVEL => 10, }, title => "Overriding the user and password works.", }, ]; for my $test ( @$tests ) { is_deeply( DBIx::Class::Schema::Config->load_credentials( DBIx::Class::Schema::Config->_make_connect_attrs( ref $test->{put} eq 'ARRAY' ? @{$test->{put}} : $test->{put}) ), $test->{get}, $test->{title} ); } done_testing; DBIx-Class-Schema-Config-0.001011/t/03_config_paths.t000644 000765 000024 00000000714 12403453455 022246 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use base 'DBIx::Class::Schema::Config'; use File::HomeDir; is_deeply( __PACKAGE__->config_paths, [ './dbic', File::HomeDir->my_home . "/.dbic", "/etc/dbic" ], "_config_paths looks sane."); __PACKAGE__->config_paths( [ ( './this', '/var/www/that' ) ] ); is_deeply( __PACKAGE__->config_paths, [ './this', '/var/www/that' ], "_config_paths can be modified."); done_testing; DBIx-Class-Schema-Config-0.001011/t/04_integration_test.t000644 000765 000024 00000007071 12403533133 023160 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use lib 't/lib'; # Tests above t/ use lib 'lib'; # Tests inside t/ use DBIx::Class::Schema::Config::Test; # Using a config file. my $expected_config = [ { 't/etc/config.perl' => { 'TEST' => { 'password' => '', 'dsn' => 'dbi:SQLite:dbname=:memory:', 'user' => '' }, 'PLUGIN' => { 'password' => '', 'dsn' => 'dbi:SQLite:dbname=%s', 'user' => '' } } } ]; is_deeply(DBIx::Class::Schema::Config::Test->config, $expected_config, 'config from class accessor matches as expected - loaded before connect'); ok my $Schema1 = DBIx::Class::Schema::Config::Test->connect('TEST'), "Can connect to the Test Schema."; ok $Schema1->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema1->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema1->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of array. ok my $Schema2 = DBIx::Class::Schema::Config::Test->connect('dbi:SQLite:dbname=:memory:', '', ''), "Can connect to the Test Schema."; ok $Schema2->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema2->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema2->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of hash ok my $Schema3 = DBIx::Class::Schema::Config::Test->connect({ dsn => 'dbi:SQLite:dbname=:memory:' }), "Can connect to the Test Schema."; ok $Schema3->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema3->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema3->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of code reference. ok my $Schema4 = DBIx::Class::Schema::Config::Test->connect( sub { DBI->connect( 'dbi:SQLite:dbname=:memory:', undef, undef, { RaiseError => 1 } ) } ), "Can connect to the Test Schema."; ok $Schema4->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema4->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema4->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # dbh_maker functions as one would expect. ok my $Schema5 = DBIx::Class::Schema::Config::Test->connect({ dbh_maker => sub { DBI->connect( 'dbi:SQLite:dbname=:memory:', undef, undef, { RaiseError => 1 } ) }, }), "Can connect to the Test Schema."; ok $Schema5->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema5->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema5->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; done_testing; DBIx-Class-Schema-Config-0.001011/t/05_integration_plugin.t000644 000765 000024 00000003443 12403453455 023507 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use lib 't/lib'; # Tests above t/ use lib 'lib'; # Tests inside t/ use DBIx::Class::Schema::Config::Plugin; # Using a config file. ok my $Schema1 = DBIx::Class::Schema::Config::Plugin->connect('TEST'), "Can connect to the Test Schema."; ok $Schema1->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema1->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema1->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of array. ok my $Schema2 = DBIx::Class::Schema::Config::Plugin->connect('dbi:SQLite:dbname=:memory:', '', ''), "Can connect to the Test Schema."; ok $Schema2->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema2->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema2->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of hash ok my $Schema3 = DBIx::Class::Schema::Config::Plugin->connect({ dsn => 'dbi:SQLite:dbname=:memory:' }), "Can connect to the Test Schema."; ok $Schema3->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema3->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema3->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; done_testing; DBIx-Class-Schema-Config-0.001011/t/06_on_credential_load.t000644 000765 000024 00000001153 12403453455 023410 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use lib 't/lib'; # Tests above t/ use lib 'lib'; # Tests inside t/ use DBIx::Class::Schema::Config::Plugin; use Data::Dumper; # Using a config file, with a plugin changing the DSN. ok my $Schema = DBIx::Class::Schema::Config::Plugin->connect('PLUGIN', { dbname => ':memory:' }), "Connection to a plugin-modified schema works."; my $expect = [ { password => '', user => '', dsn => 'dbi:SQLite:dbname=:memory:' } ]; is_deeply $Schema->storage->connect_info, $expect, "Expected schema changes happened."; done_testing; DBIx-Class-Schema-Config-0.001011/t/07_integration_config_files.t000644 000765 000024 00000003467 12403453455 024650 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use lib 't/lib'; # Tests above t/ use lib 'lib'; # Tests inside t/ use DBIx::Class::Schema::Config::ConfigFiles; # Using a config file. ok my $Schema1 = DBIx::Class::Schema::Config::ConfigFiles->connect('TEST'), "Can connect to the Test Schema."; ok $Schema1->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema1->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema1->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of array. ok my $Schema2 = DBIx::Class::Schema::Config::ConfigFiles->connect('dbi:SQLite:dbname=:memory:', '', ''), "Can connect to the Test Schema."; ok $Schema2->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema2->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema2->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of hash ok my $Schema3 = DBIx::Class::Schema::Config::ConfigFiles->connect({ dsn => 'dbi:SQLite:dbname=:memory:' }), "Can connect to the Test Schema."; ok $Schema3->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema3->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema3->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; done_testing; DBIx-Class-Schema-Config-0.001011/t/08_integration_env.t000644 000765 000024 00000004013 12403453455 022776 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use lib 't/lib'; # Tests above t/ use lib 'lib'; # Tests inside t/ # This test requires that the environment # variable is set at the DB's compile time, # as it would if you ran # $ DBIX_CONFIG_DIR="t/etc/" prove t/08* BEGIN { $ENV{'DBIX_CONFIG_DIR'} = "t/etc/"; require DBIx::Class::Schema::Config::ENV; DBIx::Class::Schema::Config::ENV->import(); } # Using a config file. ok my $Schema1 = DBIx::Class::Schema::Config::ENV->connect('TEST'), "Can connect to the Test Schema."; ok $Schema1->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema1->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema1->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of array. ok my $Schema2 = DBIx::Class::Schema::Config::ENV->connect('dbi:SQLite:dbname=:memory:', '', ''), "Can connect to the Test Schema."; ok $Schema2->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema2->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema2->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; # Pass through of hash ok my $Schema3 = DBIx::Class::Schema::Config::ENV->connect({ dsn => 'dbi:SQLite:dbname=:memory:' }), "Can connect to the Test Schema."; ok $Schema3->storage->dbh->do( "CREATE TABLE hash ( key text, value text )" ), "Can create table against the raw dbh."; ok $Schema3->resultset('Hash')->create( { key => "Dr", value => "Spaceman" } ), "Can write to the Test Schema."; is $Schema3->resultset('Hash')->find( { key => 'Dr' }, { key => 'key_unique' } )->value, 'Spaceman', "Can read from the Test Schema."; done_testing; DBIx-Class-Schema-Config-0.001011/t/09_no_modify_config.t000644 000765 000024 00000003211 12403455314 023107 0ustar00symkatstaff000000 000000 #!/usr/bin/perl use warnings; use strict; use Test::More; use DBIx::Class::Schema::Config; { package Config::Any; $INC{"Config/Any.pm"} = __FILE__; sub load_stems { return [ { 'some_file' => { SOME_DATABASE => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'MyUser', password => 'MyPass', }, AWESOME_DB => { dsn => 'dbi:mysql:dbname=epsilon', user => 'Bravo', password => 'ShiJulIanDav', }, OPTIONS => { dsn => 'dbi:SQLite:dbfile=:memory:', user => 'Happy', password => 'User', TRACE_LEVEL => 5, } }, }, { 'some_other_file' => { SOME_DATABASE => { dsn => 'dbi:mysql:dbname=acronym', user => 'YawnyPants', password => 'WhyDoYouHateUs?', }, }, } ] } } ok my $ref = DBIx::Class::Schema::Config->config; is_deeply( $ref, "Config::Any"->load_stems, "Loaded correct data set." ); is $ref->[0]->{some_file} = undef, undef, "Changed reference returned by config."; is_deeply( DBIx::Class::Schema::Config->config, "Config::Any"->load_stems, "Changes to a ref of ::config's return does not change future invocations." ); done_testing; DBIx-Class-Schema-Config-0.001011/t/etc/000755 000765 000024 00000000000 12404416303 017654 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/000755 000765 000024 00000000000 12404416303 017647 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/000755 000765 000024 00000000000 12404416303 020435 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/000755 000765 000024 00000000000 12404416303 021502 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/000755 000765 000024 00000000000 12404416303 022702 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/000755 000765 000024 00000000000 12404416303 024107 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ConfigFiles/000755 000765 000024 00000000000 12404416303 026277 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ConfigFiles.pm000644 000765 000024 00000000317 12403453455 026646 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::ConfigFiles; use strict; use warnings; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->config_files( [ ( 't/etc/config.perl' ) ] ); __PACKAGE__->load_classes; 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ENV/000755 000765 000024 00000000000 12404416303 024537 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ENV.pm000644 000765 000024 00000000215 12403453455 025103 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::ENV; use strict; use warnings; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->load_classes; 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Plugin/000755 000765 000024 00000000000 12404416303 025345 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Plugin.pm000644 000765 000024 00000000604 12403453455 025713 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::Plugin; use strict; use warnings; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->config_paths( [ ( 't/etc/config' ) ] ); sub filter_loaded_credentials { my ( $class, $new, $orig ) = @_; if ( $new->{dsn} =~ /\%s/ ) { $new->{dsn} = sprintf($new->{dsn}, $orig->{dbname}); } return $new; } __PACKAGE__->load_classes; 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Test/000755 000765 000024 00000000000 12404416303 025026 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Test.pm000644 000765 000024 00000000303 12403453455 025370 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::Test; use strict; use warnings; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->config_paths( [ ( 't/etc/config' ) ] ); __PACKAGE__->load_classes; 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Test/Hash.pm000644 000765 000024 00000000743 12403453455 026263 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::Test::Hash; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("hash"); __PACKAGE__->add_columns( "key", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, "value", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, ); __PACKAGE__->add_unique_constraint("key_unique", ["key"]); 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/Plugin/Hash.pm000644 000765 000024 00000000745 12403453455 026604 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::Plugin::Hash; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("hash"); __PACKAGE__->add_columns( "key", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, "value", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, ); __PACKAGE__->add_unique_constraint("key_unique", ["key"]); 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ENV/Hash.pm000644 000765 000024 00000000742 12403453455 025773 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::ENV::Hash; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("hash"); __PACKAGE__->add_columns( "key", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, "value", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, ); __PACKAGE__->add_unique_constraint("key_unique", ["key"]); 1; DBIx-Class-Schema-Config-0.001011/t/lib/DBIx/Class/Schema/Config/ConfigFiles/Hash.pm000644 000765 000024 00000000752 12403453455 027534 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config::ConfigFiles::Hash; use strict; use warnings; use base 'DBIx::Class'; __PACKAGE__->load_components("Core"); __PACKAGE__->table("hash"); __PACKAGE__->add_columns( "key", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, "value", { data_type => "text", default_value => undef, is_nullable => 0, size => undef, }, ); __PACKAGE__->add_unique_constraint("key_unique", ["key"]); 1; DBIx-Class-Schema-Config-0.001011/t/etc/config.perl000644 000765 000024 00000000452 12403453455 022016 0ustar00symkatstaff000000 000000 { "TEST" => { "dsn" => "dbi:SQLite:dbname=:memory:", "user" => "", "password" => "", }, "PLUGIN" => { "dsn" => "dbi:SQLite:dbname=%s", "user" => "", "password" => "", }, } DBIx-Class-Schema-Config-0.001011/t/etc/dbic.perl000644 000765 000024 00000000452 12403453455 021452 0ustar00symkatstaff000000 000000 { "TEST" => { "dsn" => "dbi:SQLite:dbname=:memory:", "user" => "", "password" => "", }, "PLUGIN" => { "dsn" => "dbi:SQLite:dbname=%s", "user" => "", "password" => "", }, } DBIx-Class-Schema-Config-0.001011/lib/DBIx/000755 000765 000024 00000000000 12404416303 020172 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/lib/DBIx/Class/000755 000765 000024 00000000000 12404416303 021237 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/lib/DBIx/Class/Schema/000755 000765 000024 00000000000 12404416303 022437 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/lib/DBIx/Class/Schema/Config.pm000644 000765 000024 00000031466 12404415514 024217 0ustar00symkatstaff000000 000000 package DBIx::Class::Schema::Config; use 5.005; use warnings; use strict; use base 'DBIx::Class::Schema'; use File::HomeDir; use Storable qw( dclone ); use Hash::Merge qw( merge ); use namespace::clean; our $VERSION = '0.001011'; # 0.1.11 $VERSION = eval $VERSION; sub connection { my ( $class, @info ) = @_; if ( ref($info[0]) eq 'CODE' ) { return $class->next::method( @info ); } my $attrs = $class->_make_connect_attrs(@info); # We will not load credentials for someone who uses dbh_maker, # however we will pass their request through. return $class->next::method( $attrs ) if defined $attrs->{dbh_maker}; # Take responsibility for passing through normal-looking # credentials. $attrs = $class->load_credentials($attrs) unless $attrs->{dsn} =~ /dbi:/i; return $class->next::method( $attrs ); } # Normalize arguments into a single hash. If we get a single hashref, # return it. # Check if $user and $pass are hashes to support things like # ->connect( 'CONFIG_FILE', { hostname => 'db.foo.com' } ); sub _make_connect_attrs { my ( $class, $dsn, $user, $pass, $dbi_attr, $extra_attr ) = @_; return $dsn if ref $dsn eq 'HASH'; return { dsn => $dsn, %{ref $user eq 'HASH' ? $user : { user => $user }}, %{ref $pass eq 'HASH' ? $pass : { password => $pass }}, %{$dbi_attr || {} }, %{ $extra_attr || {} } }; } # Cache the loaded configuration. sub config { my ( $class ) = @_; if ( ! $class->_config ) { $class->_config( $class->_load_config ); } return dclone( $class->_config ); } sub _load_config { my ( $class ) = @_; require Config::Any; # Only loaded if we need to load credentials. # If we have ->config_files, we'll use those and load_files # instead of the default load_stems. my %cf_opts = ( use_ext => 1 ); return @{$class->config_files} ? Config::Any->load_files({ files => $class->config_files, %cf_opts }) : Config::Any->load_stems({ stems => $class->config_paths, %cf_opts }); } sub load_credentials { my ( $class, $connect_args ) = @_; # While ->connect is responsible for returning normal-looking # credential information, we do it here as well so that it can be # independently unit tested. return $connect_args if $connect_args->{dsn} =~ /^dbi:/i; return $class->filter_loaded_credentials( $class->_find_credentials( $connect_args, $class->config ), $connect_args ); } # This will look through the data structure returned by Config::Any # and return the first instance of the database credentials it can # find. sub _find_credentials { my ( $class, $connect_args, $ConfigAny ) = @_; for my $cfile ( @$ConfigAny ) { for my $filename ( keys %$cfile ) { for my $database ( keys %{$cfile->{$filename}} ) { if ( $database eq $connect_args->{dsn} ) { return $cfile->{$filename}->{$database}; } } } } } sub get_env_vars { return $ENV{DBIX_CONFIG_DIR} . "/dbic" if exists $ENV{DBIX_CONFIG_DIR}; return (); } # Intended to be sub-classed, the default behavior is to # overwrite the loaded configuration with any specified # configuration from the connect() call, with the exception # of the DSN itself. sub filter_loaded_credentials { my ( $class, $new, $old ) = @_; local $old->{password}, delete $old->{password} unless $old->{password}; local $old->{user}, delete $old->{user} unless $old->{user}; local $old->{dsn}, delete $old->{dsn}; return merge( $old, $new ); }; __PACKAGE__->mk_classaccessor('config_paths'); __PACKAGE__->mk_classaccessor('config_files'); __PACKAGE__->mk_classaccessor('_config'); __PACKAGE__->config_paths([( get_env_vars(), './dbic', File::HomeDir->my_home . '/.dbic', '/etc/dbic')]); __PACKAGE__->config_files([ ] ); 1; =encoding UTF-8 =head1 NAME DBIx::Class::Schema::Config - Credential Management for DBIx::Class =head1 DESCRIPTION DBIx::Class::Schema::Config is a subclass of DBIx::Class::Schema that allows the loading of credentials & configuration from a file. The actual code itself would only need to know about the name used in the configuration file. This aims to make it simpler for operations teams to manage database credentials. A simple tutorial that compliments this documentation and explains converting an existing DBIx::Class Schema to use this software to manage credentials can be found at L =head1 SYNOPSIS /etc/dbic.yaml MY_DATABASE: dsn: "dbi:Pg:host=localhost;database=blog" user: "TheDoctor" password: "dnoPydoleM" TraceLevel: 1 package My::Schema use warnings; use strict; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->load_namespaces; package My::Code; use warnings; use strict; use My::Schema; my $schema = My::Schema->connect('MY_DATABASE'); # arbitrary config access from anywhere in your $app my $level = My::Schema->config->{TraceLevel}; =head1 CONFIG FILES This module will load the files in the following order if they exist: =over 4 =item * C<$ENV{DBIX_CONFIG_DIR}> . '/dbic', C<$ENV{DBIX_CONFIG_DIR}> can be configured at run-time, for instance: DBIX_CONFIG_DIR="/var/local/" ./my_program.pl =item * ./dbic.* =item * ~/.dbic.* =item * /etc/dbic.* =back The files should have an extension that L recognizes, for example /etc/dbic.B. NOTE: The first available credential will be used. Therefore I in ~/.dbic.yaml will only be looked at if it was not found in ./dbic.yaml. If there are duplicates in one file (such that DATABASE is listed twice in ~/.dbic.yaml,) the first configuration will be used. =head1 CHANGE CONFIG PATH Use C<__PACKAGE__-Econfig_paths([( '/file/stub', '/var/www/etc/dbic')]);> to change the paths that are searched. For example: package My::Schema use warnings; use strict; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->config_paths([( '/var/www/secret/dbic', '/opt/database' )]); The above code would have I and I searched, in that order. As above, the first credentials found would be used. This will replace the files originally searched for, not add to them. =head1 USE SPECIFIC CONFIG FILES If you would rather explicitly state the configuration files you want loaded, you can use the class accessor C instead. package My::Schema use warnings; use strict; use base 'DBIx::Class::Schema::Config'; __PACKAGE__->config_files([( '/var/www/secret/dbic.yaml', '/opt/database.yaml' )]); This will check the files, C, and C in the same way as C, however it will only check the specific files, instead of checking for each extension that L supports. You MUST use the extension that corresponds to the file type you are loading. See L for information on supported file types and extension mapping. =head1 ACCESSING THE CONFIG FILE The config file is stored via the C<__PACKAGE__-Econfig> accessor, which can be called as both a class and instance method. =head1 OVERRIDING The API has been designed to be simple to override if you have additional needs in loading DBIC configurations. =head2 Overriding Connection Configuration Simple cases where one wants to replace specific configuration tokens can be given as extra parameters in the ->connect call. For example, suppose we have the database MY_DATABASE from above: MY_DATABASE: dsn: "dbi:Pg:host=localhost;database=blog" user: "TheDoctor" password: "dnoPydoleM" TraceLevel: 1 If you’d like to replace the username with “Eccleston” and we’d like to turn PrintError off. The following connect line would achieve this: $Schema->connect(“MY_DATABASE”, “Eccleston”, undef, { PrintError => 0 } ); The name of the connection to load from the configuration file is still given as the first argument, while other arguments may be given exactly as you would for any other call to C. Historical Note: This class accepts numerous ways to connect to DBIC that would otherwise not be valid. These connection methods are discouraged but tested for and kept for compatibility with earlier versions. For valid ways of connecting to DBIC please see L =head2 filter_loaded_credentials Override this function if you want to change the loaded credentials before they are passed to DBIC. This is useful for use-cases that include decrypting encrypted passwords or making programmatic changes to the configuration before using it. sub filter_loaded_credentials { my ( $class, $loaded_credentials, $connect_args ) = @_; ... return $loaded_credentials; } C<$loaded_credentials> is the structure after it has been loaded from the configuration file. In this case, C<$loaded_credentials-E{user}> eq B and C<$loaded_credentials-E{dsn}> eq B. C<$connect_args> is the structure originally passed on C<-Econnect()> after it has been turned into a hash. For instance, C<-Econnect('DATABASE', 'USERNAME')> will result in C<$connect_args-E{dsn}> eq B and C<$connect_args-E{user}> eq B. Additional parameters can be added by appending a hashref, to the connection call, as an example, C<-Econnect( 'CONFIG', { hostname =E "db.foo.com" } );> will give C<$connect_args> a structure like C<{ dsn =E 'CONFIG', hostname =E "db.foo.com" }>. For instance, if you want to use hostnames when you make the initial connection to DBIC and are using the configuration primarily for usernames, passwords and other configuration data, you can create a config like the following: DATABASE: dsn: "DBI:mysql:database=students;host=%s;port=3306" user: "WalterWhite" password: "relykS" In your Schema class, you could include the following: package My::Schema use warnings; use strict; use base 'DBIx::Class::Schema::Config'; sub filter_loaded_credentials { my ( $class, $loaded_credentials, $connect_args ) = @_; if ( $loaded_credentials->{dsn} =~ /\%s/ ) { $loaded_credentials->{dsn} = sprintf( $loaded_credentials->{dsn}, $connect_args->{hostname}); } } __PACKAGE__->load_classes; 1; Then the connection could be done with C<$Schema-Econnect('DATABASE', { hostname => 'my.hostname.com' });> See L for more complex changes that require changing how the configuration itself is loaded. =head2 load_credentials Override this function to change the way that L loads credentials. The function takes the class name, as well as a hashref. If you take the route of having C<-Econnect('DATABASE')> used as a key for whatever configuration you are loading, I would be C<$config-E{dsn}> Some::Schema->connect( "SomeTarget", "Yuri", "Yawny", { TraceLevel => 1 } ); Would result in the following data structure as $config in C: { dsn => "SomeTarget", user => "Yuri", password => "Yawny", TraceLevel => 1, } Currently, load_credentials will NOT be called if the first argument to C<-Econnect()> looks like a valid DSN. This is determined by match the DSN with C. The function should return the same structure. For instance: package My::Schema use warnings; use strict; use base 'DBIx::Class::Schema::Config'; use LWP::Simple; use JSON # Load credentials from internal web server. sub load_credentials { my ( $class, $config ) = @_; return decode_json( get( "http://someserver.com/v1.0/database?key=somesecret&db=" . $config->{dsn} )); } __PACKAGE__->load_classes; =head1 AUTHOR Kaitlyn Parkhurst (SymKat) Isymkat@symkat.comE> ( Blog: L ) =head1 CONTRIBUTORS =over 4 =item * Matt S. Trout (mst) Imst@shadowcat.co.ukE> =item * Peter Rabbitson (ribasushi) Iribasushi@cpan.orgE> =item * Christian Walde (Mihtaldu) Iwalde.christian@googlemail.comE> =item * Dagfinn Ilmari Mannsåker (ilmari) Iilmari@ilmari.orgE> =item * Matthew Phillips (mattp) Imattp@cpan.orgE> =back =head1 COPYRIGHT AND LICENSE This library is free software and may be distributed under the same terms as perl itself. =head1 AVAILABILITY The latest version of this software is available at L =cut DBIx-Class-Schema-Config-0.001011/inc/Module/000755 000765 000024 00000000000 12404416303 020634 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/000755 000765 000024 00000000000 12404416303 022242 5ustar00symkatstaff000000 000000 DBIx-Class-Schema-Config-0.001011/inc/Module/Install.pm000644 000765 000024 00000030111 12404416265 022603 0ustar00symkatstaff000000 000000 #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.10'; # 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}; $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( 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($subpath . '.pm'); 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; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD 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; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _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; __END__ #line 485 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Base.pm000644 000765 000024 00000002147 12404416266 023466 0ustar00symkatstaff000000 000000 #line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.10'; } # 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 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Can.pm000644 000765 000024 00000006157 12404416266 023322 0ustar00symkatstaff000000 000000 #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.10'; @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; 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 236 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Fetch.pm000644 000765 000024 00000004653 12404416266 023651 0ustar00symkatstaff000000 000000 #line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @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; __END__ #line 109 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Makefile.pm000644 000765 000024 00000027437 12404416266 024342 0ustar00symkatstaff000000 000000 #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.10'; @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 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Metadata.pm000644 000765 000024 00000047322 12404416266 024340 0ustar00symkatstaff000000 000000 #line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @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 = ( open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ## from Software-License - should we be using S-L instead ? # duplicates commeted out, see hack above ^^ # open_source => 'http://www.gnu.org/licenses/agpl-3.0.txt', # apache => 'http://www.apache.org/licenses/LICENSE-1.1', apache => 'http://www.apache.org/licenses/LICENSE-2.0.txt', artistic => 'http://www.perlfoundation.org/artistic_license_1_0', artistic_2 => 'http://www.perlfoundation.org/artistic_license_2_0', bsd => 'http://opensource.org/licenses/BSD-3-Clause', # unrestricted => 'http://creativecommons.org/publicdomain/zero/1.0/', # open_source => 'http://www.freebsd.org/copyright/freebsd-license.html', # open_source => 'http://www.gnu.org/licenses/fdl-1.2.txt', # open_source => 'http://www.gnu.org/licenses/fdl-1.3.txt', # gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt', # gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt', gpl => 'http://www.gnu.org/licenses/gpl-3.0.txt', # lgpl => 'http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt', lgpl => 'http://www.gnu.org/licenses/lgpl-3.0.txt', mit => 'http://www.opensource.org/licenses/mit-license.php', # mozilla => 'http://www.mozilla.org/MPL/MPL-1.0.txt', # mozilla => 'http://www.mozilla.org/MPL/MPL-1.1.txt', mozilla => 'http://www.mozilla.org/MPL/2.0/index.txt', # restrictive => '', # open_source => 'http://www.openssl.org/source/license.html', perl => 'http://dev.perl.org/licenses/', # open_source => 'http://www.opensource.org/licenses/postgresql', # open_source => 'http://trolltech.com/products/qt/licenses/licensing/qpl', # unrestricted => 'http://h71000.www7.hp.com/doc/83final/BA554_90007/apcs02.html', # open_source => 'http://www.openoffice.org/licenses/sissl_license.html', # open_source => 'http://www.zlib.net/zlib_license.html', ); 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, # the following are relied on by the test system even if they are wrong :( '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'LGPL' => 'lgpl', 1, 'MIT' => 'mit', 1, ## from Software-License 'The GNU Affero General Public License, Version 3, November 2007' => 'open_source', 1, 'The Apache Software License, Version 1.1' => 'apache', 1, 'The Apache License, Version 2.0, January 2004' => 'apache', 1, 'The Artistic License 1.0' => 'artistic', 1, 'The Artistic License 2.0 (GPL Compatible)' => 'artistic_2', 1, 'The (three-clause) BSD License' => 'bsd', 1, 'CC0 License' => 'unrestricted', 1, 'The (two-clause) FreeBSD License' => 'open_source', 1, 'GNU Free Documentation License v1.2' => 'open_source', 1, 'GNU Free Documentation License v1.3' => 'open_source', 1, 'The GNU General Public License, Version 1, February 1989' => 'gpl', 1, 'The GNU General Public License, Version 2, June 1991' => 'gpl', 1, 'The GNU General Public License, Version 3, June 2007' => 'gpl', 1, 'The GNU Lesser General Public License, Version 2.1, February 1999' => 'lgpl', 1, 'The GNU Lesser General Public License, Version 3, June 2007' => 'lgpl', 1, 'The MIT (X11) License' => 'mit', 1, 'The Mozilla Public License 1.0' => 'mozilla', 1, 'The Mozilla Public License 1.1' => 'mozilla', 1, 'Mozilla Public License Version 2.0' => 'mozilla', 1, '"No License" License' => 'restrictive', 1, 'OpenSSL License' => 'open_source', 1, 'the same terms as the perl 5 programming language system itself' => 'perl', 1, 'The PostgreSQL License' => 'open_source', 1, 'The Q Public License, Version 1.0' => 'open_source', 1, 'Original SSLeay License' => 'unrestricted', 1, 'Sun Internet Standards Source License (SISSL)' => 'open_source', 1, 'The zlib License' => 'open_source', 1, ); 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; __END__ #line 766 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/Win32.pm000644 000765 000024 00000003426 12404416266 023517 0ustar00symkatstaff000000 000000 #line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @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; __END__ #line 80 DBIx-Class-Schema-Config-0.001011/inc/Module/Install/WriteAll.pm000644 000765 000024 00000002421 12404416266 024332 0ustar00symkatstaff000000 000000 #line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.10'; @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; __END__ #line 79