# HTML::AccountAutoDiscovery - Embed FOAF accountName discovery
# Ver 1.04 Jul. 29 2005 Written by MIZUTANI Tociyuki
package HTML::AccountAutoDiscovery;
use strict;
use LWP::UserAgent;
our $VERSION = '1.04';

sub find {
  my $self = shift;
  my $url = shift;
  my $ua = LWP::UserAgent->new;
  $ua->agent('AccountAutoDiscovery/1.04');
  $ua->parse_head(0);
  $ua->timeout(10);
  my $req = HTTP::Request->new( GET => $url );
  my $res = $ua->request( $req );
  return () unless $res->is_success;
  my $s = $res->content;
  my @result;
  $self->each_account( sub {
    my( $srvname, $account ) = @_;
    push @result, { service => $srvname, account => $account };
  }, \$s );
  @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)[\s\n]*(.*?)</\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 );
      }
    }
  }
}

__END__
=head1 NAME
HTML::AccountAutoDiscovery - Embed FOAF accountName discovery
=head1 SYNOPSIS
  use AccountAutoDiscovery;

  my @a = HTML::AccountAutoDiscovery->find( $url );
  for my $x ( @a ) {
    print "$x->{service} $x->{account}\n";
  }

  HTML::AccountAutoDiscovery->each_account( sub {
    my( $srvname, $account ) = @_;
    print "$srvname $account\n";
  }, \$html_string );

=head1 AUTHOR

MIZUTANI, Tociyuki
<http://tociyuki.cool.ne.jp/> - Sorry Japanese only.

=head1 COPYRIGHT AND LICENCE

Copyright (c) 2005 MIZUTANI Tociyuki All Rights Reserved.

This library is free software.
You can redistribute it and/or modify it under
the same terms as perl itself.
=cut