File Coverage

blib/lib/HTML/AccountAutoDiscovery.pm

Criterion	Covered	Total	%
statement	47	50	94.0
branch	7	16	43.7
condition	1	3	33.3
subroutine	8	8	100.0
pod	0	3	0.0
total	63	80	78.7

#$Id: AccountAutoDiscovery.pm,v 1.9 2005/09/02 02:59:30 naoya Exp $
package HTML::AccountAutoDiscovery;
use strict;
use base qw ( Class::ErrorHandler );
use LWP::UserAgent;

use vars qw ( $VERSION );
our $VERSION = '0.06';
my $MAX_SIZE = 1000000; # 1mb
my $TIME_OUT = 10;

sub find {
    my ($class, $uri) = @_;
    my $ua = LWP::UserAgent->new;
    $ua->agent(join '/', $class, $class->VERSION);
    $ua->timeout($TIME_OUT);
    $ua->max_size($MAX_SIZE);
    $ua->parse_head(0);
    my $req = HTTP::Request->new(GET => $uri);
    my @result;
    my $res = $ua->request($req);
    return $class->error($res->status_line) unless $res->is_success;
    $class->find_in_html(\$res->content);
}

sub find_in_html {
    my ($class, $html) = @_;
    my @result;
    $class->each_account(
        sub {
            my( $srvname, $account ) = @_;
            push @result, { service => $srvname, account => $account };
        }, $html
    );
    @result;
}

sub each_account {
    my( $self, $yield, $sp ) = @_;
    ref( $yield ) eq 'CODE'
        or die __PACKAGE__ . "\:\:each_account needs CODE_REF\n";
    my $foafuri = "http://xmlns\\.com/foaf/0\\.1/";
    while ( $$sp =~ m{()}sg) {
        my $rdf = $1;
        my $foaf = '';
        if ( $rdf =~ m{xmlns:(\w+)="$foafuri"}o ) {
            $foaf = $1 . ':';
        } elsif ( $rdf =~ m{xmlns="$foafuri"}o ) {
            $foaf = '';
        } else {
            next;
        }
        while ( $rdf =~ m{<(${foaf}holdsAccount)(.*?)}sg ) {
            my $onlineaccount = $2;
            my( $servicehomepage, $accountname );
            if ( $onlineaccount =~ m{
                                     <${foaf}accountServiceHomepage[^>]+rdf:resource="(.*)"
                                 }xs ) {
                $servicehomepage = $1;
            }
            if ( $onlineaccount =~ m{
                                     <${foaf}accountName>[\s\n]*([^<>]+)[\s\n]*
                                 }xs ) {
                $accountname = $1;
            }
            if ( $onlineaccount =~ m{${foaf}accountName="([^<>]+?)"} ) {
                $accountname = $1;
            }
            if ( defined( $servicehomepage ) && defined( $accountname ) ) {
                $yield->( $servicehomepage, $accountname );
            }
        }
    }
}

1;
__END__