[libnet-openid-common-perl] 02/03: use HTTP::Headers::Util instead of Email::MIME::ContentType

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag v1.14
in repository libnet-openid-common-perl.

commit a595c05e01ed3264488bae9df39020abb285c719
Author: Roger Crew <crew at cs.stanford.edu>
Date:   Wed Nov 9 14:03:33 2011 -0800

    use HTTP::Headers::Util instead of Email::MIME::ContentType
    
    formats of HTTP header Content-type and email MIME header Content-type
    really are different (e.g., the latter can have RFC822 comments).
    
    Also, Email::MIME::ContentType turns out to be wonky.
---
 dist.ini                |  2 +-
 lib/Net/OpenID/Yadis.pm | 24 +++++++++++++++++++-----
 2 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/dist.ini b/dist.ini
index 6482b48..cc97c59 100644
--- a/dist.ini
+++ b/dist.ini
@@ -39,7 +39,7 @@ MIME::Base64   = 0
 Math::BigInt   = 0
 Crypt::DH::GMP = 0
 Encode         = 0
-Email::MIME::ContentType = 0
+HTTP::Headers::Util = 0
 
 [Prereqs / TestRequires]
 Test::More     = 0
diff --git a/lib/Net/OpenID/Yadis.pm b/lib/Net/OpenID/Yadis.pm
index a80729a..a565fba 100644
--- a/lib/Net/OpenID/Yadis.pm
+++ b/lib/Net/OpenID/Yadis.pm
@@ -9,7 +9,7 @@ use Net::OpenID::URIFetch;
 use XML::Simple;
 use Net::OpenID::Yadis::Service;
 use Net::OpenID::Common;
-use Email::MIME::ContentType;
+use HTTP::Headers::Util qw(split_header_words);
 use Encode;
 
 our @EXPORT = qw(YR_HEAD YR_GET YR_XRDS);
@@ -131,6 +131,22 @@ sub _get_contents {
     }
 }
 
+sub parse_content_type {
+    # stolen from HTTP::Headers but returns lc charset
+    my $h = shift;
+    $h = $h->[0] if ref($h);
+    $h = "" unless defined $h;
+    my ($v) = (split_header_words($h), []);
+    my($ct, undef, %ct_param) = @$v;
+    $ct ||= '';
+    $ct = lc($ct);
+    $ct =~ s/\s+//;
+    my $charset = lc($ct_param{charset} || '');
+    $charset =~ s/^\s+//;
+    $charset =~ s/\s+\z//;
+    return ($ct, $charset);
+}
+
 sub discover {
     my $self = shift;
     my $url = shift or return $self->_fail("empty_url");
@@ -158,14 +174,12 @@ sub discover {
     }
 
     # (2) is content type YADIS document?
-    my $pct = parse_content_type($headers{'content-type'});
-    my $ctype = join '/', @{$pct}{qw(discrete composite)}; # really should be qw(type subtype)
+    my ($ctype, $charset) = parse_content_type($headers{'content-type'});
     if ($ctype eq 'application/xrds+xml') {
         #survey says Yes!
         $self->xrd_url($final_url);
 
-        my $charset = $pct->{attributes}->{charset};
-        if ($charset && (lc($charset) ne 'utf-8') && Encode::find_encoding($charset)) {
+        if ($charset && ($charset ne 'utf-8') && Encode::find_encoding($charset)) {
             # not UTF-8, but it's one of the ones we know about, so...
             Encode::from_to($xrd,$charset,'utf-8');
             # And now we are UTF-8, BUT...

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-openid-common-perl.git