diff options
Diffstat (limited to 'examples/lib/LWP/Ping903.pm')
-rw-r--r-- | examples/lib/LWP/Ping903.pm | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/examples/lib/LWP/Ping903.pm b/examples/lib/LWP/Ping903.pm new file mode 100644 index 0000000..8fc398e --- /dev/null +++ b/examples/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 (); +} |