aboutsummaryrefslogtreecommitdiff
path: root/examples/lib/LWP/Ping903.pm
blob: 8fc398e0ce65f4f8748dbed4268ea63bb0fbed95 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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 ();
}

Return to:

Send suggestions and report system problems to the System administrator.