@@ -11,6 +11,11 @@ theme = core || strictersubs || pulp || more [-Subroutines::RequireArgUnpacking] [-ValuesAndExpressions::ProhibitConstantPragma] +# disabled until they are configurable enough to handle exceptions +[-ControlStructures::ProhibitPostfixControls] +[-Modules::RequireExplicitInclusion] +[-Subroutines::RequireFinalReturn] + [CodeLayout::RequireTidyCode] perltidyrc = .perltidyrc @@ -23,6 +28,9 @@ lib_sections = NAME | SYNOPSIS | DESCRIPTION | AUTHOR | LICENSE [InputOutput::RequireCheckedSyscalls] functions = opendir read readline readdir closedir +[NamingConventions::Capitalization] +subroutines = (?:.+::)?(?:[[:lower:]_\d]+|[[:upper:]_\d]+) + [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 5 .perlcriticrc @@ -15,4 +15,6 @@ --stack-opening-tokens --stack-closing-tokens --want-break-before="% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=" +--format-skipping-begin="#+\s*no tidy" +--format-skipping-end="#+\s*tidy" .perltidyrc @@ -5,6 +5,11 @@ use 5.008008; our $VERSION = '0.2.0'; if ( !caller ) { require WGDev::Command; - exit WGDev::Command->run(@ARGV) ? 0 : 1; + my $return = eval { $return = WGDev::Command->run(@ARGV) }; + if ( my $message = $@ ) { + $message =~ s/\n?\z/\n/msx; + die $message; + } + exit $return ? 0 : 1; } bin/wgd @@ -32,9 +32,9 @@ sub new { sub set_environment { my $self = shift; require Config; - WDGev::X::NoWebGUIRoot->throw + WGDev::X::NoWebGUIRoot->throw if !$self->root; - WDGev::X::NoWebGUIConfig->throw + WGDev::X::NoWebGUIConfig->throw if !$self->config_file; $self->{orig_env} ||= { map { $_ => $ENV{$_} } qw(WEBGUI_ROOT WEBGUI_CONFIG PERL5LIB) }; @@ -69,7 +69,10 @@ sub root { unshift @INC, $self->lib; } else { - WGDev::X::BadParameter->throw('parameter' => 'WebGUI root directory', 'value' => $path); + WGDev::X::BadParameter->throw( + 'parameter' => 'WebGUI root directory', + 'value' => $path + ); } } return $self->{root}; @@ -90,7 +93,10 @@ sub config_file { $path = $fullpath; } else { - WGDev::X::BadParameter->throw('parameter' => 'WebGUI config file', 'value' => $path); + WGDev::X::BadParameter->throw( + 'parameter' => 'WebGUI config file', + 'value' => $path + ); } if ( !$self->root ) { ##no critic (RequireCheckingReturnValueOfEval) @@ -112,7 +118,7 @@ sub config_file { sub lib { my $self = shift; - WDGev::X::NoWebGUIRoot->throw + WGDev::X::NoWebGUIRoot->throw if !$self->root; if ( !wantarray ) { return $self->{lib}; @@ -141,7 +147,7 @@ sub lib { sub config { my $self = shift; - WDGev::X::NoWebGUIConfig->throw + WGDev::X::NoWebGUIConfig->throw if !$self->config_file; return $self->{config} ||= do { require Config::JSON; @@ -155,7 +161,6 @@ sub close_config { # if we're closing the config, we probably want new sessions to pick up # changes to the file - ## no critic (Modules::RequireExplicitInclusion) if ( WebGUI::Config->can('clearCache') ) { WebGUI::Config->clearCache; } @@ -164,7 +169,7 @@ sub close_config { sub config_file_relative { my $self = shift; - WDGev::X::NoWebGUIConfig->throw + WGDev::X::NoWebGUIConfig->throw if !$self->config_file; return $self->{config_file_relative} ||= do { my $config_dir @@ -181,7 +186,7 @@ sub db { sub session { my $self = shift; - WDGev::X::NoWebGUIConfig->throw + WGDev::X::NoWebGUIConfig->throw if !$self->config_file; require WebGUI::Session; if ( $self->{session} ) { @@ -217,16 +222,13 @@ sub close_session { sub list_site_configs { my $self = shift; my $root = $self->root; - WDGev::X::NoWebGUIRoot->throw + WGDev::X::NoWebGUIRoot->throw if !$root; if ( opendir my $dh, File::Spec->catdir( $root, 'etc' ) ) { my @configs = readdir $dh; closedir $dh - or WGDev::X::IO::Read->throw( - message => 'Unable to close directory handle', - errno_string => "$!", - ); + or WGDev::X::IO::Read->throw('Unable to close directory handle'); @configs = map { File::Spec->catdir( $root, 'etc', $_ ) } grep { /\Q.conf\E$/msx && !/^(?:spectre|log)\Q.conf\E$/msx } @configs; @@ -243,7 +245,7 @@ sub asset { sub version { my $self = shift; - WDGev::X::NoWebGUIRoot->throw + WGDev::X::NoWebGUIRoot->throw if !$self->root; require WGDev::Version; return $self->{version} ||= WGDev::Version->new( $self->root ); @@ -371,16 +373,14 @@ sub write_wgd_config { $encoded =~ s/\n?\z/\n/msx; open my $fh, '>', $config_path or WGDev::X::IO::Write->throw( - message => 'Unable to write config file', - errno_string => "$!", - path => $config_path, + message => 'Unable to write config file', + path => $config_path, ); print {$fh} $encoded; close $fh or WGDev::X::IO::Write->throw( - message => 'Unable to write config file', - errno_string => "$!", - path => $config_path, + message => 'Unable to write config file', + path => $config_path, ); return 1; } lib/WGDev.pm @@ -57,7 +57,7 @@ sub find { if ( $asset && ref $asset && $asset->isa('WebGUI::Asset') ) { return $asset; } - WGDev::X::AssetNotFound->throw(asset => $asset_spec); + WGDev::X::AssetNotFound->throw( asset => $asset_spec ); } sub validate_class { @@ -69,7 +69,7 @@ sub validate_class { return wantarray ? ( $class, $short_class ) : $class; } } - WGDev::X::BadAssetClass->throw(class => $in_class); + WGDev::X::BadAssetClass->throw( class => $in_class ); } sub _gen_serialize_header { lib/WGDev/Asset.pm @@ -21,7 +21,7 @@ sub run { 'F|config-file=s' => \( my $opt_config ), 'R|webgui-root=s' => \( my $opt_root ), - ) || WGDev::X::CommandLine->throw(usage => $class->usage(0)); + ) || WGDev::X::CommandLine->throw( usage => $class->usage(0) ); my @params = @ARGV; my $command_name = shift @params; @@ -40,7 +40,7 @@ sub run { else { WGDev::X::CommandLine::BadCommand->throw( command_name => $command_name, - usage => $class->usage(0), + usage => $class->usage(0), ); } } @@ -60,8 +60,8 @@ sub run { require WGDev; my $wgd = WGDev->new; $class->guess_webgui_paths( - wgd => $wgd, - root => $opt_root, + wgd => $wgd, + root => $opt_root, config_file => $opt_config, ); my $command = $command_module->new($wgd); @@ -71,11 +71,19 @@ sub run { } sub guess_webgui_paths { - my $class = shift; + my $class = shift; my %params = @_; - my $wgd = $params{wgd}; - my $webgui_root = $params{root} || $ENV{WEBGUI_ROOT} || $wgd->my_config('webgui_root'); - my $webgui_config = $params{config_file} || $ENV{WEBGUI_CONFIG} || $wgd->my_config('webgui_config'); + my $wgd = $params{wgd}; +##no tidy + my $webgui_root + = $params{root} + || $ENV{WEBGUI_ROOT} + || $wgd->my_config('webgui_root'); + my $webgui_config + = $params{config_file} + || $ENV{WEBGUI_CONFIG} + || $wgd->my_config('webgui_config'); +##tidy # first we need to find the webgui root if ($webgui_root) { @@ -83,8 +91,10 @@ sub guess_webgui_paths { } if ($webgui_config) { - my $can_set_config - = eval { $class->set_config_by_input( $wgd, $webgui_config ); 1 }; + my $can_set_config = eval { + $class->set_config_by_input( $wgd, $webgui_config ); + 1; + }; # if we were able to set the config file and root is set either by # being specified or calculated by the config path, we are done. @@ -92,17 +102,15 @@ sub guess_webgui_paths { return $wgd; } - # if root and the config file were specified and we haven't found the config - # yet, die + # if root and the config file were specified and we haven't + # found the config yet, die elsif ( $wgd->root ) { die $@; } } if ( !$wgd->root ) { - eval { - $class->set_root_relative($wgd); - } || return $wgd; + eval { $class->set_root_relative($wgd) } || return; if ($webgui_config) { $class->set_config_by_input( $wgd, $webgui_config ); return $wgd; @@ -111,8 +119,9 @@ sub guess_webgui_paths { my @configs = $wgd->list_site_configs; if ( @configs == 1 ) { $wgd->config_file( $configs[0] ); + return $wgd; } - return $wgd; + return; } sub set_root_relative { @@ -135,21 +144,21 @@ sub set_root_relative { sub set_config_by_input { my ( $class, $wgd, $webgui_config ) = @_; - # first, try the specified email - if ( eval { $wgd->config_file($webgui_config); 1 } ) { + # first, try the specified config file + if ( eval { $wgd->config_file($webgui_config) } ) { return $wgd; } + my $e = WGDev::X->caught; # if that didn't work, try it with .conf appended - elsif ( $webgui_config !~ /\Q.conf\E$/msx ) { - local $@ = undef; - if ( eval { $wgd->config_file( $webgui_config . '.conf' ); 1; } ) { + if ( $webgui_config !~ /\Q.conf\E$/msx ) { + if ( eval { $wgd->config_file( $webgui_config . '.conf' ) } ) { return $wgd; } } # if neither normal or alternate config files worked, die - die $@; + $e->rethrow; } sub report_version { @@ -197,7 +206,7 @@ sub get_command_module { return $module; } } - WGDev::X::BadCommand->throw('command_name' => $command_name); + WGDev::X::BadCommand->throw( 'command_name' => $command_name ); } sub command_to_module { lib/WGDev/Command.pm @@ -112,7 +112,7 @@ sub run { local $| = 1; if ( !$self->parse_params(@params) ) { my $usage = $self->usage(0); - WGDev::X::CommandLine::BadParams->throw(usage => $usage); + WGDev::X::CommandLine::BadParams->throw( usage => $usage ); } return $self->process; } @@ -134,8 +134,11 @@ sub help { $class = ref $class; } require WGDev::Help; - if ( eval { WGDev::Help::package_perldoc( $class, '!AUTHOR|LICENSE|METHODS' ); 1 } - ) + if ( + eval { + WGDev::Help::package_perldoc( $class, '!AUTHOR|LICENSE|METHODS' ); + 1; + } ) { return 1; } lib/WGDev/Command/Base.pm @@ -38,7 +38,8 @@ sub command_abstracts { my $parser = Pod::PlainText->new( indent => 0, width => 1000 ); $parser->select('NAME'); for my $command ( keys %abstracts ) { - my $command_module = eval { WGDev::Command::get_command_module($command) }; + my $command_module + = eval { WGDev::Command::get_command_module($command) }; next if !$command_module; my $pod = WGDev::Help::package_pod($command_module); @@ -50,6 +51,7 @@ sub command_abstracts { $parser->parse_from_filehandle( $pod_in, $pod_out ); close $pod_in or die "Can't open file handle to scalar : $!"; close $pod_out or die "Can't open file handle to scalar : $!"; + if ( $formatted_pod =~ /^ [:\w]+ \s* - \s* (.+?) \s* $/msx ) { $abstracts{$command} = $1; } lib/WGDev/Command/Commands.pm @@ -20,7 +20,7 @@ sub process { my $wgd = $self->wgd; my ($command) = $self->arguments; - if (!defined $command) { + if ( !defined $command ) { print WGDev::Command->usage(1); return 1; } lib/WGDev/Command/Help.pm @@ -12,8 +12,8 @@ sub process { my $self = shift; $self->wgd->set_environment; my @arguments = $self->arguments; - my $command = shift @arguments; - my $result = system {$command} $command, @arguments; + my $command = shift @arguments; + my $result = system {$command} $command, @arguments; return $result ? 0 : 1; } lib/WGDev/Command/Run.pm @@ -54,12 +54,12 @@ sub process { if ( -e $cover_dir ) { system 'cover', '-silent', '-delete', $cover_dir; } - my $cover_options = $self->option('coverOptions') || '-select,WebGUI,+ignore,^t'; + my $cover_options = $self->option('coverOptions') + || '-select,WebGUI,+ignore,^t'; ##no critic (RequireLocalizedPunctuationVars) $ENV{HARNESS_PERL_SWITCHES} = '-MDevel::Cover=-silent,1' - . ",$cover_options," - . '-db,' + . ",$cover_options," . '-db,' . $cover_dir; } my $prove = App::Prove->new; lib/WGDev/Command/Test.pm @@ -5,7 +5,7 @@ use 5.008008; our $VERSION = '0.1.0'; -use WGDev::X (); +use WGDev::X (); use File::Spec (); sub package_usage { lib/WGDev/Help.pm @@ -91,8 +91,8 @@ sub item { } else { my $option_name_length = OPTION_TEXT_INDENT - OPTION_INDENT - 1; - $self->output( $indent_string . sprintf "%-*s %s\n", $option_name_length, - $tag, $item ); + $self->output( $indent_string . sprintf "%-*s %s\n", + $option_name_length, $tag, $item ); } return; } lib/WGDev/Pod/Usage.pm @@ -6,9 +6,7 @@ use 5.008008; our $VERSION = '0.0.1'; use Exception::Class ( - 'WGDev::X' => { - description => 'A general WGDev error', - }, + 'WGDev::X' => { description => 'A general WGDev error', }, 'WGDev::X::CommandLine' => { isa => 'WGDev::X', description => 'An error with the command line.', @@ -28,10 +26,10 @@ use Exception::Class ( isa => 'WGDev::X::CommandLine', description => 'Invalid parameters were passed to a command.', }, - 'WGDev::X::IO' => { + 'WGDev::X::IO' => { isa => 'WGDev::X', description => 'IO error', - fields => ['errno_string', 'path'], + fields => [ 'errno_string', 'path' ], }, 'WGDev::X::IO::Read' => { isa => 'WGDev::X', @@ -41,7 +39,7 @@ use Exception::Class ( isa => 'WGDev::X', description => 'Write error', }, - 'WGDev::X::NoConfigFile' => { + 'WGDev::X::NoWebGUIConfig' => { isa => 'WGDev::X', description => 'No WebGUI config file available.', }, @@ -52,7 +50,7 @@ use Exception::Class ( 'WGDev::X::BadParameter' => { isa => 'WGDev::X', description => 'Bad parameter provided.', - fields => ['parameter', 'value'], + fields => [ 'parameter', 'value' ], }, 'WGDev::X::AssetNotFound' => { isa => 'WGDev::X', @@ -66,14 +64,7 @@ use Exception::Class ( }, ); -##no critic (ProhibitQualifiedSubDeclarations Capitalization) - -sub WGDev::X::as_string { - my $self = shift; - my $str = $self->SUPER::as_string(@_); - $str =~ s/\n?\z/\n/msx; - return $str; -} +##no critic (ProhibitQualifiedSubDeclarations) sub WGDev::X::full_message { my $self = shift; @@ -109,12 +100,13 @@ sub WGDev::X::CommandLine::BadCommand::full_message { } sub WGDev::X::IO::new { - my $class = shift; - my $errno_string = "$!"; - my $self = $class->SUPER::new(@_); - if (!defined $self->errno_string) { + my $class = shift; + my $errno_string = qq{$!}; + my $self = $class->SUPER::new(@_); + if ( !defined $self->errno_string ) { $self->{errno_string} = $errno_string; } + return $self; } 1; lib/WGDev/X.pm @@ -19,14 +19,14 @@ my $wgd = WGDev->new; isa_ok $wgd, 'WGDev', 'WGDev->new returns WGDev object'; -throws_ok { $wgd->set_environment } qr/^\QWebGUI root not set/, +throws_ok { $wgd->set_environment } 'WGDev::X::NoWebGUIRoot', 'Exception thrown for ->set_environment with no root set'; my $test_data = catdir( TEST_DIR, 'testdata' ); { my $root_invalid = File::Temp->newdir; - throws_ok { $wgd->root($root_invalid) } qr/^\QInvalid WebGUI path:/, + throws_ok { $wgd->root($root_invalid) } 'WGDev::X::BadParameter', 'Exception thrown for ->root with invalid WebGUI root'; } @@ -57,10 +57,10 @@ lives_ok { $wgd->root($root) } 'Able to set valid WebGUI root'; is $wgd->root, $root_abs, 'WebGUI root set correctly'; -throws_ok { $wgd->config } qr/^\Qno config file available/, +throws_ok { $wgd->config } 'WGDev::X::NoWebGUIConfig', 'Exception thrown for ->config with no config file set'; -throws_ok { $wgd->set_environment } qr/^\QWebGUI config file not set/, +throws_ok { $wgd->set_environment } 'WGDev::X::NoWebGUIConfig', 'Exception thrown for ->set_environment with no config file set'; lives_ok { $wgd->config_file('www.example.com.conf') } @@ -118,28 +118,25 @@ $wgd = WGDev->new( $config, $root ); is $wgd->root, $root_abs, 'Can initialize root on new call in reverse order'; -throws_ok { $wgd->root($lib) } qr/^\QInvalid WebGUI path: $lib/, +throws_ok { $wgd->root($lib) } 'WGDev::X::BadParameter', 'Error thrown when trying to set root to directory that isn\'t a WebGUI root'; my $nonexistant_path = catdir( $root, 'nonexistant' ); -throws_ok { $wgd->root($nonexistant_path) } -qr/^\QInvalid WebGUI path: $nonexistant_path/, +throws_ok { $wgd->root($nonexistant_path) } 'WGDev::X::BadParameter', 'Error thrown when trying to set root to directory that doesn\'t exist'; is $wgd->root, $root_abs, 'Root not modified after failed attempts to set'; -throws_ok { $wgd->config_file('nonexistant') } -qr/^\QInvalid WebGUI config file: nonexistant/, +throws_ok { $wgd->config_file('nonexistant') } 'WGDev::X::BadParameter', 'Error thrown when trying to set config to nonexistant file with root set'; $wgd = WGDev->new; -throws_ok { $wgd->config_file('nonexistant') } -qr/^\QInvalid WebGUI config file: nonexistant/, +throws_ok { $wgd->config_file('nonexistant') } 'WGDev::X::BadParameter', 'Error thrown when trying to set config to nonexistant file with no root set'; lives_ok { $wgd->config_file($config_abs) } -'Can set just config file using full path'; + 'Can set just config file using full path'; is realpath( $wgd->root ), realpath($root_abs), 'Root set correctly based on absolute config file'; t/01_WGDev.t @@ -1,15 +1,8 @@ use strict; use warnings; -# set this right now so we can override it later -BEGIN { - *CORE::GLOBAL::exit = sub (;$) { - goto &CORE::exit; - }; -} - use Test::More 'no_plan'; -use Test::NoWarnings; +#use Test::NoWarnings; use Test::Exception; use Test::Warn; @@ -48,23 +41,6 @@ sub capture_output (&) { return $output; } -sub capture_exit (&) { - my $sub = shift; - my $exit_code; - - EXIT: { - no warnings 'redefine'; - local *CORE::GLOBAL::exit = sub (;$) { - $exit_code = @_ ? 0 + shift : 0; - no warnings 'exiting'; - last EXIT; - }; - $sub->(); - return; - } - return $exit_code; -} - # we don't want the user's configuration interfering with the test local $ENV{WEBGUI_ROOT}; local $ENV{WEBGUI_CONFIG}; @@ -124,11 +100,11 @@ is +WGDev::Command::get_command_module('_test-subclass'), 'WGDev::Command::_test::Subclass', 'get_command_module finds subclass command modules'; -is +WGDev::Command::get_command_module('base'), undef, - 'get_command_module returns undef for existing command modules that aren\'t runnable'; +throws_ok { WGDev::Command::get_command_module('base') } 'WGDev::X::BadCommand', + q{get_command_module throws exception for existing command modules that aren't runnable}; -is +WGDev::Command::get_command_module('_nonexistant'), undef, - 'get_command_module returns undef for nonexisting command modules'; +throws_ok { WGDev::Command::get_command_module('_nonexistant') } 'WGDev::X::BadCommand', + 'get_command_module throws exception for nonexisting command modules'; is +WGDev::Command::command_to_module('command'), 'WGDev::Command::Command', 'command_to_module converts command name to module name properly'; @@ -147,39 +123,29 @@ my $usage_base = WGDev::Help::package_usage('WGDev::Command'); is +WGDev::Command->usage, $usage_base, 'usage with no parameters gives base usage'; -my $usage_verbosity_2 = WGDev::Help::package_usage( 'WGDev::Command', 2 ); -is +WGDev::Command->usage(2), $usage_verbosity_2, +my $usage_verbosity_0 = WGDev::Help::package_usage( 'WGDev::Command', 0 ); +is +WGDev::Command->usage(0), $usage_verbosity_0, 'usage with one parameter treats it as verbosity'; -is +WGDev::Command->usage( verbosity => 2 ), $usage_verbosity_2, - 'usage with hash uses verbosity option'; - -is +WGDev::Command->usage( message => 'prefixed message' ), - 'prefixed message' . $usage_base, - 'usage with message option prefixes it to output'; - my @commands = WGDev::Command->command_list; -is +WGDev::Command->usage( include_cmd_list => 1 ), - $usage_base . "SUBCOMMANDS\n " . join( "\n ", @commands ) . "\n\n", - 'usage with include_cmd_list option includes command list'; -is + ( grep { $_ eq 'util' } @commands ), 1, +is +( grep { $_ eq 'util' } @commands ), 1, 'command_list includes unloaded commands'; -is + ( grep { $_ eq '_test' } @commands ), 1, +is +( grep { $_ eq '_test' } @commands ), 1, 'command_list includes loaded commands'; -is + ( grep { $_ eq '_tester' } @commands ), 1, +is +( grep { $_ eq '_tester' } @commands ), 1, 'command_list includes commands with mismatched filename and package'; -is + ( grep { $_ eq 'tester-executable' } @commands ), 1, +is +( grep { $_ eq 'tester-executable' } @commands ), 1, 'command_list includes standalone executables in path'; -is + ( grep { $_ eq 'tester-non-executable' } @commands ), 0, - 'command_list doesn\'t include standalone non-executables in path'; +is +( grep { $_ eq 'tester-non-executable' } @commands ), 0, + q{command_list doesn't include standalone non-executables in path}; -is + ( grep { $_ eq 'base' } @commands ), 0, - 'command_list doesn\'t include command modules that are not runnable'; +is +( grep { $_ eq 'base' } @commands ), 0, + q{command_list doesn't include command modules that are not runnable}; my $emptydir = File::Temp->newdir; my $root = File::Temp->newdir; @@ -224,55 +190,51 @@ my $cwd = cwd; chdir $emptydir; my $wgd = WGDev->new; -throws_ok { WGDev::Command->guess_webgui_paths($wgd) } -qr{^\QUnable to find WebGUI root directory!}, - 'guess_webgui_paths throws correct error for invalid dir'; +lives_and { is +WGDev::Command->guess_webgui_paths(wgd => $wgd), undef } + q{guess_webgui_paths returns undef when unable to locate WebGUI paths}; chdir $root; $wgd = WGDev->new; -lives_and { is +WGDev::Command->guess_webgui_paths($wgd), $wgd } -'guess_webgui_paths returns passed in WGDev instance when finding path based on current'; +lives_and { is +WGDev::Command->guess_webgui_paths(wgd => $wgd), $wgd } + 'guess_webgui_paths returns passed in WGDev instance when finding path based on current'; -is realpath( $wgd->root ), realpath($root_abs), 'root path set correctly'; +is realpath( $wgd->root ), realpath($root_abs), + 'root path set correctly'; is realpath( $wgd->config_file ), realpath($config_abs), 'config file path set correctly'; $wgd = WGDev->new; -throws_ok { WGDev::Command->guess_webgui_paths( $wgd, $emptydir ) } -qr{^\QInvalid WebGUI path: }, +throws_ok { WGDev::Command->guess_webgui_paths( wgd => $wgd, root => $emptydir ) } + 'WGDev::X::BadParameter', 'guess_webgui_paths throws correct error for invalid dir when in valid dir'; chdir $sbin; $wgd = WGDev->new; lives_and { - is realpath( WGDev::Command->guess_webgui_paths($wgd)->root ), - realpath($root_abs); + is realpath( WGDev::Command->guess_webgui_paths(wgd => $wgd)->root ), realpath($root_abs); } -'guess_webgui_paths finds root searching updward from current dir'; + 'guess_webgui_paths finds root searching updward from current dir'; chdir $cwd; $wgd = WGDev->new; lives_and { is realpath( - WGDev::Command->guess_webgui_paths( $wgd, undef, $config_abs ) - ->root ), realpath($root_abs); + WGDev::Command->guess_webgui_paths( wgd => $wgd, config_file => $config_abs )->root + ), realpath($root_abs); } 'guess_webgui_paths finds root when given config file'; $wgd = WGDev->new; -throws_ok { - WGDev::Command->guess_webgui_paths( $wgd, undef, - catfile( $test_data, 'www.example.com.conf' ) ); +lives_and { + is +WGDev::Command->guess_webgui_paths( wgd => $wgd, config_file => catfile( $test_data, 'www.example.com.conf' ) ), undef; } -qr{^\QUnable to find WebGUI root directory!}, - 'guess_webgui_paths throws correct error when given a config file without a valid root'; + 'guess_webgui_paths returns undef when given a config file without a valid root'; chdir $root; $ENV{WEBGUI_ROOT} = $emptydir; $wgd = WGDev->new; -throws_ok { WGDev::Command->guess_webgui_paths($wgd) } -qr{^\QInvalid WebGUI path: }, +throws_ok { WGDev::Command->guess_webgui_paths(wgd => $wgd) } 'WGDev::X::BadParameter', 'guess_webgui_paths throws correct error for invalid dir set via ENV when in valid dir'; chdir $cwd; @@ -280,7 +242,7 @@ chdir $cwd; $ENV{WEBGUI_ROOT} = $root_abs; $wgd = WGDev->new; lives_and { - is realpath( WGDev::Command->guess_webgui_paths($wgd)->root ), + is realpath( WGDev::Command->guess_webgui_paths(wgd => $wgd)->root ), realpath($root_abs); } 'guess_webgui_paths finds root given by environment'; @@ -289,7 +251,7 @@ $ENV{WEBGUI_ROOT} = undef; $command_config->{webgui_root} = $root_abs; $wgd = WGDev->new; lives_and { - is realpath( WGDev::Command->guess_webgui_paths($wgd)->root ), + is realpath( WGDev::Command->guess_webgui_paths(wgd => $wgd)->root ), realpath($root_abs); } 'guess_webgui_paths finds root given by wgdevcfg file'; @@ -297,25 +259,23 @@ lives_and { $command_config->{webgui_root} = undef; copy catfile( $test_data, 'www.example.com.conf' ), catfile( $etc, 'www.example2.com.conf' ); -throws_ok { WGDev::Command->guess_webgui_paths( $wgd, $root ) } -qr{^\QUnable to find WebGUI config file!}, - 'guess_webgui_paths throws correct error for root with two config files'; +lives_and { is +WGDev::Command->guess_webgui_paths( wgd => $wgd, root => $root ), undef } + 'guess_webgui_paths returns undef for root with two config files'; $ENV{WEBGUI_ROOT} = $root_abs; $wgd = WGDev->new; my $truncated_config = catfile( $etc, 'www.example.com' ); lives_and { is realpath( - WGDev::Command->guess_webgui_paths( $wgd, undef, $truncated_config ) + WGDev::Command->guess_webgui_paths( wgd => $wgd, config_file => $truncated_config ) ->config_file ), realpath($config); } 'guess_webgui_paths intelligently adds .conf to config file'; my $nonexistant_config = catfile( $etc, 'duff' ); throws_ok { - WGDev::Command->guess_webgui_paths( $wgd, undef, $nonexistant_config ); -} -qr{^\QInvalid WebGUI config file: $nonexistant_config\E$}m, + WGDev::Command->guess_webgui_paths( wgd=>$wgd, config_file=> $nonexistant_config ); +} 'WGDev::X::BadParameter', 'guess_webgui_paths throws with the config file requested, not with an unspecified .conf appended to the end'; $ENV{WEBGUI_ROOT} = undef; @@ -323,26 +283,18 @@ chdir $root; $wgd = WGDev->new; lives_and { is realpath( - WGDev::Command->guess_webgui_paths( $wgd, undef, 'www.example.com' ) + WGDev::Command->guess_webgui_paths( wgd=>$wgd, config_file=> 'www.example.com' ) ->config_file ), realpath($config); } 'guess_webgui_paths with guessed root intelligently adds .conf to config file'; -throws_ok { - WGDev::Command->guess_webgui_paths( $wgd, undef, 'duff' ); -} -qr{^\QInvalid WebGUI config file: duff\E$}m, - 'guess_webgui_paths with guessed root throws with the config file requested, not with an unspecified .conf appended to the end'; chdir $cwd; -my $exit; -warning_like { - $exit = capture_exit { - WGDev::Command->run(); - }; -} -qr/^\QNo command specified!/, 'run with no params warns correctly'; - -is $exit, 1, '... and exits with an error code of 1'; +my $return; +$output = capture_output { + $return = WGDev::Command->run; +}; +like $output, qr/^\QRun WGDev commands/, 'run with no params outputs correct message'; +is $return, 1, '... and exits with an error code of 0'; t/03_WGDev-Command.t 7577273976815072ce29506cada9f752ca631ba6 Graham Knop haarg@haarg.org http://github.com/haarg/wgdev/commit/5433d3fb66b8a6ba232096e108ff060dac74d8fe 5433d3fb66b8a6ba232096e108ff060dac74d8fe 2009-08-05T04:56:10-07:00 2009-08-05T04:56:10-07:00 Updated tests for new code. Also fixes an number of bugs found by tests. 33999930b9ac6f2213942dfa67cfd7594598e8cb Graham Knop haarg@haarg.org