[Bast-commits] r8326 - in DBIx-Class/0.08/branches/dbicadmin_refactor: lib/DBIx/Class script t t/admin

goraxe at dev.catalyst.perl.org goraxe at dev.catalyst.perl.org
Fri Jan 15 18:00:17 GMT 2010


Author: goraxe
Date: 2010-01-15 18:00:17 +0000 (Fri, 15 Jan 2010)
New Revision: 8326

Modified:
   DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm
   DBIx-Class/0.08/branches/dbicadmin_refactor/script/dbicadmin
   DBIx-Class/0.08/branches/dbicadmin_refactor/t/89dbicadmin.t
   DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t
   DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/03data.t
Log:
change white space to not be tabs

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm	2010-01-15 16:13:28 UTC (rev 8325)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm	2010-01-15 18:00:17 UTC (rev 8326)
@@ -1,4 +1,4 @@
-#
+# vim: et ts=2
 #===============================================================================
 #
 #         FILE:  Admin.pm
@@ -18,7 +18,7 @@
 
 use Moose;
 use MooseX::Types 
-	-declare => [qw( DBICConnectInfo )];
+-declare => [qw( DBICConnectInfo )];
 use MooseX::Types::Moose qw/Int HashRef ArrayRef Str Any/;
 use MooseX::Types::JSON qw(JSON);
 use MooseX::Types::Path::Class qw(Dir File);
@@ -33,27 +33,27 @@
 my @_deps = qw(Moose MooseX::Types MooseX::Types::JSON MooseX::Types::Path::Class Try::Tiny parent JSON::Any Class::C3::Componentised namespace::autoclean);
 
 coerce ArrayRef,
-	from JSON,
-	via { _json_to_data ($_) };
+from JSON,
+via { _json_to_data ($_) };
 
 coerce HashRef,
-	from JSON,
-	via { _json_to_data($_) };
+from JSON,
+via { _json_to_data($_) };
 
 subtype DBICConnectInfo,
-	as ArrayRef;
+as ArrayRef;
 
 coerce DBICConnectInfo,
-	from JSON,
-	 via { return _json_to_data($_) } ;
+from JSON,
+via { return _json_to_data($_) } ;
 
 coerce DBICConnectInfo,
-	from Str,
-		via { return _json_to_data($_) };
+from Str,
+via { return _json_to_data($_) };
 
 coerce DBICConnectInfo,
-	from HashRef,
-	 via { [ $_->{dsn}, $_->{user}, $_->{password} ]  };
+from HashRef,
+via { [ $_->{dsn}, $_->{user}, $_->{password} ]  };
 
 =head1 NAME
 
@@ -61,26 +61,26 @@
 
 =head1 SYNOPSIS
 
-	use DBIx::Class::Admin;
+  use DBIx::Class::Admin;
 
-	# ddl manipulation
-	my $admin = DBIx::Class::Admin->new(
-		schema_class=> 'MY::Schema',
-		sql_dir=> $sql_dir,
-		connect_info => { dsn => $dsn, user => $user, password => $pass },
-	);
+  # ddl manipulation
+  my $admin = DBIx::Class::Admin->new(
+    schema_class=> 'MY::Schema',
+    sql_dir=> $sql_dir,
+    connect_info => { dsn => $dsn, user => $user, password => $pass },
+  );
 
-	# create SQLite sql
-	$admin->create('SQLite');
+  # create SQLite sql
+  $admin->create('SQLite');
 
-	# create SQL diff for an upgrade
-	$admin->create('SQLite', {} , "1.0");
+  # create SQL diff for an upgrade
+  $admin->create('SQLite', {} , "1.0");
 
-	# upgrade a database
-	$admin->upgrade();
+  # upgrade a database
+  $admin->upgrade();
 
-	# install a version for an unversioned schema
-	$admin->install("3.0");
+  # install a version for an unversioned schema
+  $admin->install("3.0");
 
 =head1 Attributes
 
@@ -89,15 +89,15 @@
 add a library search path
 =cut
 has lib => (
-	is		=> 'ro',
-	isa		=> Dir,
-	coerce	=> 1,
-	trigger => \&_set_inc,
+is		=> 'ro',
+isa		=> Dir,
+coerce	=> 1,
+trigger => \&_set_inc,
 );
 
 sub _set_inc {
-	my ($self, $lib) = @_;
-	push @INC, $lib->stringify;
+    my ($self, $lib) = @_;
+    push @INC, $lib->stringify;
 }
 
 =head2 schema_class
@@ -105,9 +105,9 @@
 the class of the schema to load
 =cut
 has 'schema_class' => (
-	is		=> 'ro',
-	isa		=> 'Str',
-	coerce	=> 1,
+is		=> 'ro',
+isa		=> 'Str',
+coerce	=> 1,
 );
 
 =head2 schema
@@ -115,17 +115,17 @@
 A pre-connected schema object can be provided for manipulation
 =cut
 has 'schema' => (
-	is			=> 'ro',
-	isa			=> 'DBIx::Class::Schema',
-	lazy_build	=> 1,
+is			=> 'ro',
+isa			=> 'DBIx::Class::Schema',
+lazy_build	=> 1,
 );
 
 sub _build_schema {
-	my ($self)  = @_;
-	$self->ensure_class_loaded($self->schema_class);
+    my ($self)  = @_;
+    $self->ensure_class_loaded($self->schema_class);
 
-	$self->connect_info->[3]->{ignore_version} =1;
-	return $self->schema_class->connect(@{$self->connect_info()} ); # ,  $self->connect_info->[3], { ignore_version => 1} );
+    $self->connect_info->[3]->{ignore_version} =1;
+    return $self->schema_class->connect(@{$self->connect_info()} ); # ,  $self->connect_info->[3], { ignore_version => 1} );
 }
 
 =head2 resultset
@@ -133,8 +133,8 @@
 a resultset from the schema to operate on
 =cut
 has 'resultset' => (
-	is			=> 'rw',
-	isa			=> Str,
+is			=> 'rw',
+isa			=> Str,
 );
 
 =head2 where
@@ -143,9 +143,9 @@
 =cut
 
 has 'where' => (
-	is			=> 'rw',
-	isa			=> HashRef,
-	coerce		=> 1,
+is			=> 'rw',
+isa			=> HashRef,
+coerce		=> 1,
 );
 
 =head2 set
@@ -153,18 +153,18 @@
 =cut
 
 has 'set' => (
-	is			=> 'rw',
-	isa			=> HashRef,
-	coerce		=> 1,
+is			=> 'rw',
+isa			=> HashRef,
+coerce		=> 1,
 );
 
 =head2 attrs
 a hash ref or json string to be used for passing additonal info to the ->search call
 =cut
 has 'attrs' => (
-	is 			=> 'rw',
-	isa			=> HashRef,
-	coerce		=> 1,
+is 			=> 'rw',
+isa			=> HashRef,
+coerce		=> 1,
 );
 =head2 connect_info
 
@@ -173,15 +173,15 @@
 
 
 has 'connect_info' => (
-	is			=> 'ro',
-	isa			=> DBICConnectInfo,
-	lazy_build	=> 1,
-	coerce		=> 1,
+is			=> 'ro',
+isa			=> DBICConnectInfo,
+lazy_build	=> 1,
+coerce		=> 1,
 );
 
 sub _build_connect_info {
-	my ($self) = @_;
-	return $self->_find_stanza($self->config, $self->config_stanza);
+    my ($self) = @_;
+    return $self->_find_stanza($self->config, $self->config_stanza);
 }
 
 =head2 config_file
@@ -191,9 +191,9 @@
 The config file should be in a format readable by Config::General
 =cut
 has config_file => (
-	is			=> 'ro',
-	isa			=> File,
-	coerce		=> 1,
+is			=> 'ro',
+isa			=> File,
+coerce		=> 1,
 );
 
 =head2 config_stanza
@@ -202,8 +202,8 @@
 designed for use with catalyst config files
 =cut
 has 'config_stanza' => (
-	is			=> 'ro',
-	isa			=> 'Str',
+is			=> 'ro',
+isa			=> 'Str',
 );
 
 =head2 config
@@ -212,20 +212,20 @@
 config_stanza will still be required.
 =cut
 has config => (
-	is			=> 'ro',
-	isa			=> HashRef,
-	lazy_build	=> 1,
+is			=> 'ro',
+isa			=> HashRef,
+lazy_build	=> 1,
 );
 
 sub _build_config {
-	my ($self) = @_;
-	try { require 'Config::Any'; } catch { die "Config::Any is required to parse the config file"; };
+    my ($self) = @_;
+    try { require 'Config::Any'; } catch { die "Config::Any is required to parse the config file"; };
 
-	my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
+    my $cfg = Config::Any->load_files ( {files => [$self->config_file], use_ext =>1, flatten_to_hash=>1});
 
-	# just grab the config from the config file
-	$cfg = $cfg->{$self->config_file};
-	return $cfg;
+    # just grab the config from the config file
+    $cfg = $cfg->{$self->config_file};
+    return $cfg;
 }
 
 =head2 sql_dir
@@ -233,9 +233,9 @@
 The location where sql ddl files should be created or found for an upgrade.
 =cut
 has 'sql_dir' => (
-	is			=> 'ro',
-	isa			=> Dir,
-	coerce		=> 1,
+is			=> 'ro',
+isa			=> Dir,
+coerce		=> 1,
 );
 
 =head2 version
@@ -243,8 +243,8 @@
 Used for install, the version which will be 'installed' in the schema
 =cut
 has version => (
-	is			=> 'rw',
-	isa			=> 'Str',
+is			=> 'rw',
+isa			=> 'Str',
 );
 
 =head2 preversion
@@ -252,8 +252,8 @@
 Previouse version of the schema to create an upgrade diff for, the full sql for that version of the sql must be in the sql_dir
 =cut
 has preversion => (
-	is			=> 'rw',
-	isa			=> 'Str',
+is			=> 'rw',
+isa			=> 'Str',
 );
 
 =head2 force
@@ -261,8 +261,8 @@
 Try and force certain operations.
 =cut
 has force => (
-	is			=> 'rw',
-	isa			=> 'Bool',
+is			=> 'rw',
+isa			=> 'Bool',
 );
 
 =head2 quiet
@@ -270,13 +270,13 @@
 Be less verbose about actions
 =cut
 has quiet => (
-	is			=> 'rw',
-	isa			=> 'Bool',
+is			=> 'rw',
+isa			=> 'Bool',
 );
 
 has '_confirm' => (
-	is		=> 'bare',
-	isa		=> 'Bool',
+is		=> 'bare',
+isa		=> 'Bool',
 );
 
 =head1 METHODS
@@ -298,15 +298,15 @@
 =cut
 
 sub create {
-	my ($self, $sqlt_type, $sqlt_args, $preversion) = @_;
+    my ($self, $sqlt_type, $sqlt_args, $preversion) = @_;
 
-	$preversion ||= $self->preversion();
+    $preversion ||= $self->preversion();
 
-	my $schema = $self->schema();
-	# create the dir if does not exist
-	$self->sql_dir->mkpath() if ( ! -d $self->sql_dir);
+    my $schema = $self->schema();
+    # create the dir if does not exist
+    $self->sql_dir->mkpath() if ( ! -d $self->sql_dir);
 
-	$schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
+    $schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $preversion, $sqlt_args );
 }
 
 =head2 upgrade
@@ -322,15 +322,15 @@
 =cut
 
 sub upgrade {
-	my ($self) = @_;
-	my $schema = $self->schema();
-	if (!$schema->get_db_version()) {
-		# schema is unversioned
-		die "could not determin current schema version, please either install or deploy";
-	} else {
-		my $ret = $schema->upgrade();
-		return $ret;
-	}
+    my ($self) = @_;
+    my $schema = $self->schema();
+    if (!$schema->get_db_version()) {
+        # schema is unversioned
+        die "could not determin current schema version, please either install or deploy";
+    } else {
+        my $ret = $schema->upgrade();
+        return $ret;
+    }
 }
 
 =head2 install
@@ -347,26 +347,26 @@
 already versioned databases.
 =cut
 sub install {
-	my ($self, $version) = @_;
+    my ($self, $version) = @_;
 
-	my $schema = $self->schema();
-	$version ||= $self->version();
-	if (!$schema->get_db_version() ) {
-		# schema is unversioned
-		print "Going to install schema version\n";
-		my $ret = $schema->install($version);
-		print "retun is $ret\n";
-	}
-	elsif ($schema->get_db_version() and $self->force ) {
-		warn "forcing install may not be a good idea";
-		if($self->_confirm() ) {
-			# FIXME private api
-			$self->schema->_set_db_version({ version => $version});
-		}
-	}
-	else {
-		die "schema already has a version not installing, try upgrade instead";
-	}
+    my $schema = $self->schema();
+    $version ||= $self->version();
+    if (!$schema->get_db_version() ) {
+        # schema is unversioned
+        print "Going to install schema version\n";
+        my $ret = $schema->install($version);
+        print "retun is $ret\n";
+    }
+    elsif ($schema->get_db_version() and $self->force ) {
+        warn "forcing install may not be a good idea";
+        if($self->_confirm() ) {
+            # FIXME private api
+            $self->schema->_set_db_version({ version => $version});
+        }
+    }
+    else {
+        die "schema already has a version not installing, try upgrade instead";
+    }
 
 }
 
@@ -382,15 +382,15 @@
 L<DBIx::Class::Schema/deploy>.  
 =cut
 sub deploy {
-	my ($self, $args) = @_;
-	my $schema = $self->schema();
-	if (!$schema->get_db_version() ) {
-		# schema is unversioned
-		$schema->deploy( $args, $self->sql_dir)
-			or die "could not deploy schema";
-	} else {
-		die "there already is a database with a version here, try upgrade instead";
-	}
+    my ($self, $args) = @_;
+    my $schema = $self->schema();
+    if (!$schema->get_db_version() ) {
+        # schema is unversioned
+        $schema->deploy( $args, $self->sql_dir)
+            or die "could not deploy schema";
+    } else {
+        die "there already is a database with a version here, try upgrade instead";
+    }
 }
 
 
@@ -411,13 +411,13 @@
 
 =cut
 sub insert {
-	my ($self, $rs, $set) = @_;
+    my ($self, $rs, $set) = @_;
 
-	$rs ||= $self->resultset();
-	$set ||= $self->set();
-	my $resultset = $self->schema->resultset($rs);
-	my $obj = $resultset->create( $set );
-	print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet);
+    $rs ||= $self->resultset();
+    $set ||= $self->set();
+    my $resultset = $self->schema->resultset($rs);
+    my $obj = $resultset->create( $set );
+    print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet);
 }
 
 
@@ -433,20 +433,20 @@
 a where hash used to form the search for the rows to update. 
 =cut
 sub update {
-	my ($self, $rs, $set, $where) = @_;
+    my ($self, $rs, $set, $where) = @_;
 
-	$rs ||= $self->resultset();
-	$where ||= $self->where();
-	$set ||= $self->set();
-	my $resultset = $self->schema->resultset($rs);
-	$resultset = $resultset->search( ($where||{}) );
+    $rs ||= $self->resultset();
+    $where ||= $self->where();
+    $set ||= $self->set();
+    my $resultset = $self->schema->resultset($rs);
+    $resultset = $resultset->search( ($where||{}) );
 
-	my $count = $resultset->count();
-	print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
+    my $count = $resultset->count();
+    print "This action will modify $count ".ref($resultset)." records.\n" if (!$self->quiet);
 
-	if ( $self->force || $self->_confirm() ) {
-		$resultset->update_all( $set );
-	}
+    if ( $self->force || $self->_confirm() ) {
+        $resultset->update_all( $set );
+    }
 }
 
 # FIXME
@@ -463,20 +463,20 @@
 The found data is deleted and cannot be recovered.
 =cut
 sub delete {
-	my ($self, $rs, $where, $attrs) = @_;
+    my ($self, $rs, $where, $attrs) = @_;
 
-	$rs ||= $self->resultset();
-	$where ||= $self->where();
-	$attrs ||= $self->attrs();
-	my $resultset = $self->schema->resultset($rs);
-	$resultset = $resultset->search( ($where||{}), ($attrs||()) );
+    $rs ||= $self->resultset();
+    $where ||= $self->where();
+    $attrs ||= $self->attrs();
+    my $resultset = $self->schema->resultset($rs);
+    $resultset = $resultset->search( ($where||{}), ($attrs||()) );
 
-	my $count = $resultset->count();
-	print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
+    my $count = $resultset->count();
+    print "This action will delete $count ".ref($resultset)." records.\n" if (!$self->quiet);
 
-	if ( $self->force || $self->_confirm() ) {
-		$resultset->delete_all();
-	}
+    if ( $self->force || $self->_confirm() ) {
+        $resultset->delete_all();
+    }
 }
 
 =head2 select
@@ -492,58 +492,58 @@
 
 =cut
 sub select {
-	my ($self, $rs, $where, $attrs) = @_;
+    my ($self, $rs, $where, $attrs) = @_;
 
-	$rs ||= $self->resultset();
-	$where ||= $self->where();
-	$attrs ||= $self->attrs();
-	my $resultset = $self->schema->resultset($rs);
-	$resultset = $resultset->search( ($where||{}), ($attrs||()) );
+    $rs ||= $self->resultset();
+    $where ||= $self->where();
+    $attrs ||= $self->attrs();
+    my $resultset = $self->schema->resultset($rs);
+    $resultset = $resultset->search( ($where||{}), ($attrs||()) );
 
-	my @data;
-	my @columns = $resultset->result_source->columns();
-	push @data, [@columns];# 
+    my @data;
+    my @columns = $resultset->result_source->columns();
+    push @data, [@columns];# 
 
-	while (my $row = $resultset->next()) {
-		my @fields;
-		foreach my $column (@columns) {
-			push( @fields, $row->get_column($column) );
-		}
-		push @data, [@fields];
-	}
+    while (my $row = $resultset->next()) {
+        my @fields;
+        foreach my $column (@columns) {
+            push( @fields, $row->get_column($column) );
+        }
+        push @data, [@fields];
+    }
 
-	return \@data;
+    return \@data;
 }
 
 sub _confirm {
-	my ($self) = @_;
-	print "Are you sure you want to do this? (type YES to confirm) \n";
-	# mainly here for testing
-	return 1 if ($self->meta->get_attribute('_confirm')->get_value($self));
-	my $response = <STDIN>;
-	return 1 if ($response=~/^YES/);
-	return;
+    my ($self) = @_;
+    print "Are you sure you want to do this? (type YES to confirm) \n";
+    # mainly here for testing
+    return 1 if ($self->meta->get_attribute('_confirm')->get_value($self));
+    my $response = <STDIN>;
+    return 1 if ($response=~/^YES/);
+    return;
 }
 
 sub _find_stanza {
-	my ($self, $cfg, $stanza) = @_;
-	my @path = split /::/, $stanza;
-	while (my $path = shift @path) {
-		if (exists $cfg->{$path}) {
-			$cfg = $cfg->{$path};
-		}
-		else {
-			die "could not find $stanza in config, $path did not seem to exist";
-		}
-	}
-	return $cfg;
+    my ($self, $cfg, $stanza) = @_;
+    my @path = split /::/, $stanza;
+    while (my $path = shift @path) {
+        if (exists $cfg->{$path}) {
+            $cfg = $cfg->{$path};
+        }
+        else {
+            die "could not find $stanza in config, $path did not seem to exist";
+        }
+    }
+    return $cfg;
 }
 
 sub _json_to_data {
-	my ($json_str) = @_;
-	my $json = JSON::Any->new(allow_barekey => 1, allow_singlequote => 1, relaxed=>1);
-	my $ret = $json->jsonToObj($json_str);
-	return $ret;
+    my ($json_str) = @_;
+    my $json = JSON::Any->new(allow_barekey => 1, allow_singlequote => 1, relaxed=>1);
+    my $ret = $json->jsonToObj($json_str);
+    return $ret;
 }
 
 
@@ -551,14 +551,14 @@
 
 my @_missing_deps;
 foreach my $dep (@_deps) {
-	eval "require $dep";
-	if ($@) {
-		push @_missing_deps, $dep;
-	}
+    eval "require $dep";
+    if ($@) {
+        push @_missing_deps, $dep;
+    }
 }
 
 if (@_missing_deps > 0) {
-	die "The following dependecies are missing " . join ",", @_missing_deps;
+    die "The following dependecies are missing " . join ",", @_missing_deps;
 }
 
 

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/script/dbicadmin
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/script/dbicadmin	2010-01-15 16:13:28 UTC (rev 8325)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/script/dbicadmin	2010-01-15 18:00:17 UTC (rev 8326)
@@ -1,59 +1,54 @@
-#!/usr/bin/perl 
-
+#!/usr/bin/perl
+# vim: ts=2 et
 use strict;
 use warnings;
 
 use Getopt::Long::Descriptive;
-
-use FindBin qw($Bin);
-use Path::Class;
-use lib dir($Bin,'..','lib')->stringify;
-
 use DBIx::Class::Admin;
 
 
 my ($opts, $usage) = describe_options(
-	"%c: %o",
-	(
-		['Actions'],
-		["action" => hidden => { one_of => [
-			['create|c' => 'Create version diffs needs preversion',],
-			['upgrade|u' => 'Upgrade the database to the current schema '],
-			['install|i' => 'Install the schema to the database',],
-			['deploy|d' => 'Deploy the a to the database',],
-			['select|s'   => 'Select data from the schema', ],
-			['insert|i'   => 'Insert data into the schema', ],
-			['update|u'   => 'Update data in the schema', ], 
-			['delete|D'   => 'Delete data from the schema',],
-			['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
-			['help|h' => 'display this help'],
-		], required=> 1 }],
-		['Options'],
-		['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ],
-		['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ],
-		['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
-		['config|f:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
-		['connect-info|n:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
-		['connect:s' => 'Supply the connect info as a json string' ],
-		['sql-dir|q:s' => 'The directory where sql diffs will be created'],
-		['sql-type|t:s' => 'The RDBMs flavour you wish to use'],
-		['version|v:i' => 'Supply a version install'],
-		['preversion|p:s' => 'The previous version to diff against',],
-		['set:s' => 'JSON data used to perform data operations' ],
-		['lib|I:s' => 'Additonal library path to search in'], 
-		['attrs:s' => 'JSON string to be used for the second argument for search'],
-		['where:s' => 'JSON string to be used for the where clause of search'],
-		['force' => 'Be forceful with some operations'],
-		['trace' => 'Turn on DBIx::Class trace output'],
-		['tlibs' => 'Include test dirs in @INC'],
-		['quiet' => 'Be less verbose'],
-	)
+    "%c: %o",
+    (
+        ['Actions'],
+        ["action" => hidden => { one_of => [
+            ['create|c' => 'Create version diffs needs preversion',],
+            ['upgrade|u' => 'Upgrade the database to the current schema '],
+            ['install|i' => 'Install the schema to the database',],
+            ['deploy|d' => 'Deploy the a to the database',],
+            ['select|s'   => 'Select data from the schema', ],
+            ['insert|i'   => 'Insert data into the schema', ],
+            ['update|u'   => 'Update data in the schema', ], 
+            ['delete|D'   => 'Delete data from the schema',],
+            ['op:s' => 'compatiblity option all of the above can be suppied as --op=<action>'],
+            ['help|h' => 'display this help'],
+            ], required=> 1 }],
+        ['Options'],
+        ['schema-class|schema|C:s' => 'The class of the schema to load', { required => 1 } ],
+        ['resultset|resultset_class|class|r:s' => 'The resultset to operate on for data manipulation' ],
+        ['config-stanza|S:s' => 'Where in the config to find the connection_info, supply in form MyApp::Model::DB',],
+        ['config|f:s' => 'Supply the config file for parsing by Config::Any', { depends => 'config_stanza'} ],
+        ['connect-info|n:s%' => 'Supply the connect info as additonal options ie -I dsn=<dsn> user=<user> password=<pass> '],
+        ['connect:s' => 'Supply the connect info as a json string' ],
+        ['sql-dir|q:s' => 'The directory where sql diffs will be created'],
+        ['sql-type|t:s' => 'The RDBMs flavour you wish to use'],
+        ['version|v:i' => 'Supply a version install'],
+        ['preversion|p:s' => 'The previous version to diff against',],
+        ['set:s' => 'JSON data used to perform data operations' ],
+        ['lib|I:s' => 'Additonal library path to search in'], 
+        ['attrs:s' => 'JSON string to be used for the second argument for search'],
+        ['where:s' => 'JSON string to be used for the where clause of search'],
+        ['force' => 'Be forceful with some operations'],
+        ['trace' => 'Turn on DBIx::Class trace output'],
+        ['tlibs' => 'Include test dirs in @INC'],
+        ['quiet' => 'Be less verbose'],
+    )
 );
 
 
 if ($opts->{help}) {
-	print $usage->text;
-	exit 0;
+    print $usage->text;
+    exit 0;
 }
 
 if ($opts->{tlibs}) {
@@ -64,7 +59,7 @@
 
 # option compatability mangle
 if($opts->{connect}) {
-	$opts->{connect_info} = delete $opts->{connect};
+    $opts->{connect_info} = delete $opts->{connect};
 }
 
 my $admin = DBIx::Class::Admin->new( %$opts );
@@ -78,24 +73,24 @@
 print "going to perform action $action\n";
 if ($action eq 'select') {
 
-	my $csv_class;
-	my $format = $opts->{format} || 'tsv';
-	die('Invalid format') if ($format!~/^tsv|csv$/s);
-	$csv_class = 'Text::CSV_XS';
-	eval{ require Text::CSV_XS };
-	if ($@) {
-		$csv_class = 'Text::CSV_PP';
-		eval{ require Text::CSV_PP };
-		die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@);
-	}
+    my $csv_class;
+    my $format = $opts->{format} || 'tsv';
+    die('Invalid format') if ($format!~/^tsv|csv$/s);
+    $csv_class = 'Text::CSV_XS';
+    eval{ require Text::CSV_XS };
+    if ($@) {
+        $csv_class = 'Text::CSV_PP';
+        eval{ require Text::CSV_PP };
+        die('The select op requires either the Text::CSV_XS or the Text::CSV_PP module') if ($@);
+    }
 
-	my $csv = $csv_class->new({
-			sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
-		});
-	foreach my $row (@$res) {
-		$csv->combine( @$row );
-		print $csv->string()."\n";
-	}
+    my $csv = $csv_class->new({
+            sep_char => ( $format eq 'tsv' ? "\t" : ',' ),
+        });
+    foreach my $row (@$res) {
+        $csv->combine( @$row );
+        print $csv->string()."\n";
+    }
 }
 
 

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/t/89dbicadmin.t
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/t/89dbicadmin.t	2010-01-15 16:13:28 UTC (rev 8325)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/t/89dbicadmin.t	2010-01-15 18:00:17 UTC (rev 8326)
@@ -1,4 +1,4 @@
-# vim: filetype=perl
+# vim: filetype=perl et ts=2
 use strict;
 use warnings;  
 
@@ -64,8 +64,8 @@
         my $data = do { local $/; <$fh> };
         close($fh);
         if (!ok( ($data=~/Aran.*Trout/s), "$ENV{JSON_ANY_ORDER}: select with attrs" )) {
-			diag ("data from select is $data")
-		};
+            diag ("data from select is $data")
+        };
     }
 
     system( _prepare_system_args( qw|--op=delete --where={"name":"Trout"}| ) );

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t	2010-01-15 16:13:28 UTC (rev 8325)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t	2010-01-15 18:00:17 UTC (rev 8326)
@@ -1,4 +1,4 @@
-#
+# vim: et ts=2
 #===============================================================================
 #
 #         FILE:  02admin..t
@@ -40,24 +40,24 @@
 
 my $sql_dir = dir($Bin,"..","var");
 my @connect_info = DBICTest->_database(
-	no_deploy=>1,
-	no_populate=>1,
-	sqlite_use_file	=> 1,
+    no_deploy=>1,
+    no_populate=>1,
+    sqlite_use_file	=> 1,
 );
 { # create the schema
 
 #  make sure we are  clean
-clean_dir($sql_dir);
+    clean_dir($sql_dir);
 
 
-my $admin = DBIx::Class::Admin->new(
-	schema_class=> "DBICTest::Schema",
-	sql_dir=> $sql_dir,
-	connect_info => \@connect_info, 
-);
-isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
-lives_ok { $admin->create('MySQL'); } 'Can create MySQL sql';
-lives_ok { $admin->create('SQLite'); } 'Can Create SQLite sql';
+    my $admin = DBIx::Class::Admin->new(
+        schema_class=> "DBICTest::Schema",
+        sql_dir=> $sql_dir,
+        connect_info => \@connect_info, 
+    );
+    isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
+    lives_ok { $admin->create('MySQL'); } 'Can create MySQL sql';
+    lives_ok { $admin->create('SQLite'); } 'Can Create SQLite sql';
 }
 
 { # upgrade schema
@@ -68,77 +68,77 @@
 #	sqlite_use_file	=> 1,
 #);
 
-clean_dir($sql_dir);
-load 'DBICVersionOrig';
+    clean_dir($sql_dir);
+    load 'DBICVersionOrig';
 
-my $admin = DBIx::Class::Admin->new(
-	schema_class => 'DBICVersion::Schema', 
-	sql_dir =>  $sql_dir,
-	connect_info => \@connect_info,
-);
+    my $admin = DBIx::Class::Admin->new(
+        schema_class => 'DBICVersion::Schema', 
+        sql_dir =>  $sql_dir,
+        connect_info => \@connect_info,
+    );
 
-my $schema = $admin->schema();
+    my $schema = $admin->schema();
 
-lives_ok { $admin->create($schema->storage->sqlt_type(), {add_drop_table=>0}); } 'Can create DBICVersionOrig sql in ' . $schema->storage->sqlt_type;
-lives_ok { $admin->deploy(  ) } 'Can Deploy schema';
+    lives_ok { $admin->create($schema->storage->sqlt_type(), {add_drop_table=>0}); } 'Can create DBICVersionOrig sql in ' . $schema->storage->sqlt_type;
+    lives_ok { $admin->deploy(  ) } 'Can Deploy schema';
 
 # connect to now deployed schema
-lives_ok { $schema = DBICVersion::Schema->connect(@{$schema->storage->connect_info()}); } 'Connect to deployed Database';
+    lives_ok { $schema = DBICVersion::Schema->connect(@{$schema->storage->connect_info()}); } 'Connect to deployed Database';
 
-is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema deployed and versions match');
+    is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema deployed and versions match');
 
 
-load 'DBICVersionNew';
+    load 'DBICVersionNew';
 
-$admin = DBIx::Class::Admin->new(
-	schema_class => 'DBICVersion::Schema', 
-	sql_dir =>  "t/var",
-	connect_info => \@connect_info
-);
+    $admin = DBIx::Class::Admin->new(
+        schema_class => 'DBICVersion::Schema', 
+        sql_dir =>  "t/var",
+        connect_info => \@connect_info
+    );
 
-lives_ok { $admin->create($schema->storage->sqlt_type(), {}, "1.0" ); } 'Can create diff for ' . $schema->storage->sqlt_type;
+    lives_ok { $admin->create($schema->storage->sqlt_type(), {}, "1.0" ); } 'Can create diff for ' . $schema->storage->sqlt_type;
 # sleep required for upgrade table to hold a distinct time of upgrade value
 # otherwise the returned of get_db_version can be undeterministic
-sleep 1;
-lives_ok {$admin->upgrade();} 'upgrade the schema';
+    sleep 1;
+    lives_ok {$admin->upgrade();} 'upgrade the schema';
 
-is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema and db versions match');
+    is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema and db versions match');
 
 }
 
 { # install
 
-clean_dir($sql_dir);
+    clean_dir($sql_dir);
 
-my $admin = DBIx::Class::Admin->new(
-	schema_class	=> 'DBICVersion::Schema', 
-	sql_dir			=> $sql_dir,
-	_confirm		=> 1,
-	connect_info	=> \@connect_info,
-);
+    my $admin = DBIx::Class::Admin->new(
+        schema_class	=> 'DBICVersion::Schema', 
+        sql_dir			=> $sql_dir,
+        _confirm		=> 1,
+        connect_info	=> \@connect_info,
+    );
 
-$admin->version("3.0");
-lives_ok { $admin->install(); } 'install schema version 3.0';
-is($admin->schema->get_db_version, "3.0", 'db thinks its version 3.0');
-dies_ok { $admin->install("4.0"); } 'cannot install to allready existing version';
-sleep 1;
-$admin->force(1);
-lives_ok { $admin->install("4.0"); } 'can force install to allready existing version';
-is($admin->schema->get_db_version, "4.0", 'db thinks its version 4.0');
+    $admin->version("3.0");
+    lives_ok { $admin->install(); } 'install schema version 3.0';
+    is($admin->schema->get_db_version, "3.0", 'db thinks its version 3.0');
+    dies_ok { $admin->install("4.0"); } 'cannot install to allready existing version';
+    sleep 1;
+    $admin->force(1);
+    lives_ok { $admin->install("4.0"); } 'can force install to allready existing version';
+    is($admin->schema->get_db_version, "4.0", 'db thinks its version 4.0');
 #clean_dir($sql_dir);
 }
 
 sub clean_dir {
-	my ($dir)  =@_;
-	$dir = $dir->resolve;
-	if ( ! -d $dir ) {
-		$dir->mkpath();
-	}
-	foreach my $file ($dir->children) {
-		# skip any hidden files
-		next if ($file =~ /^\./); 
-		unlink $file;
-	}
+    my ($dir)  =@_;
+    $dir = $dir->resolve;
+    if ( ! -d $dir ) {
+        $dir->mkpath();
+    }
+    foreach my $file ($dir->children) {
+        # skip any hidden files
+        next if ($file =~ /^\./); 
+        unlink $file;
+    }
 }
 
 done_testing;

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/03data.t
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/03data.t	2010-01-15 16:13:28 UTC (rev 8325)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/03data.t	2010-01-15 18:00:17 UTC (rev 8326)
@@ -1,4 +1,4 @@
-#
+# vim: et ts=2
 #===============================================================================
 #
 #         FILE:  03sql.t
@@ -39,49 +39,49 @@
 
 { # test data maniplulation functions
 
-	# create a DBICTest so we can steal its connect info
-	my $schema = DBICTest->init_schema(
-	#    no_deploy=>1,
-	#	no_populate=>1,
-		sqlite_use_file => 1,
-		);
+    # create a DBICTest so we can steal its connect info
+    my $schema = DBICTest->init_schema(
+        #    no_deploy=>1,
+        #	no_populate=>1,
+        sqlite_use_file => 1,
+    );
 
 
-	my $admin = DBIx::Class::Admin->new(
-		schema_class=> "DBICTest::Schema",
-		connect_info => $schema->storage->connect_info(),
-		quiet	=> 1,
-		_confirm=>1,
-	);
-	isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
+    my $admin = DBIx::Class::Admin->new(
+        schema_class=> "DBICTest::Schema",
+        connect_info => $schema->storage->connect_info(),
+        quiet	=> 1,
+        _confirm=>1,
+    );
+    isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
 
-	$admin->insert('Employee', { name => 'Matt' });
-	my $employees = $schema->resultset('Employee');
-	is ($employees->count(), 1, "insert okay" );
+    $admin->insert('Employee', { name => 'Matt' });
+    my $employees = $schema->resultset('Employee');
+    is ($employees->count(), 1, "insert okay" );
 
-	my $employee = $employees->find(1);
-	is($employee->name(),  'Matt', "insert valid" );
+    my $employee = $employees->find(1);
+    is($employee->name(),  'Matt', "insert valid" );
 
-	$admin->update('Employee', {name => 'Trout'}, {name => 'Matt'});
+    $admin->update('Employee', {name => 'Trout'}, {name => 'Matt'});
 
-	$employee = $employees->find(1);
-	is($employee->name(),  'Trout', "update Matt to Trout" );
+    $employee = $employees->find(1);
+    is($employee->name(),  'Trout', "update Matt to Trout" );
 
-	$admin->insert('Employee', {name =>'Aran'});
+    $admin->insert('Employee', {name =>'Aran'});
 
-	my $expected_data = [ 
-		[$employee->result_source->columns() ],
-		[1,1,undef,undef,undef,'Trout'],
-		[2,2,undef,undef,undef,'Aran']
-	];
-	my $data;
-	lives_ok { $data = $admin->select('Employee')} 'can retrive data from database';
-	cmp_deeply($data, $expected_data, 'DB matches whats expected');
+    my $expected_data = [ 
+    [$employee->result_source->columns() ],
+    [1,1,undef,undef,undef,'Trout'],
+    [2,2,undef,undef,undef,'Aran']
+    ];
+    my $data;
+    lives_ok { $data = $admin->select('Employee')} 'can retrive data from database';
+    cmp_deeply($data, $expected_data, 'DB matches whats expected');
 
-	$admin->delete('Employee', {name=>'Trout'});
-	my $del_rs  = $employees->search({name => 'Trout'});
-	is($del_rs->count(), 0, "delete Trout" );
-	is ($employees->count(), 1, "left Aran" );
+    $admin->delete('Employee', {name=>'Trout'});
+    my $del_rs  = $employees->search({name => 'Trout'});
+    is($del_rs->count(), 0, "delete Trout" );
+    is ($employees->count(), 1, "left Aran" );
 }
 
 




More information about the Bast-commits mailing list