1 files changed, 49 insertions, 0 deletions
diff --git a/lib/LWP/Ping903.pm b/lib/LWP/Ping903.pm
new file mode 100644
index 0000000..8fc398e
--- /dev/null
+++ b/lib/LWP/Ping903.pm
@@ -0,0 +1,49 @@
+package LWP::Ping903;
+use parent 'LWP::UserAgent';
+use File::Spec;
+use HTTP::Status qw(:constants);
+use strict;
+use warnings;
+use Carp;
+
+my $VERSION = '0.3';
+
+sub new {
+    my $class = shift;
+    my $self = bless $class->SUPER::new(@_), $class;
+    $self->agent("$class/$VERSION");
+    return $self;
+}
+
+sub get_basic_credentials {
+    my ($self, $realm, $uri, $isproxy) = @_;
+    my $cf = File::Spec->catfile($ENV{HOME}, ".ping903.cred");
+    if (open(my $fh, '<', $cf)) {
+	while (<$fh>) {
+	    chomp;
+	    s/^\s+//;
+	    s/\s+$//;
+	    next if /^(#.*)?$/;
+	    my @words;
+	    while ($_) {
+		no warnings 'uninitialized';
+		if (s/^"(.*?)(?<!\\)"(?:\s+(.*))?$/$2/) {
+		    (my $s = $1) =~ s/\\([\\\"])/$1/g;
+		    push @words, $s;
+		} else {
+		    s/^(.+?)(?:\s+(.+))?$/$2/;
+		    push @words, $1;
+		}
+	    }
+	    if (@words == 4) {
+		my($h,$p) = split /:/, $words[0], 2;
+		if (($h eq '*' || $h eq $uri->host)
+		    && (!$p || $p eq '*' || $p eq $uri->port)
+		    && ($words[1] eq $realm || $words[1] eq '*')) {
+		    return @words[2..3];
+		}
+	    }
+	}
+    }
+    return ();
+}