Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also .

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also .
...
  • 19 commits
  • 12 files changed
  • 0 commit comments
  • 1 contributor
Commits on Dec 05, 2013
@deeelwy Changed http_download_dirlist() to display content in addition to hea…
…ders.
1905031
@deeelwy Added cool BUGALERT feature request to add a cool progress bar. bf60348
@deeelwy Moved vmsg to after to operation for less confusing debugging.
This commit also fixes a silly copy and paste typo.
4b48a79
Commits on Dec 07, 2013
@deeelwy Fixed vmsg reference typo regarding . 495a20b
Commits on Dec 08, 2013
@deeelwy Refactored cmd_list() test to use print_ok(). d6bc0ed
@deeelwy Fix confusing subroutine call in t/bin-fetchware-clean.t a9da7ec
@deeelwy Fixed missing regex bug in cmd_look() test. b9953a1
@deeelwy Added new fork_ok() testing subroutine to Test::Fetchware.
t/bin-fetchware-run.t needs to fork, because run(), which the file tests,
calls exit, because doing so makes sense in bin/fetchware, but doing so
complicates testing.

This is fixed by just forking before calling run(), which is what fork_ok()
does for us.
043b863
@deeelwy Fixed typo in Getopt::Long command line option parsing.
cmd_help() used to be called just help, but it was renamed. It looks like
I missed one. It's fixed now.
a526ff7
@deeelwy Added run() tests in t/bin-fetchware-run.t
It tests the command line options and the big commands such as install. It
does not test new, because new asks questions on the terminal, and I have
not successfully gotten Test::Expect to work with new all at once yet.
612f936
Commits on Dec 09, 2013
@deeelwy Added missing test for -? printing help. faa6ff9
@deeelwy Fix POD parsing error. cde20d8
@deeelwy Fixed copy and paste leftovers in t/bin-fetchware-run.t cf9ba45
@deeelwy Added t/bin-fetchware-command-line.t to test Fetchware's command line…
… interface.

It is just t/bin-fetchware-run.t copied and pasted with the fork_ok()'s removed,
and all of the run()'s replaced with run_perl(), which is just a local
conviencience subroutine that calls system($^X, 'bin/fetchware', @_) for you,
and it does error checking and exit status to subroutine true/false conversion.

A teammate in a group project in college came up with an insane programming
strategy he called "Copy, Paste, Customize." Which is literally downloading
example code snippets off of the internet, pasting them into our project, and
then customizing them to fit the needs of our program.

When using Test::More to test Fetchware I find my self constantly copying large
portions, in the case of t/bin-fetchware-command-line.t the entire file, or test
code, and then changing some parts especially test names. It is really
convienient and fast, and much easier than using some gigantic, complicated
test module like Test::Class or Test::Routine.
8b3a1ce
Commits on Dec 12, 2013
@deeelwy Fixed copy_fpkg_to_fpkg_database() test failing to delete a test fpkg.
The left over was named App-Fetchware when I test it in my git repo, but in a
CPAN download the file is named App-Fetchware-1.008 or whatever version of
fetchware your testing.

Fetchware creates lots of files that should be deleted after the test is run,
managing these manually like malloc()ing and free()ing memory in C is stupid.
Just as it works in C, it works ok in fetchware. But a garbage collector would
be nice: Perhaps an object that stringifies to the path of the file it
represents, and on instantiation it adds that object to a list of stuff to
delete. And then an END {} block comes along and deletes it all for me.
cec5046
@deeelwy Fixed "uninitialized variable" warnings when fetchware is called by i…
…tself.

When just fetchware is run the help command is run, but inside run(), the if's
that determine what cmd_*() subroutine to run spit out annoying "use of
uninitialized variable..." warnings, because @ARGV is undef, and therefore so is
$command.

I also deleted the weird space before  the help message is printed. Most *nix
commands don't do this so fetchware shouldn't either.
d52e89e
@deeelwy Fixed indentation due to tabs in bin/fetchware. 1d3b5e7
@deeelwy Fixed bizarre "variable $VERSION is not imported at" bug.
[PkgVersion] bizarrely declares version numbers using:
{
    $fetchware::VERSION = 1.008;
}
Which looks weird why not "our $VERSION." our has block scope? Or use vars
'VERSION';. use vars has file scope?

Apparently, $fetchware::VERSION does not make a symbol for just regular old
$VERSION. So, you can't actually reference $VERSION.
e0ca971
@deeelwy v1.009
    - Fixed github#2-3 for good by introducing tests for both run() and actually
      running the program with arguments to check its command line arguments.
      Now, if I break the user interface, and fetchware becomes useless, I'll
      actually know from just its own tests.
    - Created a new testing helper subroutine, fork_ok(). All it does is fork,
      execute the specified coderef, and pass or fail based on the forked
      proces's exit status. Used in the test suite testing mentioned above.
    - Fixed a typo that caused fetchware's -h, --help, and -? command line
      options to not work at all. Until this release fetchware was calling the
      help() subroutine, which no longer exists. It was renamed cmd_help() a
      long time ago. This is now fixed, and tested for.
    - Fixed an annoying bug that caused App-Fetchware-$VERSION.fpkg to be left
      in user's fetchware package directory. Fetchware's test suite creates a
      few test packages, and copies them to the user's fetchware database
      directory. These packages are then deleted, because they are only used for
      testing, so they do not need to be left there with the user wondering
      where they came from.
    - And a number of small bug fixes and typos as well.
5d7cb78
View
20 Changes
@@ -2,6 +2,26 @@ Revison History for App::Fetchware
{{$NEXT}}
+1.009 2013-12-11 22:41:13 America/New_York
+ - Fixed github#2-3 for good by introducing tests for both run() and actually
+ running the program with arguments to check its command line arguments.
+ Now, if I break the user interface, and fetchware becomes useless, I'll
+ actually know from just its own tests.
+ - Created a new testing helper subroutine, fork_ok(). All it does is fork,
+ execute the specified coderef, and pass or fail based on the forked
+ proces's exit status. Used in the test suite testing mentioned above.
+ - Fixed a typo that caused fetchware's -h, --help, and -? command line
+ options to not work at all. Until this release fetchware was calling the
+ help() subroutine, which no longer exists. It was renamed cmd_help() a
+ long time ago. This is now fixed, and tested for.
+ - Fixed an annoying bug that caused App-Fetchware-$VERSION.fpkg to be left
+ in user's fetchware package directory. Fetchware's test suite creates a
+ few test packages, and copies them to the user's fetchware database
+ directory. These packages are then deleted, because they are only used for
+ testing, so they do not need to be left there with the user wondering
+ where they came from.
+ - And a number of small bug fixes and typos as well.
+
1.008 2013-11-30 04:46:59 America/New_York
- Fixed github#1 by fixing mistakenly commented out code that was poorly
half refactored.
View
54 bin/fetchware
@@ -78,6 +78,7 @@ our %EXPORT_TAGS = (
edit_manually
check_fetchwarefile
ask_to_install_now_to_test_fetchwarefile
+ run
)]
);
our @EXPORT_OK = @{$EXPORT_TAGS{TESTING}};
@@ -136,8 +137,8 @@ EOM
# $VERSION is managed by dzil; therefore, I use eval to access it at
# run time instead of compile time, so that I can test fetchware without
# running dzil test.
- 'version|V' => sub { eval 'say "Fetchware version $VERSION"; '; exit 0},
- 'help|h|?' => \&help,
+ 'version|V' => sub { eval 'say "Fetchware version $fetchware::VERSION"; '; exit 0},
+ 'help|h|?' => \&cmd_help,
'verbose|v' => \$verbose,
'quiet|q' => \$quiet,
###BUGALERT### dry-run functionality is *not* implemented!!!
@@ -161,7 +162,7 @@ EOM
# tell the user that they can clean it up with fetchware clean??
# Also, add cmdline options to control what to do when this happens???
vmsg 'Determining which command to run based on command line options.';
- my $command = shift @ARGV;
+ my $command = shift @ARGV // 'defined but not an actual command';
if ($command eq 'install') {
cmd_install(@ARGV);
} elsif ($command eq 'uninstall') {
@@ -409,7 +410,7 @@ EOM
=
extract_fetchwarefile($fetchware_package_path, cwd());
vmsg <<EOM;
-Extracting out Fetchwarefile from [$fetchware_package_path] to [$fetchwarefile]
+Extracting out Fetchwarefile from [$fetchware_package_path] to [$$fetchwarefile]
EOM
} else {
die <<EOD;
@@ -424,7 +425,7 @@ EOD
# to the imported subroutines and modified fetchware configuration (%CONFIG)
# just as the child does.
parse_fetchwarefile($fetchwarefile);
- vmsg "Parsed Fetchwarefile [$fetchwarefile].";
+ vmsg "Parsed Fetchwarefile [$$fetchwarefile].";
# start() runs as root before the fork, because it uses
# App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
@@ -2170,7 +2171,7 @@ EOD
# to the imported subroutines and modified fetchware configuration (%CONFIG)
# just as the child does.
parse_fetchwarefile($fetchwarefile);
- vmsg "Parsed Fetchwarefile [$fetchwarefile].";
+ vmsg "Parsed Fetchwarefile [$$fetchwarefile].";
# start() runs as root before the fork, because it uses
# App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
@@ -2297,8 +2298,8 @@ EOM
# name that would support multiple versions being in the fetchware
# package database at the same time.
###BUGALERT### The above Note is a ridiculous bug. Fix it!
- vmsg 'Uninstalled the old fetchware package from the fetchware database.';
uninstall_fetchware_package_from_database($fetchware_package_path);
+ vmsg 'Uninstalled the old fetchware package from the fetchware database.';
my $installed_fetchware_package_path
= copy_fpkg_to_fpkg_database($updated_fetchware_package_path);
@@ -2434,7 +2435,7 @@ sub cmd_look {
if ($filename =~ /\.fpkg$/) {
$fetchwarefile = extract_fetchwarefile($filename);
vmsg <<EOM;
-Extracting out Fetchwarefile from [$filename] to [$fetchwarefile]
+Extracting out Fetchwarefile from [$filename] to [$$fetchwarefile]
EOM
} else {
my $fh = safe_open($filename, <<EOD);
@@ -2445,14 +2446,14 @@ EOD
# Add a \ to turn the slurped scalar into a scalar ref for calling
# parse_fetchwarefile() properly.
$fetchwarefile = \do {local $/; <$fh>};
- vmsg "Slurped [$filename] into fetchware: [$fetchwarefile]";
+ vmsg "Slurped [$filename] into fetchware: [$$fetchwarefile]";
}
# Must parse the Fetchwarefile in the parent, so that the parent has access
# to the imported subroutines and modified fetchware configuration (%CONFIG)
# just as the child does.
parse_fetchwarefile($fetchwarefile);
- vmsg "Parsed Fetchwarefile [$fetchwarefile].";
+ vmsg "Parsed Fetchwarefile [$$fetchwarefile].";
# start() runs as root before the fork, because it uses
# App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
@@ -2769,7 +2770,6 @@ And then C<exit()>s with an exit status of 0 indicating success.
sub cmd_help {
print <<'HELP';
-
fetchware is a package manager for source code distributions. It gives you the
ability to install, uninstall, and even upgrade your source code distributions
just like you can with your binary packages using yum, apt-get, or slackpkg.
@@ -2782,28 +2782,28 @@ exceed the ability of fetchware's q&a configuration see perldoc App::Fetchware
for instructions on manual Fetchwarefile configuration.
USAGE:
- fetchware new|install|uninstall|upgrade|upgrade-all|list|look|clean|help
- [--help|-h|-?|--version|-V|--verbose|-v|--quiet|-q]
- package-name
+ fetchware new|install|uninstall|upgrade|upgrade-all|list|look|clean|help
+ --help|-h|-?|--version|-V|--verbose|-v|--quiet|-q]
+ package-name
COMMANDS:
new - creates a new Fetchwarefile for use with fetchware.
- install - installs a fetchware package, which is a .tar.gz ending with
- .fpkg, which includes the source code distribution unmodified,
- but with an included Fetchwarefile. See perldoc fetchware.
- uninstall - uninstalls a fetchware package.
- upgrade - upgrades a fetchware package if a newer version is available.
- upgrade-all - upgrades *all* installed fetchware packages.
+ install - installs a fetchware package, which is a .tar.gz ending with
+ .fpkg, which includes the source code distribution unmodified,
+ but with an included Fetchwarefile. See perldoc fetchware.
+ uninstall - uninstalls a fetchware package.
+ upgrade - upgrades a fetchware package if a newer version is available.
+ upgrade-all - upgrades *all* installed fetchware packages.
list - lists all installed fetchware packages.
look - downloads and unarchives a fetchware package for viewing.
clean - deletes any left over messes caused by fetchware in your tempdir.
- help - prints this help message
+ help - prints this help message
OPTIONS:
- --help|-h|-? - prints this help message.
- --version|-V - prints a version message.
- --verbose|-v - prints additional logging information.
- --quiet|-q - prints *no* logging invormation. Determine success or
- failure with fetchware's exit status. 0 = success. Non-zero = failure.
+ --help|-h|-? - prints this help message.
+ --version|-V - prints a version message.
+ --verbose|-v - prints additional logging information.
+ --quiet|-q - prints *no* logging invormation. Determine success or
+ failure with fetchware's exit status. 0 = success. Non-zero = failure.
For more information see perldoc fetchware and perldoc App::Fetchware.
HELP
@@ -3270,7 +3270,7 @@ EOD
=head2 uninstall_fetchware_package_from_database()
- my uninstall_fetchware_package_from_database($uninstall_package_name);
+ uninstall_fetchware_package_from_database($uninstall_package_name);
Deletes the specified $uninstall_package_name from the fetchware package
database. Throws an exception on error.
View
2 dist.ini
@@ -4,7 +4,7 @@ license = Perl_5
copyright_holder = David Yingling
copyright_year = 2013
-version = 1.008
+version = 1.009
; Change bugtracker to github
[MetaResources]
View
12 lib/App/Fetchware/Util.pm
@@ -291,16 +291,13 @@ EOD
=head2 Executing external commands without using run_prog()
-Subify the -q checking code, and paste it below, and tell users to use that if
-they want to use something else, and document the $fetchware::quiet variable for
-other users too.
-
msg(), vmsg(), and run_prog() determine if -v and if -q were specified by
checking the values of the global variables listed below:
=over
=item * $fetchware::quiet - is C<0> if -q was B<not> specified.
+
=item * $fetchware::verbose - is C<0> if -v was B<not> specified.
=back
@@ -604,12 +601,17 @@ sub http_download_dirlist {
###BUGALERT### Should use request() instead of get, because request can
#directly write the chunks of the file to disk as they are downloaded. get()
#just uses RAM, so a 50Meg file takes up 50 megs of ram, and so on.
+ ###BUGALERT### Also, if you use request instead, and get chunks of bytes
+ #instead of just writing them to disk, you could also use a
+ #Term::ProgressBar to print a cool progress bar during the download!
+ #This could also be added to the ftp downloaders too, but probably not the
+ #local file:// downloaders though.
my $response = $http->get($http_url);
die <<EOD unless $response->{success};
App-Fetchware: run-time error. HTTP::Tiny failed to download a directory listing
of your provided lookup_url. HTTP status code [$response->{status} $response->{reason}]
-HTTP headers [@{[Data::Dumper::Dumper($response->{headers})]}].
+HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD
View
61 lib/Test/Fetchware.pm
@@ -38,6 +38,7 @@ our %EXPORT_TAGS = (
TESTING => [qw(
eval_ok
print_ok
+ fork_ok
skip_all_unless_release_testing
make_clean
make_test_dist
@@ -188,6 +189,66 @@ sub print_ok {
}
+=head2 fork_ok()
+
+ fork_ok(&code_fork_should_do, $test_name);
+
+Simply properly forks, and runs the caller's provided coderef in the child,
+and tests that the child's exit value is 0 for success using a simple ok() call from
+Test::More. The child's exit value is controlled by the caller based on what
+&code_fork_should_do returns. If &code_fork_should_do returns true, then the
+child returns C<0> for success, and if &code_fork_should_do returns false, then
+the child returns C<1> for failure.
+
+Because the fork()ed child is a copy of the current perl process you can still
+access whatever Test::More or Test::Fetchware testing subroutines you may have
+imported for use in the test file that uses fork_ok().
+
+This testing helper subroutine only exists for testing fetchware's command line
+interface. This interface is fetchware's run() subroutine and when you actually
+execute the fetchware program from the command line such as C<fetchware help>.
+
+=over
+
+=item WARNING
+
+fork_ok() has a major bug that makes any tests you attempt to run in
+&code_fork_should_do that fail never report this failure properly to
+Test::Builder. Also, any success is not reported either. This is not fork_ok()'s
+fault it is Test::Builder's fault for still not having support for forking. This
+lack of support for forking may be fixed in Test::Builder 1.5 or perhaps 2.0,
+but those are still in development.
+
+=back
+
+=cut
+
+sub fork_ok {
+ my $coderef = shift;
+ my $test_name = shift;
+
+
+ my $kid = fork;
+ die "Couldn't fork: $!\n" if not defined $kid;
+ # ... parent code here ...
+ if ( $kid ) {
+ # Block waiting for the child process ($kid) to exit.
+ waitpid($kid, 0);
+ }
+ # ... child code here ...
+ else {
+ # Run caller's code wihtout any args.
+ # And exit based on the success or failure of $coderef.
+ $coderef->() ? exit 0 : exit 1;
+ }
+
+ # And test that the child returned successfully.
+ ok($? == 0, $test_name);
+
+ return $?;
+}
+
+
=head2 skip_all_unless_release_testing()
subtest 'some subtest that tests fetchware' => sub {
View
18 t/Test-Fetchware.t
@@ -7,7 +7,7 @@ use diagnostics;
use 5.010001;
# Test::More version 0.98 is needed for proper subtest support.
-use Test::More 0.98 tests => '7'; #Update if this changes.
+use Test::More 0.98 tests => '8'; #Update if this changes.
use File::Spec::Functions qw(splitpath catfile rel2abs tmpdir);
use Path::Class;
@@ -38,6 +38,7 @@ subtest 'TESTING export what they should' => sub {
my @expected_testing_exports = qw(
eval_ok
print_ok
+ fork_ok
skip_all_unless_release_testing
make_clean
make_test_dist
@@ -214,6 +215,21 @@ subtest 'test add_prefix_if_nonroot() success' => sub {
};
+subtest 'test fork_ok()' => sub {
+ fork_ok(sub {ok(1, 'successful fork_ok() test.')},
+ 'checked fork_ok() success.');
+
+ # Abuse a TODO block to test fork_ok() failure by turning that failure into
+ # success. When this test fails it succeeds, because it is testing failure.
+ TODO: {
+ todo_skip 'Turn failure into success.', 1;
+
+ fork_ok(sub { return 0 },
+ 'checked fork_ok() failure.');
+ }
+};
+
+
# Remove this or comment it out, and specify the number of tests, because doing
# so is more robust than using this, but this is better than no_plan.
#done_testing();
View
2 t/bin-fetchware-clean.t
@@ -48,7 +48,7 @@ subtest 'test cmd_clean() success' => sub {
my $tempdir = create_tempdir(TempDir => $cwd);
ok(-e $tempdir, 'checked creating a temporary directory.');
- print_ok(sub {cmd_clean(original_cwd)},
+ print_ok(sub {cmd_clean(original_cwd())},
qr/.*?] locked by another fetchware process\. Skipping\./,
'checked cmd_clean skipping locked fetchware directories.');
View
432 t/bin-fetchware-command-line.t
@@ -0,0 +1,432 @@
+#!perl
+# bin-fetchware-command-line.t tests bin/fetchware's command line interface.
+use strict;
+use warnings;
+use diagnostics;
+use 5.010001;
+
+
+# Test::More version 0.98 is needed for proper subtest support.
+use Test::More 0.98 tests => '11'; #Update if this changes.
+
+use App::Fetchware::Config ':CONFIG';
+use Test::Fetchware ':TESTING';
+use File::Spec::Functions 'catfile';
+use File::Temp 'tempdir';
+use Cwd 'cwd';
+
+
+# Set PATH to a known good value.
+$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
+# Delete *bad* elements from environment to make it safer as recommended by
+# perlsec.
+delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+
+# Load bin/fetchware "manually," because it isn't a real module, and has no .pm
+# extenstion use expects.
+BEGIN {
+ my $fetchware = 'fetchware';
+ use lib 'bin';
+ require $fetchware;
+ fetchware->import(':TESTING');
+ ok(defined $INC{$fetchware}, 'checked bin/fetchware loading and import')
+}
+
+
+subtest 'test command line install' => sub {
+ # Clear App::Fetchware's internal configuration information, which I must do
+ # if I parse more than one Fetchwarefile in a running of fetchware.
+ __clear_CONFIG();
+
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ verbose_on();
+
+ ok(run_perl('install', $test_dist_path),
+ 'Checked command line test-dist install success');
+
+ # Now uninstall the useless test dist.
+ ok(cmd_uninstall('test-dist-1.00'),
+ 'checked cmd_install() clean up installed test-dist.');
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_install() delete temp files.');
+};
+
+
+subtest 'test command line uninstall' => sub {
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ # I obviously must install apache before I can test uninstalling it :)
+ cmd_install($test_dist_path);
+ # And then test if the install was successful.
+ ok(grep /test-dist-1.00/, glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) test setup success.');
+
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+
+ ok(run_perl('uninstall', 'test-dist-1.00'),
+ 'Checked command line uninstall test-dist success.');
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_uninstall() clean up.');
+};
+
+
+##BROKEN## Even t/bin-fetchware-new.t does not actually test new completly yet,
+#so until that is done I can not test it here.
+##BROKEN##subtest 'test command line new' => sub {
+##BROKEN##
+##BROKEN##};
+
+
+subtest 'test command line upgrade' => sub {
+ # Actually test during user install!!!
+ # Delete all existing httpd fetchware packages in fetchware_database_path(),
+ # which will screw up the installation and upgrading of httpd below.
+ for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
+ # Clean up $fetchware_package.
+ if ($fetchware_package =~ /test-dist/) {
+ ok((unlink $fetchware_package),
+ 'checked cmd_upgrade() clean up fetchware database path')
+ if -e $fetchware_package
+ }
+ }
+
+
+ # Create a $temp_dir for make_test_dist() to use. I need to do this, so that
+ # both the old and new test dists can be in the same directory.
+ my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+ # However, not only do I have create the tempdir, but I must also chmod 755
+ # this temporary directory to ensure read access if this test file is run as
+ # root, and then drops its privs without the extra read perms this test will
+ # fail, because the nobody user will not be able to access this directory's
+ # 700 perms.
+ chmod 0755, $upgrade_temp_dir or fail(<<EOF);
+Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
+EOF
+
+note("UPGRADETD[$upgrade_temp_dir]");
+
+ my $old_test_dist_path = make_test_dist('test-dist', '1.00',
+ $upgrade_temp_dir);
+
+ my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
+
+ # Delete all existing httpd fetchware packages in fetchware_database_path(),
+ # which will screw up the installation and upgrading of httpd below.
+ for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
+ # Delete *only* httpd.
+ if ($fetchware_package =~ /test-dist/) {
+ # Clean up $fetchware_package.
+ ok((unlink $fetchware_package),
+ 'checked cmd_upgrade() clean up fetchware database path')
+ if -e $fetchware_package;
+ }
+ }
+
+note("INSTALLPATH[$old_test_dist_path]");
+
+ # I obviously must install test-dist before I can test upgrading it :)
+ my $fetchware_package_path = cmd_install($old_test_dist_path);
+ # And then test if the install was successful.
+ ok(grep /test-dist/, glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) success.');
+
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+
+
+ # Sleep for 2 seconds to ensure that the new version is a least a couple of
+ # seconds newer than the original version. Perl is pretty fast, so it can
+ # actually execute this whole friggin subtest in less than one second on my
+ # decent desktop system.
+ sleep 2;
+
+
+ my $new_test_dist_path = make_test_dist('test-dist', '1.01',
+ $upgrade_temp_dir);
+
+ my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
+
+note("upgradepath[");
+system('ls', '-lh', $upgrade_temp_dir);
+note("]");
+
+ ok(run_perl('upgrade', 'test-dist'),
+ 'Checked command line @ARGV upgrade success');
+
+ print_ok(sub {cmd_list()},
+ sub {grep({$_ =~ /test-dist-1\.01/} (split "\n", $_[0]))},
+ 'check cmd_upgrade() success.');
+
+
+
+ # Test for when cmd_upgrade() determines that the latest version is
+ # installed.
+ # Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ ok(run_perl('upgrade', 'test-dist'),
+ 'Checked command line @ARGV upgrade version already installed');
+
+ # Clean up upgrade path.
+ ok(unlink($old_test_dist_path, $old_test_dist_path_md5,
+ $new_test_dist_path, $new_test_dist_path_md5),
+ 'checked cmd_upgrade() delete temp upgrade files');
+
+ # Clean up installed and upgraded test-dist!
+ ok(unlink(catfile(fetchware_database_path(), 'test-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+};
+
+
+# Set FETCHWARE_DATABASE_PATH to a tempdir, so that this test uses a different
+# path for your fetchware database than the one fetchware normally uses after it
+# is installed. This is to avoid any conflicts--especially because this test
+# file upgrades everything in your fetchware database path, so we need to ensure
+# that there are just simple testing packages in ther, and not something more
+# annoying.
+$ENV{FETCHWARE_DATABASE_PATH} = tempdir("fetchware-test-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+
+
+subtest 'test command line upgrade-all' => sub {
+ # Actually test during user install!!!
+
+ # Create a $temp_dir for make_test_dist() to use. I need to do this, so that
+ # both the old and new test dists can be in the same directory.
+ my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+ # However, not only do I hav to create the tempdir, but I must also chmod
+ # 755 this temporary directory to ensuer read access if this test file is
+ # run as root, and then drops its privs without the extra read perms this
+ # test will fail, because the nobody user will not be able to access this
+ # directory's 700 perms.
+ chmod 0755, $upgrade_temp_dir or fail(<<EOF);
+Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
+EOF
+
+ my $old_test_dist_path = make_test_dist('test-dist', '1.00', $upgrade_temp_dir);
+ my $old_another_dist_path = make_test_dist('another-dist', '1.00', $upgrade_temp_dir);
+
+ my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
+ my $old_another_dist_path_md5 = md5sum_file($old_another_dist_path);
+
+
+ # I obviously must install test-dist before I can test upgrading it :)
+ for my $fpkg_to_install ($old_test_dist_path, $old_another_dist_path) {
+ my $fetchware_package_path = cmd_install($fpkg_to_install);
+ # And then test if the install was successful.
+ ok(grep /test-dist|another-dist/,
+ glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) success.');
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ }
+
+
+ # Sleep for 2 seconds to ensure that the new version is a least a couple of
+ # seconds newer than the original version. Perl is pretty fast, so it can
+ # actually execute this whole friggin subtest on my decent desktop system
+ # in less thatn one second.
+ sleep 2;
+
+
+ # Create new test fpkgs and md5s in same dir for cmd_upgrade_all() to work.
+ my $new_test_dist_path = make_test_dist('test-dist', '1.01', $upgrade_temp_dir);
+ my $new_another_dist_path = make_test_dist('another-dist', '1.01', $upgrade_temp_dir);
+
+ my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
+ my $new_another_dist_path_md5 = md5sum_file($new_another_dist_path);
+
+
+ # Upgrade all installed fetchware packages.
+ ok(run_perl('upgrade-all'),
+ 'Checked command line @ARGV upgrade-all success. ');
+
+ print_ok(sub {cmd_list()},
+ sub {grep({$_ =~ /(test|another)-dist-1\.01/} (split "\n", $_[0]))},
+ 'check cmd_upgrade_all() success.');
+
+
+ # Test for when cmd_upgrade() determines that the latest version is
+ # installed.
+ # Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ is(cmd_upgrade_all(), 'No upgrade needed.',
+ 'checked cmd_upgrade() latest version already installed.');
+
+ # Clean up upgrade path.
+ ok(unlink($old_test_dist_path, $old_test_dist_path_md5,
+ $old_another_dist_path, $old_another_dist_path_md5,
+ $new_test_dist_path, $new_test_dist_path_md5,
+ $new_another_dist_path, $new_another_dist_path_md5,
+ ), 'checked cmd_upgrade() delete temp upgrade files');
+
+ # Clean up installed and upgraded test-dist!
+ ok(unlink(catfile(fetchware_database_path(), 'test-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+ ok(unlink(catfile(fetchware_database_path(), 'another-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+
+};
+
+
+# Clear FETCHWARE_DATABASE_PATH, because only upgrade-all needs it.
+delete $ENV{FETCHWARE_DATABASE_PATH};
+
+
+subtest 'test command line list' => sub {
+ # First install a test package to make sure there is something for cmd_list()
+ # to find.
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ ok(cmd_install($test_dist_path),
+ 'checked cmd_list() by installing a test-dist to list');
+
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(sub {run_perl('list')},
+ 'checked list success.');
+
+# Annoyingly clean up CONFIG. Shouln't end() do this!!!!:)
+__clear_CONFIG();
+
+ # Now uninstall the useless test dist.
+ ok(cmd_uninstall('test-dist-1.00'),
+ 'checked cmd_list() clean up installed test-dist.');
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_list() delete temp files.');
+};
+
+
+subtest 'test command line look' => sub {
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ ok(run_perl('look', $test_dist_path),
+ 'checked command line look success.');
+
+ # Cleanup the test-dist crap.
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_list() delete temp files.');
+};
+
+
+subtest 'test command line clean' => sub {
+ # $cwd is needed multiple times so just store it in a variable.
+ my $cwd = cwd();
+
+ # Test cmd_clean()'s ability to delete temporary files that start with
+ # fetchware-* or Fetchwarefile-*.
+ my $fetchware_tempdir = tempdir("fetchware-$$-XXXXXXXXX", DIR => $cwd,
+ CLEANUP => 1);
+ my $fetchwarefile_tempdir = tempdir("Fetchwarefile-$$-XXXXXXXXX",
+ DIR => $cwd, CLEANUP => 1);
+
+ ok(-e $fetchware_tempdir, 'checked creating fetchware temporary directory.');
+ ok(-e $fetchwarefile_tempdir, 'checked creating Fetchwarefile temporary directory.');
+
+ # Delete newly created tempfiles.
+ ok(run_perl('clean', $cwd),
+ 'checked command line clean success.');
+
+ ok(! -e $fetchware_tempdir,
+ 'checked deleting fetchware temporary directory success.');
+ ok(! -e $fetchwarefile_tempdir,
+ 'checked deleting Fetchwarefile temporary directory success.');
+};
+
+
+# Tests command line when @ARGV's first value is *not* one of fetchware's allowable
+# commands.
+subtest 'test command line default' => sub {
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl($^X, 'bin/fetchware'),
+ 'Checked command line @ARGV = help.');
+
+
+ # Now test that the same else is hit if an unrecognized command is
+ # specified.
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('unrecognized'),
+ 'Checked command line @ARGV = help.');
+};
+
+
+subtest 'test command line help' => sub {
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('help'),
+ 'Checked command line @ARGV = help.');
+};
+
+
+subtest 'test command line command line options' => sub {
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('-h'),
+ 'Checked command line @ARGV = -h.');
+
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('--help'),
+ 'Checked command line @ARGV = --help.');
+
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('-?'),
+ 'Checked command line @ARGV = -?.');
+
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('-V'),
+ 'checked command line -V option success.');
+
+ ###BUGALERT### Only tests if bin/fetchware's exit value is 0, because
+ #print_ok() cannot test a forked and execed processes' STDOUT only the
+ #current processes STDOUT.
+ ok(run_perl('--version'),
+ 'checked command line --version option success.');
+};
+
+
+# Remove this or comment it out, and specify the number of tests, because doing
+# so is more robust than using this, but this is better than no_plan.
+#done_testing();
+
+# Like run_prog() but never prints anything extra, and includes the $^X and
+# 'bin/fetchware' stuff all of these tests need. And it returns
+sub run_perl {
+ my $retval = system($^X, 'bin/fetchware', @_);
+ $retval == 0 or die <<EOD;
+system(\$^X, 'bin/fetchware', @_) failed. OS error [$!].
+EOD
+ # system() returns 0 for success, but 0 is false in perl, so I have to turn
+ # it into a normal true or false value for use with ok() or print_ok().
+ return $retval == 0 ? 1 : 0;
+}
View
22 t/bin-fetchware-list.t
@@ -48,26 +48,8 @@ subtest 'test cmd_list() success' => sub {
'checked cmd_list() by installing a test-dist to list');
note("CWD[@{[cwd()]}]");
- my $stdout;
- my $error;
- {
- # localize stdout, and open it for reading to test cmd_list()'s output.
- local *STDOUT;
- open STDOUT, '>', \$stdout
- or $error = "Can't open STDOUTto test cmd_list()'s output: $!";
-
- # Writes to STDOUT, which is redirected to $stdout above.
- cmd_list();
-
- close STDOUT
- or $error = "WTF! close STDOUT actually failed Huh?!?: $!";
- }
- # Catch any errors that will be screwed up, because of STDOUT being stolen.
- fail($error) if defined $error;
-
- # Test cmd_list()'s output.
- ok(grep { $_ eq 'test-dist-1.00' } (split "\n", $stdout),
- 'checked cmd_list() success');
+ print_ok(sub {cmd_list()}, qr/test-dist-1\.00/,
+ 'checked cmd_list() success.');
# Annoyingly clean up CONFIG. Shouln't end() do this!!!!:)
__clear_CONFIG();
View
3 t/bin-fetchware-look.t
@@ -83,8 +83,9 @@ subtest 'test cmd_look() test-dist success' => sub {
my $test_dist_md5 = md5sum_file($test_dist_path);
my $look_path = cmd_look($test_dist_path);
+note("LOOKPATH[$look_path]");
- like($look_path, qr//,
+ like($look_path, qr/test-dist-1\.00/,
'check cmd_look(test-dist) success.');
# Cleanup the test-dist crap.
View
481 t/bin-fetchware-run.t
@@ -0,0 +1,481 @@
+#!perl
+# bin-fetchware-run.t tests bin/fetchware's run() subroutine, which
+# does command line option parsing and executes whatever cmd_*() subroutine that
+# is needed.
+use strict;
+use warnings;
+use diagnostics;
+use 5.010001;
+
+
+# Test::More version 0.98 is needed for proper subtest support.
+use Test::More 0.98 tests => '11'; #Update if this changes.
+
+use App::Fetchware::Config ':CONFIG';
+use Test::Fetchware ':TESTING';
+use File::Spec::Functions 'catfile';
+use File::Temp 'tempdir';
+use Cwd 'cwd';
+
+
+# Set PATH to a known good value.
+$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
+# Delete *bad* elements from environment to make it safer as recommended by
+# perlsec.
+delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+
+# Load bin/fetchware "manually," because it isn't a real module, and has no .pm
+# extenstion use expects.
+BEGIN {
+ my $fetchware = 'fetchware';
+ use lib 'bin';
+ require $fetchware;
+ fetchware->import(':TESTING');
+ ok(defined $INC{$fetchware}, 'checked bin/fetchware loading and import')
+}
+
+
+subtest 'test run() install' => sub {
+ # Clear App::Fetchware's internal configuration information, which I must do
+ # if I parse more than one Fetchwarefile in a running of fetchware.
+ __clear_CONFIG();
+
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ verbose_on();
+
+ {
+ local @ARGV = ('install', $test_dist_path);
+ fork_ok(sub { run() },
+ 'Checked run() test-dist install success');
+ }
+
+ # Now uninstall the useless test dist.
+ ok(cmd_uninstall('test-dist-1.00'),
+ 'checked cmd_install() clean up installed test-dist.');
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_install() delete temp files.');
+};
+
+
+subtest 'test run() uninstall' => sub {
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ # I obviously must install apache before I can test uninstalling it :)
+ cmd_install($test_dist_path);
+ # And then test if the install was successful.
+ ok(grep /test-dist-1.00/, glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) test setup success.');
+
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+
+ {
+ local @ARGV = ('uninstall', 'test-dist-1.00');
+ fork_ok(sub { run() },
+ 'Checked run() uninstall test-dist success.');
+ }
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_uninstall() clean up.');
+};
+
+
+##BROKEN## Even t/bin-fetchware-new.t does not actually test new completly yet,
+#so until that is done I can not test it here.
+##BROKEN##subtest 'test run() new' => sub {
+##BROKEN##
+##BROKEN##};
+
+
+subtest 'test run() upgrade' => sub {
+ # Actually test during user install!!!
+ # Delete all existing httpd fetchware packages in fetchware_database_path(),
+ # which will screw up the installation and upgrading of httpd below.
+ for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
+ # Clean up $fetchware_package.
+ if ($fetchware_package =~ /test-dist/) {
+ ok((unlink $fetchware_package),
+ 'checked cmd_upgrade() clean up fetchware database path')
+ if -e $fetchware_package
+ }
+ }
+
+
+ # Create a $temp_dir for make_test_dist() to use. I need to do this, so that
+ # both the old and new test dists can be in the same directory.
+ my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+ # However, not only do I have create the tempdir, but I must also chmod 755
+ # this temporary directory to ensure read access if this test file is run as
+ # root, and then drops its privs without the extra read perms this test will
+ # fail, because the nobody user will not be able to access this directory's
+ # 700 perms.
+ chmod 0755, $upgrade_temp_dir or fail(<<EOF);
+Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
+EOF
+
+note("UPGRADETD[$upgrade_temp_dir]");
+
+ my $old_test_dist_path = make_test_dist('test-dist', '1.00',
+ $upgrade_temp_dir);
+
+ my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
+
+ # Delete all existing httpd fetchware packages in fetchware_database_path(),
+ # which will screw up the installation and upgrading of httpd below.
+ for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
+ # Delete *only* httpd.
+ if ($fetchware_package =~ /test-dist/) {
+ # Clean up $fetchware_package.
+ ok((unlink $fetchware_package),
+ 'checked cmd_upgrade() clean up fetchware database path')
+ if -e $fetchware_package;
+ }
+ }
+
+note("INSTALLPATH[$old_test_dist_path]");
+
+ # I obviously must install test-dist before I can test upgrading it :)
+ my $fetchware_package_path = cmd_install($old_test_dist_path);
+ # And then test if the install was successful.
+ ok(grep /test-dist/, glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) success.');
+
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+
+
+ # Sleep for 2 seconds to ensure that the new version is a least a couple of
+ # seconds newer than the original version. Perl is pretty fast, so it can
+ # actually execute this whole friggin subtest in less than one second on my
+ # decent desktop system.
+ sleep 2;
+
+
+ my $new_test_dist_path = make_test_dist('test-dist', '1.01',
+ $upgrade_temp_dir);
+
+ my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
+
+note("upgradepath[");
+system('ls', '-lh', $upgrade_temp_dir);
+note("]");
+
+ {
+ local @ARGV = ('upgrade', 'test-dist');
+ fork_ok(sub { run() },
+ 'Checked run() @ARGV upgrade success');
+ }
+
+ print_ok(sub {cmd_list()},
+ sub {grep({$_ =~ /test-dist-1\.01/} (split "\n", $_[0]))},
+ 'check cmd_upgrade() success.');
+
+
+
+ # Test for when cmd_upgrade() determines that the latest version is
+ # installed.
+ # Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ {
+ local @ARGV = ('upgrade', 'test-dist');
+ fork_ok(sub { run() },
+ 'Checked run() @ARGV upgrade version already installed');
+ }
+
+ # Clean up upgrade path.
+ ok(unlink($old_test_dist_path, $old_test_dist_path_md5,
+ $new_test_dist_path, $new_test_dist_path_md5),
+ 'checked cmd_upgrade() delete temp upgrade files');
+
+ # Clean up installed and upgraded test-dist!
+ ok(unlink(catfile(fetchware_database_path(), 'test-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+};
+
+
+# Set FETCHWARE_DATABASE_PATH to a tempdir, so that this test uses a different
+# path for your fetchware database than the one fetchware normally uses after it
+# is installed. This is to avoid any conflicts--especially because this test
+# file upgrades everything in your fetchware database path, so we need to ensure
+# that there are just simple testing packages in ther, and not something more
+# annoying.
+$ENV{FETCHWARE_DATABASE_PATH} = tempdir("fetchware-test-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+
+
+subtest 'test run() upgrade-all' => sub {
+ # Actually test during user install!!!
+
+ # Create a $temp_dir for make_test_dist() to use. I need to do this, so that
+ # both the old and new test dists can be in the same directory.
+ my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
+ CLEANUP => 1, TMPDIR => 1);
+ # However, not only do I hav to create the tempdir, but I must also chmod
+ # 755 this temporary directory to ensuer read access if this test file is
+ # run as root, and then drops its privs without the extra read perms this
+ # test will fail, because the nobody user will not be able to access this
+ # directory's 700 perms.
+ chmod 0755, $upgrade_temp_dir or fail(<<EOF);
+Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
+EOF
+
+ my $old_test_dist_path = make_test_dist('test-dist', '1.00', $upgrade_temp_dir);
+ my $old_another_dist_path = make_test_dist('another-dist', '1.00', $upgrade_temp_dir);
+
+ my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
+ my $old_another_dist_path_md5 = md5sum_file($old_another_dist_path);
+
+
+ # I obviously must install test-dist before I can test upgrading it :)
+ for my $fpkg_to_install ($old_test_dist_path, $old_another_dist_path) {
+ my $fetchware_package_path = cmd_install($fpkg_to_install);
+ # And then test if the install was successful.
+ ok(grep /test-dist|another-dist/,
+ glob(catfile(fetchware_database_path(), '*')),
+ 'check cmd_install(Fetchware) success.');
+
+ # Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ }
+
+
+ # Sleep for 2 seconds to ensure that the new version is a least a couple of
+ # seconds newer than the original version. Perl is pretty fast, so it can
+ # actually execute this whole friggin subtest on my decent desktop system
+ # in less thatn one second.
+ sleep 2;
+
+
+ # Create new test fpkgs and md5s in same dir for cmd_upgrade_all() to work.
+ my $new_test_dist_path = make_test_dist('test-dist', '1.01', $upgrade_temp_dir);
+ my $new_another_dist_path = make_test_dist('another-dist', '1.01', $upgrade_temp_dir);
+
+ my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
+ my $new_another_dist_path_md5 = md5sum_file($new_another_dist_path);
+
+
+ # Upgrade all installed fetchware packages.
+ {
+ local @ARGV = ('upgrade-all');
+ fork_ok(sub { run() },
+ 'Checked run() @ARGV upgrade-all success. ');
+ }
+
+ print_ok(sub {cmd_list()},
+ sub {grep({$_ =~ /(test|another)-dist-1\.01/} (split "\n", $_[0]))},
+ 'check cmd_upgrade_all() success.');
+
+
+ # Test for when cmd_upgrade() determines that the latest version is
+ # installed.
+ # Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
+ # twice, and it's only supported once.
+ __clear_CONFIG();
+ is(cmd_upgrade_all(), 'No upgrade needed.',
+ 'checked cmd_upgrade() latest version already installed.');
+
+ # Clean up upgrade path.
+ ok(unlink($old_test_dist_path, $old_test_dist_path_md5,
+ $old_another_dist_path, $old_another_dist_path_md5,
+ $new_test_dist_path, $new_test_dist_path_md5,
+ $new_another_dist_path, $new_another_dist_path_md5,
+ ), 'checked cmd_upgrade() delete temp upgrade files');
+
+ # Clean up installed and upgraded test-dist!
+ ok(unlink(catfile(fetchware_database_path(), 'test-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+ ok(unlink(catfile(fetchware_database_path(), 'another-dist-1.01.fpkg')),
+ 'checked cmd_ugprade() delete useless test-dist from package database.');
+
+};
+
+
+# Clear FETCHWARE_DATABASE_PATH, because only upgrade-all needs it.
+delete $ENV{FETCHWARE_DATABASE_PATH};
+
+
+subtest 'test run() list' => sub {
+ # First install a test package to make sure there is something for cmd_list()
+ # to find.
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ ok(cmd_install($test_dist_path),
+ 'checked cmd_list() by installing a test-dist to list');
+
+ {
+ local @ARGV = ('list');
+ fork_ok(sub {
+ print_ok(sub {run()}, qr/test-dist-1\.00/,
+ 'checked cmd_list() success.');
+ },
+ 'Checked run() @ARGV list success');
+ }
+
+# Annoyingly clean up CONFIG. Shouln't end() do this!!!!:)
+__clear_CONFIG();
+
+ # Now uninstall the useless test dist.
+ ok(cmd_uninstall('test-dist-1.00'),
+ 'checked cmd_list() clean up installed test-dist.');
+
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_list() delete temp files.');
+};
+
+
+subtest 'test run() look' => sub {
+ my $test_dist_path = make_test_dist('test-dist', '1.00');
+ my $test_dist_md5 = md5sum_file($test_dist_path);
+
+ {
+ local @ARGV = ('look', $test_dist_path);
+ fork_ok(sub {run()},
+ 'checked run() look success.');
+ }
+
+ # Cleanup the test-dist crap.
+ ok(unlink($test_dist_path, $test_dist_md5),
+ 'checked cmd_list() delete temp files.');
+};
+
+
+subtest 'test run() clean' => sub {
+ # $cwd is needed multiple times so just store it in a variable.
+ my $cwd = cwd();
+
+ # Test cmd_clean()'s ability to delete temporary files that start with
+ # fetchware-* or Fetchwarefile-*.
+ my $fetchware_tempdir = tempdir("fetchware-$$-XXXXXXXXX", DIR => $cwd,
+ CLEANUP => 1);
+ my $fetchwarefile_tempdir = tempdir("Fetchwarefile-$$-XXXXXXXXX",
+ DIR => $cwd, CLEANUP => 1);
+
+ ok(-e $fetchware_tempdir, 'checked creating fetchware temporary directory.');
+ ok(-e $fetchwarefile_tempdir, 'checked creating Fetchwarefile temporary directory.');
+
+ # Delete newly created tempfiles.
+ {
+ local @ARGV = ('clean', $cwd);
+ fork_ok(sub {run()},
+ 'checked run() clean success.');
+ }
+
+ ok(! -e $fetchware_tempdir,
+ 'checked deleting fetchware temporary directory success.');
+ ok(! -e $fetchwarefile_tempdir,
+ 'checked deleting Fetchwarefile temporary directory success.');
+};
+
+
+# Tests run() when @ARGV's first value is *not* one of fetchware's allowable
+# commands.
+subtest 'test run() default' => sub {
+ {
+ local @ARGV = ();
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = help with print_ok().');
+ },
+ 'Checked run() with an empty @ARGV.');
+ }
+
+
+ # Now test that the same else is hit if an unrecognized command is
+ # specified.
+ {
+ local @ARGV = ('unrecognized');
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = help with print_ok().');
+ },
+ 'Checked run() with an unrecognized @ARGV.');
+ }
+};
+
+
+
+# Tests run() when @ARGV's first value is *not* one of fetchware's allowable
+# commands.
+subtest 'test run() help' => sub {
+ {
+ local @ARGV = ('help');
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = help with print_ok().');
+ },
+ 'Checked run() @ARGV = help.');
+ }
+};
+
+
+subtest 'test run() command line options' => sub {
+ {
+ local @ARGV = '-h';
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = -h with print_ok().');
+ },
+ 'checked run() -h success.');
+ }
+
+ {
+ local @ARGV = '-?';
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = -? with print_ok().');
+ },
+ 'checked run() -? success.');
+ }
+
+ {
+ local @ARGV = '--help';
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/fetchware is a package manager for source code distributions. It gives you the/,
+ 'Checked run() @ARGV = --help with print_ok().');
+ },
+ 'checked run() --help success.');
+ }
+
+ {
+ local @ARGV = '-V';
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/Fetchware version \d.\d\d\d/,
+ 'checked run() -V option success with print_ok().');
+ },
+ 'Checked run() -V option success.');
+ }
+
+ {
+ local @ARGV = '--version';
+ fork_ok(sub {
+ print_ok(sub {run()},
+ qr/Fetchware version \d.\d\d\d/,
+ 'checked run() --version option success with print_ok().');
+ },
+ 'Checked run() --version option success.');
+ }
+};
+
+
+# Remove this or comment it out, and specify the number of tests, because doing
+# so is more robust than using this, but this is better than no_plan.
+#done_testing();
View
4 t/bin-fetchware-util.t
@@ -290,7 +290,7 @@ subtest 'check copy_fpkg_to_fpkg_database()' => sub {
my $fetchwarefile = '# Fake Fetchwarefile just for testing';
my $fetchware_package_path = create_fetchware_package(\$fetchwarefile, cwd());
- copy_fpkg_to_fpkg_database($fetchware_package_path);
+ my $fpkg_copy = copy_fpkg_to_fpkg_database($fetchware_package_path);
# Get filename from the test packages original path.
my ($fetchware_package_filename) = ( splitpath($fetchware_package_path) )[2];
@@ -307,7 +307,7 @@ subtest 'check copy_fpkg_to_fpkg_database()' => sub {
my $cwd_lastdir = $cwd->dir_list(-1, 1);
# Delete generated files.
- ok(unlink("../Fetchwarefile", "../$cwd_lastdir.fpkg"),
+ ok(unlink("../Fetchwarefile", "../$cwd_lastdir.fpkg", $fpkg_copy),
'checked extract_fetchwarefile() delete generated files');
};

No commit comments for this range

Something went wrong with that request. Please try again.