Menu
▾
▴
[Everydevel-opers] SF.net SVN: everydevel: [947] trunk/ebase
|
From: <pau...@us...> - 2007-05-01 21:25:38
|
Revision: 947
http://svn.sourceforge.net/everydevel/?rev=947&view=rev
Author: paul_the_nomad
Date: 2007-05-01 14:25:37 -0700 (Tue, 01 May 2007)
Log Message:
-----------
Command line utility subroutines and test
Added Paths:
-----------
trunk/ebase/lib/Everything/CmdLine.pm
trunk/ebase/lib/Everything/Test/CmdLine.pm
trunk/ebase/t/cmdline.t
Property Changed:
----------------
trunk/ebase/
Property changes on: trunk/ebase
___________________________________________________________________
Name: svk:merge
- 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:962
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
+ 16c2b9cb-492b-4d64-9535-64d4e875048d:/wip/ebase:963
a6810612-c0f9-0310-9d3e-a9e4af8c5745:/ebase/offline:17930
Added: trunk/ebase/lib/Everything/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/CmdLine.pm (rev 0)
+++ trunk/ebase/lib/Everything/CmdLine.pm 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,78 @@
+package Everything::CmdLine;
+
+use Getopt::Long;
+use Cwd;
+use Carp;
+use base 'Exporter';
+use strict;
+use warnings;
+
+our @EXPORT_OK = qw(get_options abs_path);
+
+Getopt::Long::Configure(qw/bundling/);
+
+sub get_options {
+ my ($usage_msg) = @_;
+ my %opts;
+ GetOptions(
+ \%opts, 'user|u=s', 'password|p=s', 'host|h=s',
+ 'database|d=s', 'port|P=s', 'type|t=s'
+ ) or usage_options($usage_msg);
+ return \%opts;
+
+}
+
+sub usage_options {
+ my ($usage_msg) = @_;
+ $usage_msg ||= "Usage:\n\n";
+
+ $usage_msg .= <<USAGE;
+Takes the following options:
+\t -d
+\t --database
+\t\t the db name. In the case of sqlite, it will be the file name of the test db, it will not be deleted on completion. If no name is specified a temporary file will be used if possible. The temporary file will be deleted on completion. In the case of mysql or postgresql, it is the name of the database to use.
+\t -u
+\t --user
+\t\tthe db user.
+\t -p
+\t --password
+\t\t the password for the db user.
+\t -t
+\t --type
+\t\t the db type (mysql|Pg|sqlite). Defaults to sqlite.
+\t -h
+\t --host
+\t\t the db host.
+\t -P
+\t --port
+\t\t the port number on which the db is listening.
+
+USAGE
+
+ warn $usage_msg;
+ exit 1;
+}
+
+=head2 C<abs_path>
+
+Get the absolute path of the file or directory.
+
+=cut
+
+sub abs_path {
+ my ($file) = @_;
+
+ #thank you Perl Cookbook!
+ $file =~ s{ ^ ~ ( [^/]* ) }
+ { $1
+ ? (getpwnam($1))[7]
+ : ( $ENV{HOME} || $ENV{LOGDIR}
+ || (getpwuid($>))[7]
+ )
+ }ex;
+
+ return Cwd::abs_path($file);
+
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/CmdLine.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/lib/Everything/Test/CmdLine.pm
===================================================================
--- trunk/ebase/lib/Everything/Test/CmdLine.pm (rev 0)
+++ trunk/ebase/lib/Everything/Test/CmdLine.pm 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,91 @@
+package Everything::Test::CmdLine;
+
+use Test::More;
+use Test::Warn;
+use Cwd;
+use warnings;
+use strict;
+
+use base 'Everything::Test::Abstract';
+
+my $exited;
+
+BEGIN {
+ *CORE::GLOBAL::exit = sub { $exited++ };
+}
+
+sub test_get_options : Test(4) {
+ my $self = shift;
+ my $test_code = \&{ $self->{class} . '::get_options' };
+
+ @ARGV = (
+ '-d', 'db', '-u', 'me', '-h', 'ahost',
+ '-p', 'password', '-P', '1111', '-t', 'atype'
+ );
+
+ my $opts = $test_code->();
+ is_deeply(
+ $opts,
+ {
+ database => 'db',
+ user => 'me',
+ host => 'ahost',
+ 'password' => 'password',
+ port => '1111',
+ type => 'atype'
+ },
+ '... checks all short command line options.'
+ );
+
+ @ARGV = (
+ '--database', 'db', '--user', 'me',
+ '--host', 'ahost', '--password', 'password',
+ '--port', '1111', '--type', 'atype'
+ );
+
+ $opts = $test_code->();
+ is_deeply(
+ $opts,
+ {
+ database => 'db',
+ user => 'me',
+ host => 'ahost',
+ 'password' => 'password',
+ port => '1111',
+ type => 'atype'
+ },
+ '... checks all long command line options.'
+ );
+
+ @ARGV = (
+ '--databaes', 'db', '--user', 'me',
+ '--host', 'ahost', '--password', 'password',
+ '--port', '1111', '--type', 'atype'
+ );
+
+ warnings_like { $opts = $test_code->() }[ qr/Unknown option/, qr/Usage/ ],
+ '... warns with incorrect options';
+ is( $exited, 1, '... and exits.' );
+
+}
+
+sub test_abs_path : Test(4) {
+ my $self = shift;
+ can_ok( $self->{class}, 'abs_path' ) || return 'abs_path not implemented.';
+ my $instance = $self->{instance};
+ my $test_code = \&{ $self->{class} . '::abs_path' };
+ my $rv = $test_code->('~/here');
+ is( $rv, $ENV{HOME} . '/here', '..gets absolute unix path.' );
+
+ my $wd = getcwd();
+ $rv = $test_code->('./here');
+ is( $rv, $wd . '/here', '..resolves the directory ".".' );
+
+ $wd =~ s/[\/][^\/]+$//;
+
+ $rv = $test_code->('../here');
+ is( $rv, $wd . '/here', '..resolves the directory "..".' );
+
+}
+
+1;
Property changes on: trunk/ebase/lib/Everything/Test/CmdLine.pm
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
Added: trunk/ebase/t/cmdline.t
===================================================================
--- trunk/ebase/t/cmdline.t (rev 0)
+++ trunk/ebase/t/cmdline.t 2007-05-01 21:25:37 UTC (rev 947)
@@ -0,0 +1,4 @@
+#! perl
+
+use Everything::Test::CmdLine;
+Everything::Test::CmdLine->runtests();
Property changes on: trunk/ebase/t/cmdline.t
___________________________________________________________________
Name: svn:mime-type
+ text/plain
Name: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
