File Coverage

blib/lib/Kwiki/TypeKey.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Kwiki::TypeKey;
use strict;

use Kwiki::UserName '-Base';
use mixin 'Kwiki::Installer';

our $VERSION = 0.08;

const class_id => 'user_name';
const class_title => 'Kwiki with TypeKey authentication';
const css_file => 'user_name.css';
const cgi_class => 'Kwiki::TypeKey::CGI';

field -package => 'Kwiki::PageMeta', 'edit_by_icon';

sub register {
    my $registry = shift;
    $registry->add(preload => 'user_name');
    $registry->add(action  => "return_typekey");
    $registry->add(action  => "logout_typekey");
    $registry->add(hook    => "page_metadata:sort_order", post => 'sort_order_hook');
    $registry->add(hook    => "page_metadata:update", post => 'update_hook');
}

sub sort_order_hook {
    my $hook = pop;
    return $hook->returned, 'edit_by_icon';
}

sub update_hook {
    my $meta = $self->hub->pages->current->metadata;
    $meta->edit_by_icon($self->hub->users->current->icon);
}

sub return_typekey {
    my %cookie = map { ($_ => scalar $self->cgi->$_) } qw(email name nick ts sig);
    $cookie{icon} = $self->fetch_icon($cookie{name});
    $self->hub->cookie->write(typekey => \%cookie);
    $self->redirect("?" . $self->cgi->page);
}

sub fetch_icon {
    my $name = shift;

    # WWW::Blog::Metadata is slow. Go easy with regexp.
    my $ua = LWP::UserAgent->new;
    my $res = $ua->get("http://profile.typekey.com/$name/");
    if ($res->is_success) {
        return ($res->content =~ m!\n\s*
    }
    return;
}

sub logout_typekey {
    $self->hub->cookie->write(typekey => {}, { -expires => "-3d" });
    $self->render_screen(content_pane => 'logout_typekey.html');
}

package Kwiki::TypeKey::CGI;
use Kwiki::CGI '-Base';

cgi 'email';
cgi 'name';
cgi 'nick';
cgi 'ts';
cgi 'sig';
cgi 'page';

package Kwiki::TypeKey;

1;

__DATA__