# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1322232277 -3600 # Node ID 7c3215a97e4b1713edb3d8f2385c84b2f7f5afd2 # Parent 9f127fcfdf6d49e3d67ec70b83f4a4a40a27d76f added pod coverage test diff -r 9f127fcfdf6d -r 7c3215a97e4b .hgignore --- 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 diff -r 9f127fcfdf6d -r 7c3215a97e4b Build.PL --- 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(); diff -r 9f127fcfdf6d -r 7c3215a97e4b ex/mails/unsigned --- 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 diff -r 9f127fcfdf6d -r 7c3215a97e4b lib/Message/2822.pm --- 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([I]) +=item B([I]) Return a list of existing header fields, matching the pattern. See B for information about the returned format. (default pattern: /.*/) -=item @list = B([I]) +=item B([I]) Returns the header line matching the I. See B about the returned format. (default pattern: /.*/) -=item @list = B([I]) +=item B([I]) 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 is case insensitive! -=item $scalar = $B() +=item B() -Returns the original header as it is. +Returns the original header as it is in a single scalar. -=item $body = B() +=item B() -Returns the original body as it is. +Returns the original body as it is in a single scalar. =back diff -r 9f127fcfdf6d -r 7c3215a97e4b scratch/sign --- 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" diff -r 9f127fcfdf6d -r 7c3215a97e4b t/000-pod.t --- /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"); +