#$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{(<rdf:RDF.*?</rdf:RDF>)}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)(.*?)</\1>}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]*</${foaf}accountName>
                                 }xs ) {
                $accountname = $1;
            }
            if ( $onlineaccount =~ m{${foaf}accountName="([^<>]+?)"} ) {
                $accountname = $1;
            }
            if ( defined( $servicehomepage ) && defined( $accountname ) ) {
                $yield->( $servicehomepage, $accountname );
            }
        }
    }
}

1;
__END__

=head1 NAME

HTML::AccountAutoDiscovery - finding online account names in HTML

=head1 SYNOPSIS

  use HTML::AccountAutoDiscovery;
  my @account = HTML::AccountAutoDiscovery->find('http://www.example.com');

  ## OR

  my @account = HTML::AccountAutoDiscovery->find_in_html(\$html);

  print $account[0]->{account}; # account name
  print $account[0]->{service}; # service URI or literal

=head1 DESCRIPTION

I<HTML::AccountAutoDiscovery> implements Account Auto-Discovery from given a URI or a HTML document.

Account Auto-Discovery is a spec for searching account names of some online services in the HTML. You can see the document of the spec at I<http://b.hatena.ne.jp/help?mode=tipjar#autodiscovery> (But only for Japanese.)

If you want to show your online accounts on your HTML or XHTML as metadata, you can write looks like this:

  <rdf:RDF
    xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
    xmlns:foaf="http://xmlns.com/foaf/0.1/">
  <rdf:Description rdf:about="http://d.hatena.ne.jp/naoya/20050804/1123142579">
    <foaf:maker rdf:parseType="Resource">
      <foaf:holdsAccount>
        <foaf:OnlineAccount foaf:accountName="naoya">
          <foaf:accountServiceHomepage rdf:resource="http://www.hatena.ne.jp/" />
        </foaf:OnlineAccount>
      </foaf:holdsAccount>
    </foaf:maker>
  </rdf:Description>
  </rdf:RDF>

HTML::AccountAutoDiscovery module can find this RDF and parse it, then return account name of the service and URI.

=head1 AUTHOR

Naoya Ito E<lt>naoya@naoya.dyndns.orgE<gt>, MIZUTANI Tociyuki E<lt>http://tociyuki.cool.ne.jpE<gt>


This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Feed::Find> - The implementation of HTML::AccountAutoDiscovery reffered to this module.

=cut