File Coverage

blib/lib/Net/Social/Mapper/SiteMap.pm

Criterion	Covered	Total	%
statement	59	60	98.3
branch	22	26	84.6
condition	7	13	53.8
subroutine	8	8	100.0
pod	3	3	100.0
total	99	110	90.0

package Net::Social::Mapper::SiteMap;

use strict;
use JSON::Any;

=head1 NAME

Net::Social::Mapper::SiteMap - information about know services around the internet

=head1 SYNOPSIS

    my $sitemap = Net::Social::Mapper::SiteMap;
    my $info    = $sitemap->profile($user, $service);
    my ($user, $service) = $sitemap->url_to_service($url);


=head1 DESCRIPTION

This is designed to be overriden and replaced with a more scalable
database if necessary.

Alternatively the information could come from Google's C

    http://code.google.com/p/google-sgnodemapper/

=head1 METHODS

=head2 new

Instantiate a new sitemap.

=cut
sub new {
    my $class = shift;
    my %opts  = @_;
    my $self  = bless \%opts, $class;
    $self->_init;
    return $self;
}

sub _init { }


sub _get_sitemap {
    my $self = shift;
    return $self->{_sitemap} if $self->{_sitemap};
    my $fh    = *DATA;
    my $off   = tell($fh);
    my $json = JSON::Any->new;
    my $data = do { local $/; <$fh> };
    seek($fh, $off, 0);
    return $self->{_sitemap} ||= $json->decode($data);
}

=head2 profile  [user]

Returns a hash ref with all the known information about C.

If C is passed in then any urls will be updated to include that information;

Returns undef if the service isn't known.

=cut
sub profile {
    my $self     = shift;
    my $service  = shift || return;
    my $user     = shift;
    my $site     = $self->_get_sitemap;
    my $val      = $service;
    do {
        $val     = $site->{$val};
        return unless defined $val && $val !~ m!^\s*$!;
        $service = $val unless ref($val) ne "";
    } until (ref($val) ne "");
    $val = $self->_visit($val, $user) if defined $user;
    $val->{service} = $service;
    return $val;
}

sub _visit {
    my $self    = shift;
    my $struct  = shift;
    my $user    = shift;
    my $ref     = ref($struct);

    if (!defined $ref || $ref eq "") {
        $struct =~ s!%user!$user!msg;
    } elsif ($ref eq 'SCALAR') {
        $$struct = $self->_visit($$struct, $user);
    } elsif ($ref eq 'HASH') {
        foreach my $key (keys %$struct) {
            $struct->{$key} = $self->_visit($struct->{$key}, $user);
        }
    } elsif ($ref eq 'ARRAY') {
        $struct =  [ map { $self->_visit($_, $user) } @$struct ];
    }
    return $struct;
}

=head2 url_to_service

Take a url and work out what username and service it is

=cut
sub url_to_service {
    my $self    = shift;
    my $url     = shift;
    $url        = "http://$url" unless $url =~ m![a-z]+:\/\/!i;

    my $sitemap = $self->_get_sitemap;

    foreach my $service (keys %$sitemap) {
        next unless ref($sitemap->{$service});
        my $regex   = $sitemap->{$service}->{regex} || next;
        my @regexes = (ref($regex)) ? @$regex : ($regex);
        foreach my $test (@regexes) {
            $test =~ s!\?!\\?!g;
            next unless $url =~ m!$test!;
            next unless defined $1;
            return ($1, $service);
        }
    }

    # The default
    return ($url, 'website');
}

###
# Needed
##

# Catser
# ColourLovers
# Corkd
# Dogster
# Gametap
# Goodreads
# Google
# Hi5
# Iconbuffet
# Icq
# Iminta
# IStockPhoto
# IUseThis
# IWatchThis
# Mog
# Multiply
# Netflix
# NetVibes
# NewsVine
# Ning
# Ohloh
# Opera
# p0pulist
# Skype
# Sonicliving
# Spin.de
# Stumbleupon
# Tabblo
# Technorati
# Threadless
# Uncrate
# Viddler
# Virb
# Wakoopa
# Wists
1;
__DATA__