added pod coverage test
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Fri, 25 Nov 2011 15:44:37 +0100
changeset 15 7c3215a97e4b
parent 12 9f127fcfdf6d
child 16 3996e5b8789f
child 19 13a91c615331
added pod coverage test
.hgignore
Build.PL
ex/mails/unsigned
lib/Message/2822.pm
scratch/sign
t/000-pod.t
--- a/.hgignore	Fri Nov 11 11:22:50 2011 +0100
+++ b/.hgignore	Fri Nov 25 15:44:37 2011 +0100
@@ -3,3 +3,4 @@
 _build
 Build
 blib
+cover_db
--- a/Build.PL	Fri Nov 11 11:22:50 2011 +0100
+++ b/Build.PL	Fri Nov 25 15:44:37 2011 +0100
@@ -10,5 +10,7 @@
     },
     build_requires => {
 	"Test::More" => "0.92",
+	"Test::Pod::Coverage" => "1.08",
+	"Pod::Coverage" => "0",
     },
 )->create_build_script();
--- a/ex/mails/unsigned	Fri Nov 11 11:22:50 2011 +0100
+++ b/ex/mails/unsigned	Fri Nov 25 15:44:37 2011 +0100
@@ -19,7 +19,6 @@
 Organization: schlittermann -- internet & unix support
 X-Phone: +49.172.7909055 / SMS welcome
 User-Agent: Mutt/1.5.20 (2009-06-14)
-Content-Length: 50
 Content-Type: text/plain; 
     charset=utf-8
 
--- a/lib/Message/2822.pm	Fri Nov 11 11:22:50 2011 +0100
+++ b/lib/Message/2822.pm	Fri Nov 25 15:44:37 2011 +0100
@@ -48,18 +48,18 @@
     return join "" => @r;
 }
 
-sub remove_header_lines {
-    my $self = shift;
-    my $pattern = shift // die "Need a pattern!";
-    $DATA{header}{$self} =~ s/^$pattern.*?(?=^\S|\Z)//imsg;
-}
+#sub remove_header_lines {
+#    my $self = shift;
+#    my $pattern = shift // die "Need a pattern!";
+#    $DATA{header}{$self} =~ s/^$pattern.*?(?=^\S|\Z)//imsg;
+#}
 
-sub add_header_line {
-    my $self = shift;
-    my $_ = shift;
-    $_ .= "\n" unless /\n$/;
-    $DATA{header}{$self} .= $_;
-}
+#sub add_header_line {
+    #my $self = shift;
+    #my $_ = shift;
+    #$_ .= "\n" unless /\n$/;
+    #$DATA{header}{$self} .= $_;
+#}
 
 sub header_contents {
     my $self  = shift;
@@ -128,19 +128,19 @@
 The construcor. The file is opened r/o and read. The file will not be
 closed until the object disappears.
 
-=item @list = B<header_fields>([I<pattern>])
+=item B<header_fields>([I<pattern>])
 
 Return a list of existing header fields, matching the pattern. 
 See B<header_contents()> for information about the
 returned format. (default pattern: /.*/)
 
 
-=item @list = B<header_lines>([I<pattern>])
+=item B<header_lines>([I<pattern>])
 
 Returns the header line matching the I<pattern>. See B<header_contents()>
 about the returned format. (default pattern: /.*/)
 
-=item @list = B<header_contents>([I<pattern>])
+=item B<header_contents>([I<pattern>])
 
 Returns the contents of the header lines matching the pattern. (default
 pattern: /.*/)
@@ -153,13 +153,13 @@
 since it is considered a part of the field name. I<field> is case
 insensitive!
 
-=item $scalar = $B<orig_header>()
+=item B<orig_header>()
 
-Returns the original header as it is.
+Returns the original header as it is in a single scalar.
 
-=item $body = B<orig_body>()
+=item B<orig_body>()
 
-Returns the original body as it is.
+Returns the original body as it is in a single scalar.
 
 =back
 
--- a/scratch/sign	Fri Nov 11 11:22:50 2011 +0100
+++ b/scratch/sign	Fri Nov 25 15:44:37 2011 +0100
@@ -17,12 +17,13 @@
 
 my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
 
+die join " ", $unsigned->header_contents("Subject");
 
 # copy the body into a tmp file and copy there the content-
 # header lines
 open(my $message, "+>$dir/message");
 print {$message}
-    $unsigned->header_lines(qr/^content-/i), "\n",
+    $unsigned->header_lines("content-"), "\n",
     $unsigned->orig_body;
 $message->flush();
 
@@ -37,7 +38,6 @@
 
 # ask GPG to sign it…
 system("gpg",
-    "--rfc1991",
     "--detach-sign",
     "--homedir" => "ex/gpg",
     "--armor" => "$dir/message");
@@ -49,7 +49,7 @@
 seek($message, 0, 0);
 
 print "--${boundary}\n",
-      <$message>, "\n",
+      <$message>,
       "--${boundary}\n",
       <<___, <$sig>, "\n--${boundary}--\n";
 Content-Type: application/pgp-signature; name="signature.asc"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/000-pod.t	Fri Nov 25 15:44:37 2011 +0100
@@ -0,0 +1,15 @@
+use 5.010;
+use strict;
+use warnings;
+#use Pod::Coverage;
+use Test::Pod::Coverage tests => 1;
+
+#my $pc = Pod::Coverage->new(package => "Message::2822");
+#is($pc->coverage => 1, "POD coverage") or $pc->naked
+#	? diag("Undocumented: ", join ", " => $pc->naked)
+#	: diag($pc->why_unrated);
+#
+#done_testing();
+
+pod_coverage_ok("Message::2822");
+