PGObject-Util-DBAdmin-0.100.0/0000755000175000017500000000000013014621152016527 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/lib/0000755000175000017500000000000013014621152017275 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/lib/PGObject/0000755000175000017500000000000013014621152020732 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/lib/PGObject/Util/0000755000175000017500000000000013014621152021647 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/lib/PGObject/Util/DBAdmin.pm0000644000175000017500000003215113014620720023445 0ustar ehuelsmannehuelsmannpackage PGObject::Util::DBAdmin; use 5.008; use strict; use warnings FATAL => 'all'; use Carp; use Moo; use DBI; use File::Temp; use Capture::Tiny ':all'; =head1 NAME PGObject::Util::DBAdmin - PostgreSQL Database Management Facilities for PGObject =head1 VERSION Version 0.100.0 =cut our $VERSION = '0.100.0'; =head1 SYNOPSIS This module provides an interface to the basic Postgres db manipulation utilities. my $db = PGObject::Util::DBAdmin->new( username => 'postgres', password => 'mypassword', host => 'localhost', port => '5432', dbname => 'mydb' ); my @dbnames = $db->list_dbs(); # like psql -l $db->create(); # createdb $db->run_file(file => 'sql/initial_schema.sql'); # psql -f my $filename = $db->backup(format => 'c'); # pg_dump -Fc my $db2 = PGObject::Util::DBAdmin->new($db->export, (dbname => 'otherdb')); =head1 PROPERTIES =head2 username =cut has username => (is => 'ro'); =head2 password =cut has password => (is => 'ro'); =head2 host In PostgreSQL, this can refer to the hostname or the absolute path to the directory where the UNIX sockets are set up. =cut has host => (is => 'ro'); =head2 port Default '5432' =cut has port => (is => 'ro'); =head2 dbname =cut has dbname => (is => 'ro'); sub _dbname_q { my ($self) = @_; return "'" . $self->dbname . "'"; } =head1 SUBROUTINES/METHODS =head2 new Creates a new db admin object for manipulating databases. =head2 export Exports the database parameters in a hash so it can be used to create another pbject. =cut sub export { my $self = shift; return map {$_ => $self->$_() } qw(username password host port dbname) } =head2 connect($options) Connects to the db using DBI and returns a db connection; allows specification of options in the $options hashref. =cut sub connect { my ($self, $options) = @_; my $dbh = DBI->connect('dbi:Pg:dbname=' . $self->dbname, $self->username, $self->password, $options) or die "Cound not connect to database!"; return $dbh; } =head2 server_version returns a version string (like 9.1.4) for PostgreSQL =cut sub server_version { my $self = shift @_; my $version = __PACKAGE__->new($self->export, (dbname => 'template1') )->connect->selectrow_array('SELECT version()'); $version =~ /(\d+\.\d+\.\d+)/; my $retval = $1; return $retval; } =head2 list_dbs Returns a list of db names. =cut sub list_dbs { my $self = shift; return map { $_->[0] } @{ __PACKAGE__->new($self->export, (dbname => 'template1') )->connect->selectall_arrayref( 'SELECT datname from pg_database order by datname' ) }; } =head2 create Creates a new db. Dies if there is an error. Supported arguments: =over =item copy_of Creates the db as a copy of the one of that name. Default is unspecified. =back =cut sub create { my $self = shift; my %args = @_; local $ENV{PGPASSWORD} = $self->password if $self->password; my $command = "createdb " . join (' ', ( $self->username ? "-U " . $self->username . ' ' : '' , $args{copy_of} ? "-T $args{copy_of} " : '' , $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , $self->dbname ? $self->_dbname_q : '' ) ); my $stderr = capture_stderr sub{ local ($?, $!); `$command` }; die $stderr if $stderr; return 1; } =head2 run_file Run the specified file on the db. Accepted parameters are: =over =item file Path to file to be run =item log Path to combined stderr/stdout log. If specified, do not specify other logs as this is unsupported. =item errlog Path to error log to store stderr output =item stdout_log Path to where to log standard output =item continue_on_error If set, does not die on error. =back =cut sub run_file { my ($self, %args) = @_; croak 'Must specify file' unless $args{file}; local $ENV{PGPASSWORD} = $self->password if $self->password; my $log = ''; my $errlog = 0; if ($args{log}){ $log = qq( 1>&2 ); $errlog = 1; open(ERRLOG, '>>', $args{log}) } else { if ($args{stdout_log}){ $log .= qq(>> "$args{stdout_log}" ); } if ($args{errlog}){ $errlog = 1; open(ERRLOG, '>>', $args{errlog}) } } my $command = qq(psql -f "$args{file}" ) . join(' ', ($self->username ? "-U " . $self->username . ' ' : '', $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , $self->dbname ? $self->_dbname_q : ' ' , $log) ); my $stderr = capture_stderr sub { local ($?, $!); my $result = `$command`; print STDERR "\nAPPLICATION ERROR\n" if $? != 0; return $result; }; print STDERR $stderr; print ERRLOG $stderr if $errlog; close ERRLOG if $errlog; for my $err (split /\n/, $stderr) { die $err if $err =~ /(ERROR|FATAL)/; } return 1; } =head2 backup Takes a backup and delivers the temporary file name to the handler. Accepted parameters include: =over =item format The specified format, for example c for custom. Defaults to plain text =item tempdir The directory to store temp files in. Defaults to $ENV{TEMP} if set and '/tmp/' if not. =back Returns the file name of the tempfile. =cut sub backup { my ($self, %args) = @_; local $ENV{PGPASSWORD} = $self->password if $self->password; my $tempdir = $args{tempdir} || $ENV{TEMP} || '/tmp'; $tempdir =~ s|/$||; my $tempfile = $args{file} || File::Temp->new( DIR => $tempdir, UNLINK => 0 )->filename || die "could not create temp file: $@, $!"; my $command = 'pg_dump ' . join(" ", ( $self->dbname ? "-d " . $self->_dbname_q . " " : '' , $self->username ? "-U " . $self->username . ' ' : '' , $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , defined $args{format} ? "-F$args{format} " : '' , qq(> "$tempfile" ))); my $stderr = capture_stderr { local ($?, $!); `$command` }; print STDERR $stderr; for my $err (split /\n/, $stderr) { die $err if $err =~ /(ERROR|FATAL)/; } return $tempfile; } =head2 backup_globals This creates a plain text dump of global (inter-db) objects, such as users and tablespaces. It uses pg_dumpall to do this. Options include: =over =item file File name in the path. =item tempdir The directory to store temp files in. Defaults to $ENV{TEMP} if set and '/tmp/' if not. =back Being a plain text file, it can be run using the run_file api. =cut sub backup_globals { my ($self, %args) = @_; local $ENV{PGPASSWORD} = $self->password if $self->password; my $tempdir = $args{tempdir} || $ENV{TEMP} || '/tmp'; $tempdir =~ s|/$||; my $tempfile = $args{file} || File::Temp->new( DIR => $tempdir, UNLINK => 0 )->filename || die "could not create temp file: $@, $!"; my $command = 'pg_dumpall -g ' . join(" ", ( $self->username ? "-U " . $self->username . ' ' : '' , $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , qq(> "$tempfile" ))); my $stderr = capture_stderr { local ($?, $!); `$command` }; print STDERR $stderr; for my $err (split /\n/, $stderr) { die $err if $err =~ /(ERROR|FATAL)/; } return $tempfile; } =head2 restore Restores from a saved file. Must pass in the file name as a named argument. Recognized arguments are: =over =item file Path to file =item format The specified format, for example c for custom. Defaults to plain text =item log Path to combined stderr/stdout log. If specified, do not specify other logs as this is unsupported. =item errlog Path to error log to store stderr output =item stdout_log Path to where to log standard output =back =cut sub restore { my ($self, %args) = @_; croak 'Must specify file' unless $args{file}; return $self->run_file(%args) if not defined $args{format} or $args{format} eq 'p'; local $ENV{PGPASSWORD} = $self->password if $self->password; my $log = ''; my $errlog; if ($args{log}){ $log = qq( 1>&2 ); $errlog = 1; open(ERRLOG, '>>', $args{log}) } else { if ($args{stdout_log}){ $log .= qq(>> "$args{stdout_log}" ); } if ($args{errlog}){ $errlog = 1; open(ERRLOG, '>>', $args{errlog}) } } my $command = 'pg_restore ' . join(' ', ( $self->dbname ? "-d " . $self->_dbname_q . " " : '' , $self->username ? "-U " . $self->username . ' ' : '' , $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , defined $args{format} ? "-F$args{format}" : '' , qq("$args{file}"))); my $stderr = capture_stderr sub{ local ($?, $!); `$command` }; print STDERR $stderr; print ERRLOG $stderr if $errlog; close ERRLOG if $errlog; for my $err (split /\n/, $stderr) { die $err if $err =~ /(ERROR|FATAL)/; } return 1; } =head2 drop Drops the database. This is not recoverable. =cut sub drop { my ($self, %args) = @_; croak 'No db name of this object' unless $self->dbname; local $ENV{PGPASSWORD} = $self->password if $self->password; my $command = "dropdb " . join (" ", ( $self->username ? "-U " . $self->username . ' ' : '' , $self->host ? "-h " . $self->host . " " : '' , $self->port ? "-p " . $self->port . " " : '' , $self->_dbname_q)); my $stderr = capture_stderr { local ($?, $!); `$command` }; die $stderr if $stderr =~ /(ERROR|FATAL)/; return 1; } =head1 AUTHOR Chris Travers, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc PGObject::Util::DBAdmin You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2014-2016 Chris Travers. This program is distributed under the (Revised) BSD License: L Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Chris Travers's Organization nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =cut 1; # End of PGObject::Util::DBAdmin PGObject-Util-DBAdmin-0.100.0/Makefile.PL0000644000175000017500000000222513014613617020511 0ustar ehuelsmannehuelsmannuse 5.008; use strict; use warnings FATAL => 'all'; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'PGObject::Util::DBAdmin', AUTHOR => q{Chris Travers }, VERSION_FROM => 'lib/PGObject/Util/DBAdmin.pm', ABSTRACT_FROM => 'lib/PGObject/Util/DBAdmin.pm', LICENSE => 'BSD', PL_FILES => {}, MIN_PERL_VERSION => 5.008, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, BUILD_REQUIRES => { 'Test::More' => 0, 'Test::Exception' => 0, }, PREREQ_PM => { 'DBD::Pg' => 0, 'Capture::Tiny' => 0, 'DBI' => 0, 'Moo' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'PGObject-Util-DBAdmin-*' }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/einhverfr/PGObject-Util-DBAdmin.git', web => 'https://github.com/einhverfr/PGObject-Util-DBAdmin', }, }, }, ); PGObject-Util-DBAdmin-0.100.0/README0000644000175000017500000000471113014614310017410 0ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin This module provides a basic interface to command line utilities. With it you can create and drop databases, list databases, take and restore backups, and run sql files against databases. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc PGObject::Util::DBAdmin You can also look for information at: RT, CPAN's request tracker (report bugs here) http://rt.cpan.org/NoAuth/Bugs.html?Dist=PGObject-Util-DBAdmin AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/PGObject-Util-DBAdmin CPAN Ratings http://cpanratings.perl.org/d/PGObject-Util-DBAdmin Search CPAN http://search.cpan.org/dist/PGObject-Util-DBAdmin/ LICENSE AND COPYRIGHT Copyright (C) 2014-2016 Chris Travers This program is distributed under the (Revised) BSD License: L Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Chris Travers's Organization nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. PGObject-Util-DBAdmin-0.100.0/Changes0000644000175000017500000000207313014621016020023 0ustar ehuelsmannehuelsmannRevision history for PGObject-Util-DBAdmin 0.100.0 2016-12-17 Publish 0.10 as 0.100; CPAN considers 0.09 equal to 0.090, which is higher than 0.10.0 (which is 0.010_000) 0.10.0 2016-12-17 Removed MYMETA.* (rt.cpan.org#109062) Correct spelling errors reported by Robert James Clay (jame@rocasa.ru) Correct copyright years (rt.cpan.org#117202 and #10) 0.09 2016-07-18 Fixed handling of &'s in db names 0.08 2016-02-11 Added ability to pass connection parameters to connect() 0.07 2015-07-16 Fixed handling of connection when connection fails 0.06 2014-09-18 Fixed support for remote hosts. 0.05 2014-09-14 Added backup of globals 0.04 2014-09-14 Additional tests Fixing packaging bugs Adding server_version api 0.03 2014-09-13 Better handling of auth environment variables so they don't always clobber Fixes to exception handling More tests 0.02 2014-09-12 Better error handling of external programs, using Tiny::Capture to process external stderr 0.01 2014-09-11 First version, released on an unsuspecting world. PGObject-Util-DBAdmin-0.100.0/META.json0000644000175000017500000000240013014621152020144 0ustar ehuelsmannehuelsmann{ "abstract" : "PostgreSQL Database Management Facilities for PGObject", "author" : [ "Chris Travers " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "PGObject-Util-DBAdmin", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Capture::Tiny" : "0", "DBD::Pg" : "0", "DBI" : "0", "Moo" : "0", "perl" : "5.008" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/einhverfr/PGObject-Util-DBAdmin.git", "web" : "https://github.com/einhverfr/PGObject-Util-DBAdmin" } }, "version" : "v0.100.0" } PGObject-Util-DBAdmin-0.100.0/MANIFEST0000644000175000017500000000064213014621152017662 0ustar ehuelsmannehuelsmannChanges ignore.txt lib/PGObject/Util/DBAdmin.pm Makefile.PL MANIFEST This list of files README t/00-load.t t/01-dbtests.t t/02-dbexceptions.t t/boilerplate.t t/data/backup.sqlc t/data/bad.sql t/data/schema.sql t/manifest.t t/pod-coverage.t t/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) PGObject-Util-DBAdmin-0.100.0/ignore.txt0000644000175000017500000000032413014613617020561 0ustar ehuelsmannehuelsmannMakefile Makefile.old Build Build.bat META.* MYMETA.* .build/ _build/ cover_db/ blib/ inc/ .lwpcookies .last_cover_stats nytprof.out pod2htm*.tmp pm_to_blib PGObject-Util-DBAdmin-* PGObject-Util-DBAdmin-*.tar.gz PGObject-Util-DBAdmin-0.100.0/META.yml0000644000175000017500000000125613014621152020004 0ustar ehuelsmannehuelsmann--- abstract: 'PostgreSQL Database Management Facilities for PGObject' author: - 'Chris Travers ' build_requires: Test::Exception: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PGObject-Util-DBAdmin no_index: directory: - t - inc requires: Capture::Tiny: '0' DBD::Pg: '0' DBI: '0' Moo: '0' perl: '5.008' resources: repository: https://github.com/einhverfr/PGObject-Util-DBAdmin.git version: v0.100.0 PGObject-Util-DBAdmin-0.100.0/t/0000755000175000017500000000000013014621152016772 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/t/pod-coverage.t0000644000175000017500000000111313014613617021535 0ustar ehuelsmannehuelsmann#!perl -T use 5.006; use strict; use warnings FATAL => 'all'; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); PGObject-Util-DBAdmin-0.100.0/t/data/0000755000175000017500000000000013014621152017703 5ustar ehuelsmannehuelsmannPGObject-Util-DBAdmin-0.100.0/t/data/bad.sql0000644000175000017500000000004013014613617021153 0ustar ehuelsmannehuelsmannCREATE TABLE foo (bar, text, ); PGObject-Util-DBAdmin-0.100.0/t/data/backup.sqlc0000644000175000017500000000377113014613617022053 0ustar ehuelsmannehuelsmannPGDMP ! rtest_db9.3.59.3.5 # 00ENCODINGENCODINGSET client_encoding = 'UTF8'; false$ 00 STDSTRINGS STDSTRINGS(SET standard_conforming_strings = 'on'; false% 1262280335test_dbDATABASEyCREATE DATABASE test_db WITH TEMPLATE = template0 ENCODING = 'UTF8' LC_COLLATE = 'en_US.UTF-8' LC_CTYPE = 'en_US.UTF-8'; DROP DATABASE test_db; chrisfalse26152200publicSCHEMACREATE SCHEMA public; DROP SCHEMA public; postgresfalse& 00 SCHEMA publicCOMMENT6COMMENT ON SCHEMA public IS 'standard public schema'; postgresfalse6' 00publicACL¢REVOKE ALL ON SCHEMA public FROM PUBLIC; REVOKE ALL ON SCHEMA public FROM postgres; GRANT ALL ON SCHEMA public TO postgres; GRANT ALL ON SCHEMA public TO PUBLIC; postgresfalse6«307912669plpgsql EXTENSION?CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog; DROP EXTENSION plpgsql; false( 00EXTENSION plpgsqlCOMMENT@COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language'; false171ª1259280336 test_dataTABLE*CREATE TABLE test_data ( test text ); DROP TABLE public.test_data; publicchrisfalse6 0280336 test_data TABLE DATA"COPY test_data (test) FROM stdin; publicchrisfalse170Ú xœ3äŠÑãââZäPGObject-Util-DBAdmin-0.100.0/t/data/schema.sql0000644000175000017500000000011713014613617021672 0ustar ehuelsmannehuelsmannCREATE TABLE test_data ( test text ); INSERT INTO test_data (test) values (1); PGObject-Util-DBAdmin-0.100.0/t/00-load.t0000644000175000017500000000040713014613617020323 0ustar ehuelsmannehuelsmann#!perl -T use 5.006; use strict; use warnings FATAL => 'all'; use Test::More; plan tests => 1; BEGIN { use_ok( 'PGObject::Util::DBAdmin' ) || print "Bail out!\n"; } diag( "Testing PGObject::Util::DBAdmin $PGObject::Util::DBAdmin::VERSION, Perl $], $^X" ); PGObject-Util-DBAdmin-0.100.0/t/02-dbexceptions.t0000644000175000017500000000216413014613617022077 0ustar ehuelsmannehuelsmannuse Test::More; use PGObject::Util::DBAdmin; use Test::Exception; plan skip_all => 'DB_TESTING not set' unless $ENV{DB_TESTING}; plan tests => 9; my $db = PGObject::Util::DBAdmin->new( username => 'postgres' , host => 'localhost' , port => '5432' , dbname => 'pgobject_test_db', ); eval { $db->drop }; lives_ok { $db->create } 'Create db, none exists'; dies_ok { $db->create } 'create db, already exists'; dies_ok { $db->run_file(file => 't/data/does_not_exist.sql') } 'bad file input for run_file'; dies_ok { $db->run_file(file => 't/data/bad.sql') } 'sql file errors'; lives_ok { $db->drop } 'drop db first time, successful'; dies_ok { $db->drop } 'dropdb second time, dies'; dies_ok { $db->backup(format => 'c') } 'cannot back up non-existent db'; dies_ok { $db->restore(format => 'c', file => 't/data/backup.sqlc') } 'cannot restore to non-existent db'; $db = PGObject::Util::DBAdmin->new( username => 'postgres' , host => 'localhost' , port => '2' , dbname => 'pgobject_test_db', ); dies_ok { $db->connect } 'Could not connect'; PGObject-Util-DBAdmin-0.100.0/t/boilerplate.t0000644000175000017500000000241313014613617021470 0ustar ehuelsmannehuelsmann#!perl -T use 5.006; use strict; use warnings FATAL => 'all'; use Test::More; plan tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open( my $fh, '<', $filename ) or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); module_boilerplate_ok('lib/PGObject/Util/DBAdmin.pm'); PGObject-Util-DBAdmin-0.100.0/t/manifest.t0000644000175000017500000000050713014613617020776 0ustar ehuelsmannehuelsmann#!perl -T use 5.006; use strict; use warnings FATAL => 'all'; use Test::More; unless ( $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } my $min_tcm = 0.9; eval "use Test::CheckManifest $min_tcm"; plan skip_all => "Test::CheckManifest $min_tcm required" if $@; ok_manifest(); PGObject-Util-DBAdmin-0.100.0/t/pod.t0000644000175000017500000000040113014613617017743 0ustar ehuelsmannehuelsmann#!perl -T use 5.006; use strict; use warnings FATAL => 'all'; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); PGObject-Util-DBAdmin-0.100.0/t/01-dbtests.t0000644000175000017500000000374113014613617021061 0ustar ehuelsmannehuelsmannuse Test::More; use PGObject::Util::DBAdmin; plan skip_all => 'DB_TESTING not set' unless $ENV{DB_TESTING}; plan tests => 33; # Constructor my $dbh; my $db; ok($db = PGObject::Util::DBAdmin->new( username => 'postgres', password => undef, dbname => 'pgobject_test_db', host => 'localhost', port => '5432' ), 'Created db admin object'); # Drop db if exists eval { $db->drop }; ok($db->backup_globals, 'can backup globals'); # List dbs my @dblist; ok(@dblist = $db->list_dbs, 'Got a db list'); ok (!grep {$_ eq 'pgobject_test_db'} @dblist, 'DB list does not contain pgobject_test_db'); # Create db $db->create; ok($db->server_version, 'Got a server version'); ok (grep {$_ eq 'pgobject_test_db'} $db->list_dbs, 'DB list does contain pgobject_test_db after create call'); # load with schema ok ($db->run_file(file => 't/data/schema.sql'), 'Loaded schema'); ok ($dbh = $db->connect, 'Got dbi handle'); my ($foo) = @{ $dbh->selectall_arrayref('select count(*) from test_data') }; is ($foo->[0], 1, 'Correct count of data') ; $dbh->disconnect; # backup/drop/create/restore, formats undef, p, and c no warnings; for ((undef, 'p', 'c')) { my $backup; ok($backup = $db->backup( format => $_, tempdir => 't/var/', ), 'Made backup, format ' . $_ || 'undef'); ok($db->drop, 'dropped db, format ' . $_ || 'undef'); ok (!(grep{$_ eq 'pgobject_test_db'} @dblist), 'DB list does not contain pgobject_test_db'); ok($db->create, 'created db, format ' . $_ || 'undef'); ok($dbh = $db->connect, 'Got dbi handle ' . $_ || 'undef'); ok($db->restore( format => $_, file => $backup, ), 'Restored backup, format ' . $_ || 'undef'); ok(($foo) = $dbh->selectall_arrayref('select count(*) from test_data'), 'Got results from test data count ' . $_ || 'undef'); is($foo->[0]->[0], 1, 'correct data count ' . $_ || 'undef'); $dbh->disconnect; unlink $backup; }