Merge pull request #249 from rhansen/mockmodule

Fix `write_cache` tests

.github/workflows/ci.yml

@@ -34,6 +34,7 @@ jobs:
               libio-socket-inet6-perl \
               libio-socket-ip-perl \
               libplack-perl \
+              libtest-mockmodule-perl \
               libtest-tcp-perl \
               libtest-warnings-perl \
               liburi-perl \
@@ -113,6 +114,7 @@ jobs:
               perl-HTTP-Daemon-SSL \
               perl-IO-Socket-INET6 \
               perl-Plack \
+              perl-Test-MockModule \
               perl-Test-TCP \
               perl-Test-Warnings \
               ;

Makefile.am

@@ -67,7 +67,8 @@ PL_LOG_DRIVER = $(LOG_DRIVER)
 PL_LOG_COMPILER = $(PERL)
 AM_PL_LOG_FLAGS = -Mstrict -w \
 	-I'$(abs_top_builddir)' \
-	-I'$(abs_top_srcdir)'/t/lib
+	-I'$(abs_top_srcdir)'/t/lib \
+	-MDevel::Autoflush
 handwritten_tests = \
 	t/geturl_connectivity.pl \
 	t/geturl_ssl.pl \
@@ -77,6 +78,7 @@ generated_tests = \
 	t/version.pl
 TESTS = $(handwritten_tests) $(generated_tests)
 EXTRA_DIST += $(handwritten_tests) \
+	t/lib/Devel/Autoflush.pm \
 	t/lib/Test/Builder.pm \
 	t/lib/Test/Builder/Formatter.pm \
 	t/lib/Test/Builder/IO/Scalar.pm \

configure.ac

@@ -68,6 +68,7 @@ m4_foreach_w([_m], [
     HTTP::Response
     IO::Socket::IP
     Scalar::Util
+    Test::MockModule
     Test::TCP
     Test::Warnings
     Time::HiRes

t/lib/Devel/Autoflush.pm

@@ -0,0 +1,106 @@
+package Devel::Autoflush;
+# ABSTRACT: Set autoflush from the command line
+our $VERSION = '0.06'; # VERSION
+
+my $kwalitee_nocritic = << 'END';
+# can't use strict as older stricts load Carp and we can't allow side effects
+use strict;  
+END
+
+my $old = select STDOUT;
+$|++;
+select STDERR;
+$|++;
+select $old;
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Devel::Autoflush - Set autoflush from the command line
+
+=head1 VERSION
+
+version 0.06
+
+=head1 SYNOPSIS
+
+ perl -MDevel::Autoflush Makefile.PL
+
+=head1 DESCRIPTION
+
+This module is a hack to set autoflush for STDOUT and STDERR from the command
+line or from C<PERL5OPT> for code that needs it but doesn't have it.
+
+This often happens when prompting:
+
+  # guess.pl
+  print "Guess a number: ";
+  my $n = <STDIN>;
+
+As long as the output is going to a terminal, the prompt is flushed when STDIN
+is read.  However, if the output is being piped, the print statement will 
+not automatically be flushed, no prompt will be seen and the program will
+silently appear to hang while waiting for input.  This might happen with 'tee':
+
+  $ perl guess.pl | tee capture.out
+
+Use Devel::Autoflush to work around this:
+
+  $ perl -MDevel::Autoflush guess.pl | tee capture.out
+
+Or set it in C<PERL5OPT>:
+
+  $ export PERL5OPT=-MDevel::Autoflush
+  $ perl guess.pl | tee capture.out
+
+= SEE ALSO
+
+=over 4
+
+=item *
+
+L<CPANPLUS::Internals::Utils::Autoflush> -- same idea but STDOUT only and 
+
+only available as part of the full CPANPLUS distribution
+
+=back
+
+=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
+
+=head1 SUPPORT
+
+=head2 Bugs / Feature Requests
+
+Please report any bugs or feature requests through the issue tracker
+at L<https://github.com/dagolden/Devel-Autoflush/issues>.
+You will be notified automatically of any progress on your issue.
+
+=head2 Source Code
+
+This is open source software.  The code repository is available for
+public review and contribution under the terms of the license.
+
+L<https://github.com/dagolden/Devel-Autoflush>
+
+  git clone https://github.com/dagolden/Devel-Autoflush.git
+
+=head1 AUTHOR
+
+David Golden <dagolden@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2014 by David Golden.
+
+This is free software, licensed under:
+
+  The Apache License, Version 2.0, January 2004
+
+=cut

t/write_cache.pl

@@ -8,17 +8,15 @@ eval { require 'ddclient'; } or BAIL_OUT($@);
 my $warning;
 
 my $module = Test::MockModule->new('ddclient');
-$module->redefine('warning', sub {
+# Note: 'mock' is used instead of 'redefine' because 'redefine' is not available in the versions of
+# Test::MockModule distributed with old Debian and Ubuntu releases.
+$module->mock('warning', sub {
     BAIL_OUT("warning already logged") if defined($warning);
     $warning = sprintf(shift, @_);
 });
 my $tmpdir = File::Temp->newdir();
 my $dir = $tmpdir->dirname();
 diag("temporary directory: $dir");
-my $ro_tmpdir = File::Temp->newdir();
-my $ro_dir = $ro_tmpdir->dirname();
-chmod(0500, $ro_dir) or BAIL_OUT($!);
-diag("temporary read-only directory: $ro_dir");
 
 sub tc {
     return {
@@ -31,8 +29,8 @@ sub tc {
 my @test_cases = (
     tc("create cache file",    catfile($dir, 'a', 'b', 'cachefile'),        undef),
     tc("overwrite cache file", catfile($dir, 'a', 'b', 'cachefile'),        undef),
-    tc("bad directory",        catfile($dir, 'a', 'b', 'cachefile', 'bad'), qr/File exists/),
+    tc("bad directory",        catfile($dir, 'a', 'b', 'cachefile', 'bad'), qr/Failed to create/i),
-    tc("read-only directory",  catfile($ro_dir, 'cachefile'),               qr/Permission denied/),
+    tc("bad file",             catfile($dir, 'a', 'b'),                     qr/Failed to create/i),
 );
 
 for my $tc (@test_cases) {