Browse Source

testing: get_date(), rendering util, mock file writes

- move get_date() from App::WRT::Util to App::WRT::Date
- make App::WRT::FileIO and ::Util less redundant
- add App::WRT::Mock::FileIO for faking writes in tests
- make bin/wrt-render-all testable, add t/bin-wrt-render-all.t
Brennen Bearnes 2 months ago
parent
commit
9d3289b19f
12 changed files with 248 additions and 118 deletions
  1. 7
    0
      Changes
  2. 43
    27
      bin/wrt-render-all
  3. 18
    2
      lib/App/WRT.pm
  4. 36
    1
      lib/App/WRT/Date.pm
  5. 7
    38
      lib/App/WRT/FileIO.pm
  6. 50
    0
      lib/App/WRT/Mock/FileIO.pm
  7. 2
    4
      lib/App/WRT/Renderer.pm
  8. 1
    36
      lib/App/WRT/Util.pm
  9. 30
    0
      t/bin-wrt-render-all.t
  10. 12
    1
      t/wrt_date.t
  11. 38
    0
      t/wrt_renderer.t
  12. 4
    9
      t/wrt_util.t

+ 7
- 0
Changes View File

@@ -1,5 +1,12 @@
1 1
 Revision history for App::WRT
2 2
 
3
+v6.3.0 2019-06-22
4
+
5
+  - move get_date() from App::WRT::Util to App::WRT::Date
6
+  - make App::WRT::FileIO and ::Util less redundant
7
+  - add App::WRT::Mock::FileIO for faking writes in tests
8
+  - make bin/wrt-render-all testable, add t/bin-wrt-render-all.t
9
+
3 10
 v6.2.4 2019-05-28
4 11
 
5 12
   - Replace README.pod with a concise README.md

+ 43
- 27
bin/wrt-render-all View File

@@ -43,35 +43,51 @@ no  warnings 'uninitialized';
43 43
 use Getopt::Long;
44 44
 use Pod::Usage;
45 45
 use App::WRT;
46
+use App::WRT::FileIO;
46 47
 use App::WRT::Renderer;
47 48
 
48
-use App::WRT::Util qw(file_put_contents);
49
-
50
-# Handle options, including help generated from the POD above.  See:
51
-# - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options
52
-# - https://metacpan.org/pod/Pod::Usage
53
-# - http://michael.thegrebs.com/2014/06/08/Pod-Usage/
54
-my $config_file = 'wrt.json';
55
-GetOptions(
56
-  'config=s' => \$config_file,
57
-  help       => sub { pod2usage(0) },
58
-) or pod2usage(2);
59
-
60
-unless (-e $config_file) {
61
-  die "No wrt config file found.  Tried: $config_file";
49
+# If invoked directly from the command-line, caller() will return undef.
50
+# Execute main() with a callback to print output directly, a FileIO object,
51
+# and a copy of our real @ARGV:
52
+if (not caller()) {
53
+  my $output = sub { say @_; };
54
+  my $io = App::WRT::FileIO->new();
55
+  main($output, $io, @ARGV);
56
+  exit(0);
62 57
 }
63 58
 
64
-my $wrt = App::WRT::new_from_file($config_file);
65
-
66
-# This expects a callback to handle logging output and a callback to handle
67
-# file writing:
68
-
69
-my $renderer = App::WRT::Renderer->new(
70
-  $wrt,
71
-  sub { say $_[0]; },
72
-  sub { file_put_contents($_[0], $_[1]); },
73
-);
74
-
75
-$renderer->render();
59
+# main() takes an output callback, a FileIO object or equivalent, and an @ARGV
60
+# to pass in to GetOptionsFromArray().  This allows relatively simple
61
+# integration tests to be written.  See also: t/bin-wrt-render-all.t
62
+sub main {
63
+  my ($output, $io, @local_argv) = @_;
64
+
65
+  # Handle options, including help generated from the POD above.  See:
66
+  # - http://perldoc.perl.org/Getopt/Long.html#User-defined-subroutines-to-handle-options
67
+  # - https://metacpan.org/pod/Pod::Usage
68
+  # - http://michael.thegrebs.com/2014/06/08/Pod-Usage/
69
+  my $config_file = 'wrt.json';
70
+  GetOptions(
71
+    'config=s' => \$config_file,
72
+    help       => sub { pod2usage(0) },
73
+  ) or pod2usage(2);
74
+
75
+  unless (-e $config_file) {
76
+    die "No wrt config file found.  Tried: $config_file";
77
+  }
78
+
79
+  my $wrt = App::WRT::new_from_file($config_file);
80
+
81
+  # This expects a callback to handle logging output and a callback to handle
82
+  # file writing:
83
+
84
+  my $renderer = App::WRT::Renderer->new(
85
+    $wrt,
86
+    $output,
87
+    $io
88
+  );
89
+
90
+  $renderer->render();
91
+}
76 92
 
77
-exit(0);
93
+1;

+ 18
- 2
lib/App/WRT.pm View File

@@ -1,6 +1,22 @@
1 1
 package App::WRT;
2 2
 
3
-use version; our $VERSION = version->declare("v6.2.4");
3
+# From semver.org:
4
+#
5
+#   Given a version number MAJOR.MINOR.PATCH, increment the:
6
+#
7
+#       MAJOR version when you make incompatible API changes,
8
+#       MINOR version when you add functionality in a backwards-compatible
9
+#             manner, and
10
+#       PATCH version when you make backwards-compatible bug fixes.
11
+#
12
+#   Additional labels for pre-release and build metadata are available as
13
+#   extensions to the MAJOR.MINOR.PATCH format.
14
+#
15
+# Honestly I have always found it just about impossible to follow semver
16
+# without overthinking a bunch of hair-splitting decisions and categories,
17
+# but whatever.  I'll try to follow it, roughly.
18
+
19
+use version; our $VERSION = version->declare("v6.3.0");
4 20
 
5 21
 use strict;
6 22
 use warnings;
@@ -23,7 +39,7 @@ use App::WRT::FileIO;
23 39
 use App::WRT::HTML   qw(:all);
24 40
 use App::WRT::Image  qw(image_size);
25 41
 use App::WRT::Markup qw(line_parse image_markup eval_perl);
26
-use App::WRT::Util   qw(dir_list get_date file_get_contents);
42
+use App::WRT::Util   qw(dir_list file_get_contents);
27 43
 
28 44
 =pod
29 45
 

+ 36
- 1
lib/App/WRT/Date.pm View File

@@ -4,7 +4,7 @@ use strict;
4 4
 use warnings;
5 5
 
6 6
 use base qw(Exporter);
7
-our @EXPORT_OK = qw(iso_date get_mtime month_name);
7
+our @EXPORT_OK = qw(iso_date get_date get_mtime month_name);
8 8
 
9 9
 use POSIX qw(strftime);
10 10
 
@@ -71,6 +71,41 @@ Turn numeric months into English names.
71 71
   }
72 72
 }
73 73
 
74
+=item get_date('key', 'other_key', ...)
75
+
76
+Return current date values for the given key. Valid keys are sec, min, hour,
77
+mday (day of month), mon, year, wday (day of week), yday (day of year), and
78
+isdst (is daylight savings).
79
+
80
+Remember that year is given in years after 1900.
81
+
82
+=cut
83
+
84
+# Below replaces:
85
+# my ($sec, $min, $hour, $mday, $mon,
86
+#     $year, $wday, $yday, $isdst) = localtime(time);
87
+{
88
+  my %name_map = (
89
+    sec   => 0,  min   => 1, hour => 2, mday => 3,
90
+    mon   => 4,  year  => 5, wday => 6, yday => 5,
91
+    isdst => 6,
92
+  );
93
+
94
+  sub get_date {
95
+    my (@names) = @_;
96
+    my (@indices) = @name_map{@names};
97
+    my (@values) = (localtime time)[@indices];
98
+
99
+    if (wantarray()) {
100
+        # my ($foo, $bar) = get_date('foo', 'bar');
101
+        return @values;
102
+    } else {
103
+        # this is probably useless unless you're getting just one value
104
+        return join '', @values;
105
+    }
106
+  }
107
+}
108
+
74 109
 =back
75 110
 
76 111
 =cut

+ 7
- 38
lib/App/WRT/FileIO.pm View File

@@ -8,6 +8,7 @@ use Encode;
8 8
 use File::Copy;
9 9
 use File::Path qw(make_path);
10 10
 use Data::Dumper;
11
+use App::WRT::Util;
11 12
 
12 13
 =pod
13 14
 
@@ -56,21 +57,8 @@ Calls $sort_order, which can be one of:
56 57
 =cut
57 58
 
58 59
 sub dir_list {
59
-  my ($self, $dir, $sort_order, $pattern) = @_;
60
-
61
-  $pattern    ||= qr/^[0-9]{1,2}$/;
62
-  $sort_order ||= 'high_to_low';
63
-
64
-  opendir my $list_dir, $dir
65
-    or die "Couldn't open $dir: $!";
66
-
67
-  my @files = sort $sort_order
68
-              grep { m/$pattern/ }
69
-              readdir $list_dir;
70
-
71
-  closedir $list_dir;
72
-
73
-  return @files;
60
+  my $self = shift;
61
+  return App::WRT::Util::dir_list(@_);
74 62
 }
75 63
 
76 64
 # Various named sorts for dir_list:
@@ -89,11 +77,8 @@ L<https://secure.php.net/manual/en/function.file-put-contents.php>
89 77
 =cut
90 78
 
91 79
 sub file_put_contents {
92
-  my ($self, $file, $contents) = @_;
93
-  open(my $fh, '>', $file)
94
-    or die "Unable to open $file for writing: $!";
95
-  print $fh $contents;
96
-  close $fh;
80
+  my $self = shift;
81
+  App::WRT::Util::file_put_contents(@_);
97 82
 }
98 83
 
99 84
 
@@ -106,24 +91,8 @@ L<https://secure.php.net/manual/en/function.file-get-contents.php>
106 91
 =cut
107 92
 
108 93
 sub file_get_contents {
109
-  my ($self, $file) = @_;
110
-
111
-  open my $fh, '<', $file
112
-    or croak "Couldn't open $file: $!\n";
113
-
114
-  my $contents;
115
-  {
116
-    # line separator:
117
-    local $/ = undef;
118
-    $contents = <$fh>;
119
-  }
120
-
121
-  close $fh or croak "Couldn't close $file: $!";
122
-
123
-  # TODO: _May_ want to assume here that any file is UTF-8 text.
124
-  # http://perldoc.perl.org/perlunitut.html
125
-  # return decode('UTF-8', $contents);
126
-  return $contents;
94
+  my $self = shift;
95
+  return App::WRT::Util::file_get_contents(@_);
127 96
 }
128 97
 
129 98
 

+ 50
- 0
lib/App/WRT/Mock/FileIO.pm View File

@@ -0,0 +1,50 @@
1
+package App::WRT::Mock::FileIO;
2
+
3
+# Partially mock FileIO (the write operations - reads are still done as
4
+# usual).
5
+
6
+use strict;
7
+use warnings;
8
+
9
+use Carp;
10
+use App::WRT::Util;
11
+
12
+sub new {
13
+  my $class = shift;
14
+
15
+  my %params = (
16
+    'io'            => App::WRT::FileIO->new(),
17
+    'file_contents' => { },
18
+  );
19
+
20
+  my $self = \%params;
21
+  bless $self, $class;
22
+}
23
+
24
+sub dir_list {
25
+  my $self = shift;
26
+  return $self->{io}->dir_list(@_);
27
+}
28
+
29
+sub file_put_contents {
30
+  my $self = shift;
31
+  my ($file, $contents) = @_;
32
+  $self->{file_contents}->{$file} = $contents; 
33
+}
34
+
35
+sub file_get_contents {
36
+  my $self = shift;
37
+  return $self->{io}->file_get_contents(@_);
38
+}
39
+
40
+sub file_copy {
41
+  my ($self, $source, $dest) = @_;
42
+}
43
+
44
+sub dir_make {
45
+  my ($self, $path) = @_;
46
+  my $path_err;
47
+  return 1;
48
+}
49
+
50
+1;

+ 2
- 4
lib/App/WRT/Renderer.pm View File

@@ -41,7 +41,7 @@ mangling of things on the filesystem.
41 41
 
42 42
 sub new {
43 43
   my $class = shift;
44
-  my ($wrt, $logger) = @_;
44
+  my ($wrt, $logger, $io) = @_;
45 45
 
46 46
   ref($logger) eq 'CODE' or
47 47
     croak("Error: Renderer expects an anonymous function for logging");
@@ -49,9 +49,7 @@ sub new {
49 49
   my %params = (
50 50
     wrt    => $wrt,
51 51
     logger => $logger,
52
-
53
-    # Overwrite this for testing purposes:
54
-    io => App::WRT::FileIO->new(),
52
+    io     => $io,
55 53
   );
56 54
 
57 55
   my $self = \%params;

+ 1
- 36
lib/App/WRT/Util.pm View File

@@ -7,7 +7,7 @@ use Carp;
7 7
 use Encode;
8 8
 
9 9
 use base qw(Exporter);
10
-our @EXPORT_OK = qw(dir_list get_date file_put_contents file_get_contents);
10
+our @EXPORT_OK = qw(dir_list file_put_contents file_get_contents);
11 11
 
12 12
 =over
13 13
 
@@ -94,41 +94,6 @@ sub file_get_contents {
94 94
   return $contents;
95 95
 }
96 96
 
97
-=item get_date('key', 'other_key', ...)
98
-
99
-Return current date values for the given key. Valid keys are sec, min, hour,
100
-mday (day of month), mon, year, wday (day of week), yday (day of year), and
101
-isdst (is daylight savings).
102
-
103
-Remember that year is given in years after 1900.
104
-
105
-=cut
106
-
107
-# Below replaces:
108
-# my ($sec, $min, $hour, $mday, $mon,
109
-#     $year, $wday, $yday, $isdst) = localtime(time);
110
-{
111
-  my %name_map = (
112
-    sec   => 0,  min   => 1, hour => 2, mday => 3,
113
-    mon   => 4,  year  => 5, wday => 6, yday => 5,
114
-    isdst => 6,
115
-  );
116
-
117
-  sub get_date {
118
-    my (@names) = @_;
119
-    my (@indices) = @name_map{@names};
120
-    my (@values) = (localtime time)[@indices];
121
-
122
-    if (wantarray()) {
123
-        # my ($foo, $bar) = get_date('foo', 'bar');
124
-        return @values;
125
-    } else {
126
-        # this is probably useless unless you're getting just one value
127
-        return join '', @values;
128
-    }
129
-  }
130
-}
131
-
132 97
 =back
133 98
 
134 99
 1;

+ 30
- 0
t/bin-wrt-render-all.t View File

@@ -0,0 +1,30 @@
1
+#!/usr/bin/perl
2
+
3
+use strict;
4
+use warnings;
5
+use utf8;
6
+use 5.10.0;
7
+
8
+use lib 'lib';
9
+
10
+use Encode;
11
+use Test::More tests => 2;
12
+use App::WRT::Mock::FileIO;
13
+
14
+chdir 'example';
15
+require_ok('../bin/wrt-render-all');
16
+
17
+my $output_string;
18
+my $output = sub {
19
+  $output_string .= $_[0] . "\n";
20
+};
21
+
22
+my $mock_io = App::WRT::Mock::FileIO->new();
23
+my @local_argv = ();
24
+
25
+main($output, $mock_io, @local_argv);
26
+
27
+ok(
28
+  $output_string =~ 'rendered 21 entries',
29
+  'rendered expected number of entries'
30
+);

+ 12
- 1
t/wrt_date.t View File

@@ -4,7 +4,7 @@ use warnings;
4 4
 
5 5
 use lib 'lib';
6 6
 
7
-use Test::More tests => 4;
7
+use Test::More tests => 6;
8 8
 
9 9
 require_ok('App::WRT::Date');
10 10
 
@@ -23,3 +23,14 @@ ok(
23 23
   App::WRT::Date::month_name(1) eq 'January',
24 24
   'month_name(1) is January'
25 25
 );
26
+
27
+my $year = App::WRT::Date::get_date('year') + 1900;
28
+
29
+ok(
30
+  ($year =~ /^[0-9]+$/) && ($year > 1900),
31
+  'sure looks like a year'
32
+);
33
+
34
+my (@values) = App::WRT::Date::get_date('wday', 'yday', 'mon');
35
+my $length = @values;
36
+ok($length == 3, 'got multiple values');

+ 38
- 0
t/wrt_renderer.t View File

@@ -0,0 +1,38 @@
1
+#!/usr/bin/perl
2
+
3
+use strict;
4
+use warnings;
5
+use 5.10.0;
6
+
7
+use lib 'lib';
8
+
9
+use Data::Dumper;
10
+use Test::More tests => 2;
11
+
12
+use App::WRT;
13
+use App::WRT::Mock::FileIO;
14
+use App::WRT::Renderer;
15
+
16
+chdir 'example';
17
+my $config_file = 'wrt.json';
18
+my $wrt = App::WRT::new_from_file($config_file);
19
+
20
+my $log_string = '';
21
+
22
+my $renderer = App::WRT::Renderer->new(
23
+  $wrt,
24
+  sub { $log_string .= join '', @_; },
25
+  App::WRT::Mock::FileIO->new(),
26
+);
27
+
28
+ok(
29
+  $renderer->render(),
30
+  'successful mock render'
31
+);
32
+
33
+# diag($log_string);
34
+
35
+ok(
36
+  $log_string =~ m/seconds/,
37
+  'log mentions seconds'
38
+);

+ 4
- 9
t/wrt_util.t View File

@@ -5,18 +5,13 @@ use warnings;
5 5
 
6 6
 use lib 'lib';
7 7
 
8
-use Test::Simple tests => 2;
9
-use App::WRT::Util qw(get_date);
8
+use Test::More tests => 2;
10 9
 
11
-my $year = get_date('year') + 1900;
10
+require_ok('App::WRT::Util');
12 11
 
13 12
 ok(
14
-  ($year =~ /^[0-9]+$/) && ($year > 1900),
15
-  'sure looks like a year'
13
+  App::WRT::Util::file_get_contents('example/files/include_me') =~ 'content',
14
+  'got contents of include_me'
16 15
 );
17 16
 
18
-my (@values) = get_date('wday', 'yday', 'mon');
19
-my $length = @values;
20
-ok($length == 3, 'got multiple values');
21
-
22 17
 1;

Loading…
Cancel
Save