AnnoCPAN::Control - Main AnnoCPAN Web Interface Control Module

    # in the simplest case, this is all you need...
    use AnnoCPAN::Control;
    AnnoCPAN::Control->new->run;

    sub Main {
        my ($self, $vars) = @_;
        $vars ||= {};
        my @recent = AnnoCPAN::DBI::Note->search_recent;
        ({recent => \@recent, %$vars}, "main");
    }

package AnnoCPAN::Control;

$VERSION = '0.22';

use strict;
use warnings;
no warnings 'uninitialized';
use AnnoCPAN::Config;
use AnnoCPAN::DBI;
use CGI::Cookie;
use Digest::MD5 qw(md5_hex);
use IO::String;
use POSIX qw(ceil);
use Lingua::EN::Inflect qw(NO);
use AnnoCPAN::Feed;

# it should be possible to subclass this module to use a different
# interface and templating system by overriding new and the simple
# 'delegational' methods param, process, header...

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        log => [],
        cgi => $args{cgi} || CGI->new, 
        tt  => $args{tt}  || Template->new(
            INCLUDE_PATH => AnnoCPAN::Config->option('template_path'),
            PRE_PROCESS => 'util.tt',
            FILTERS => { myuri => \&myuri_filter },
        ),
    }, $class;
    $self;
}

sub run {
    my ($self) = @_;
    my $mode = $self->mode;
    $self->check_login;
    my ($vars, $template, $type);

    eval {
        ($vars, $template, $type) = $self->$mode;
    };
    if ($@) {
        $vars     = { error => $@ };
        if ($self->param('fast')) {
            $template = 'error';
        } else {
            ($vars, $template, $type) = $self->Main($vars);
        }
    }
    if ($template) {
        my $default_vars = $self->default_vars;
        $vars = { %$default_vars, %$vars };
        print $self->header(
            -charset => 'UTF-8',
            -cookie => $self->cookies,
            $type ? (-type => $type) : (),
        );
        $template .= '.html' unless $template =~ /\./;
        my $output = '';
        $self->process($template, $vars, \$output) or print $@;
        print $output;
    }
}

sub mode {
    my ($self) = @_;
    my $mode = ucfirst $self->param('mode');
    #$self->_log("mode?=($mode)");
    $mode = 'Main' unless $mode =~ /^[A-Z]\w+$/ and $self->can($mode);
    #$self->_log("mode=($mode)");
    $mode;
}

sub cgi { shift->{cgi} }

sub tt  { shift->{tt} }

sub param { shift->cgi->param(@_) }

sub param_obj {
    my ($self, $name, $key) = @_;
    my (@values) = $self->param(lc $name)
        or  die "unspecified $name\n";
    my $class = "AnnoCPAN::DBI::$name";
    $key ||= 'id';
    my @objs;
    for my $value (@values) {
        $key ne 'id' or $value =~ /^\d+$/
            or  die "invalid $name: '$value'\n";
        my $obj = $class->retrieve($key => $value)
            or die "$name '$value' not found\n";
        return $obj unless wantarray;
        push @objs, $obj;
    }
    return @objs;
}

sub header { shift->cgi->header(@_) }

sub redirect {
    my ($self, $uri) = @_;
    unless ($uri =~ /^\w+:/) {
        require URI;
        $uri = URI->new(AnnoCPAN::Config->option('root_uri_abs') . $uri);
        $uri->host($ENV{HTTP_HOST});
    }
    print $self->header(
        -cookie => $self->cookies, 
        -status => $ENV{REQUEST_METHOD} eq 'POST' ? 303 : 302, 
        -location => $uri,
    );
}

sub process { shift->tt->process(@_) }

sub default_vars {
    my ($self) = @_;
    +{
        param        => sub { $self->param(@_) },
        user         => $self->user,
        mode         => $self->mode,
        log          => $self->{log},
        prefs        => sub { $self->prefs(@_) },
        my_html      => sub { $self->my_html(@_) },
        request_uri  => $ENV{REQUEST_URI},
        cgi          => $self->cgi,
        root_uri_rel => AnnoCPAN::Config->option('root_uri_rel'),
        img_root     => AnnoCPAN::Config->option('img_root'),
        root_uri_abs => AnnoCPAN::Config->option('root_uri_abs'),
        NO           => \&NO,
    }
}

sub prefs {
    my ($self, $name) = @_;
    my $user = $self->user;
    my $value;
    if ($user) {
        $value = AnnoCPAN::DBI::Prefs->retrieve(user => $user, name => $name);
    }
    defined $value ? $value->value : AnnoCPAN::Config->option($name);
}

sub cookies { 
    my ($self) = @_;
    $self->{cookies} || [];
}

sub add_cookie {
    my ($self, $name, $val) = @_;

    my $max_time = AnnoCPAN::Config->option('cookie_duration');
    push @{$self->{cookies}}, CGI::Cookie->new(
        -name => $name, -value => $val,
        $max_time ? (-expires => "+${max_time}d") : (),
    );
}

sub delete_cookie {
    my ($self, $name) = @_;
    push @{$self->{cookies}}, CGI::Cookie->new(
        -name => $name, -value => '', -expires => '-1Y',
    );
}

sub check_login {
    my ($self) = @_;
    if ($ENV{TEST_USER}) {
        return AnnoCPAN::DBI::User->retrieve(username => 'test');
    }
    my %cookies = CGI::Cookie->fetch;
    my $login = $cookies{login}  && $cookies{login}->value;
    my $time  = $cookies{'time'} && $cookies{'time'}->value;
    my $key   = $cookies{key}    && $cookies{key}->value;
    my $max_time = (AnnoCPAN::Config->option('cookie_duration') || 1E9) * 86400;
    if ($self->key($login, $time) eq $key and time-$time < $max_time) {
        return AnnoCPAN::DBI::User->retrieve(username => $login);
    }
    0;
}

sub set_login_cookies {
    my ($self, $user) = @_;
    $self->user($user);
    my $login = $user->username;
    my $time = time;
    my $key = $self->key($login, $time);
    $self->add_cookie(login  => $login);
    $self->add_cookie(key    => $key);
    $self->add_cookie('time' => $time);
}

sub user {
    my ($self, $user) = @_;
    if (@_ > 1) {
        $self->{user} = $user;
    } else {
        $self->{user} = $self->check_login unless exists $self->{user};
    }
    $self->{user};
}

sub key {
    my ($self, $login, $time) = @_;
    my $secret = AnnoCPAN::Config->option('secret');
    md5_hex("$login $time $secret");
}

############# MODES ###############

sub Main {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $page = ($self->param('page') * 1) || 1;
    my $page_size = AnnoCPAN::Config->option('recent_notes') || 25;
    my $start  = ($page - 1) * $page_size;
    my @recent = AnnoCPAN::DBI::Note->recent($start, $page_size);
    my $n      = AnnoCPAN::DBI::Note->count_all;
    my $pages  = ceil($n / $page_size);
    ({
        recent      => \@recent, 
        note_count  => $n, 
        page        => $page,
        pages       => $pages,
        %$vars
    }, "main");
}

sub Show {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $podver = $vars->{podver} || $self->param_obj('PodVer');
    ({ 
        podver   => $podver,
        %$vars,
    }, "show");
}

sub Show_note {
    my ($self) = @_;
    my $note = $self->param_obj('Note');
    my $podver = $note->section->podver; 
    my $uri = sprintf "/dist/%s/%s", $podver->distver->distver, $podver->path;
    $self->redirect($uri);
    #$self->Show({ podver => $podver });
}

sub Show_notepos {
    my ($self) = @_;
    my $note = $self->param_obj('Note');
    ({ note => $note }, 'show_notepos');
}

sub Update_notepos {
    my ($self) = @_;
    my $note = $self->param_obj('Note');
    my $vars = { note => $note };
    my $user = $self->user;
    if ($user && $user->can_hide($note)) {
        my %to_hide;
        @to_hide{$self->param('hide')} = ();
        my $ref = $self->param('ref');
        for my $notepos ($note->notepos) {
            if ($notepos->id eq $ref) {
                $note->section($notepos->section);
                $note->update;
            }
            if (exists $to_hide{$notepos->id}) {
                $notepos->hide;
            } else {
                $notepos->unhide;
            }
        }
        $vars->{message} = "Note bindings updated";
    } else {
        $vars->{error} = "Edit not authorized";
    }
    ($vars, 'show_notepos');
}

sub Show_dist {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $distver = $vars->{distver} || $self->param_obj('DistVer');
    ({ 
        distver   => $distver,
        %$vars,
    }, "show_dist");
}

sub Edit {
    my ($self, $vars) = @_;
    $vars ||= {};

    my $notepos   = $self->param_obj('NotePos');
    ({ 
        podver   => $notepos->podver,
        note     => $notepos->note,
        %$vars,
        #message => "here ($section, $podver)" . $podver->pod->name,
    }, "edit");
}

sub Raw_note {
    my ($self, $vars) = @_;
    my $notepos = $self->param_obj('NotePos');
    my $text = $notepos->note->note;
    ({ note => $text }, 'note.txt', 'text/plain');
}

sub Create {
    my ($self, $vars) = @_;
    $vars ||= {};

    # get user, see if can edit
    my $user = $self->user
        or return $self->error("Not logged in; can't create note");

    my $section = $self->param_obj('Section');
    my $podver  = $section->podver;
    ({ 
        podver   => $podver,
        section  => $section,
        %$vars,
        #message => "here ($section, $podver)" . $podver->name,
    }, "edit");
}

sub _search_podver {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pod_name  = $self->param('name');
    return $self->Main unless $pod_name;
    my @pods = AnnoCPAN::DBI::Pod->search(name => $pod_name);
    return $self->error("not found") unless @pods;
    return $self->choose_podver($vars, \@pods);
}

sub _search_dist {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $dist_name  = $self->param('name');
    return $self->Main unless $dist_name;

    my $author     = uc $self->param('author');

    # try distvers first
    my @distvers = AnnoCPAN::DBI::DistVer->search(distver => $dist_name);
    @distvers = grep { $_->pause_id eq $author } @distvers if $author;

    unless (@distvers) {
        my ($dist) = AnnoCPAN::DBI::Dist->search(name => $dist_name);
        @distvers = $dist->distvers if $dist;
        @distvers = grep { $_->pause_id eq $author } @distvers if $author;
        if (@distvers == 1) {
            $self->redirect($self->distver_uri($distvers[0]));
            return;
        }
    }

    return $self->choose_distver($vars, \@distvers) if @distvers;
    return $self->error("not found");
}

sub _search_author {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pause_id  = $self->param('name');
    return $self->Main unless $pause_id;
    my @distvers = AnnoCPAN::DBI::DistVer->search(pause_id => $pause_id);

    # get only unique dists XXX this should be done in SQL
    my %seen;
    for (@distvers) {
        $seen{$_->dist} = $_->dist;
    }

    return $self->error("not found") unless @distvers;
    ({
        %$vars, dists => [ values %seen ], author => uc $pause_id,
        note_count => AnnoCPAN::DBI::Note->count_by_author($pause_id),
    }, 'show_author');
}


sub _search_both {
    my ($self, $vars) = @_;
    $vars ||= {};

    # find the pods
    my $pod_path  = $self->param('pod');
    return $self->Main unless $pod_path;

    # find the distvers
    my $dist_name  = $self->param('dist');
    return $self->Main unless $dist_name;

    my @podvers = AnnoCPAN::DBI::PodVer->search_distver_pod(
        $dist_name, $pod_path);
    unless (@podvers) {
        @podvers = AnnoCPAN::DBI::PodVer->search_dist_pod(
            $dist_name, $pod_path);
    }
    my $author     = uc $self->param('author');
    @podvers = grep { $_->distver->pause_id eq $author } @podvers if $author;

    return $self->error("not found") unless @podvers;

    if ($self->param('latest')) {
        @podvers = sort { $b->mtime <=> $a->mtime } @podvers;
        splice @podvers, 1;
    }
    if (@podvers == 1) {
        return ({ podver => $podvers[0] }, "show");
    } else {
        return ({ podvers => \@podvers, pod_name => $podvers[0]->pod->name}, 
            "choose");
    }
}


sub Search {
    my ($self, $vars) = @_;
    my $field  = $self->param('field');
    return $self->_search_dist($vars)   if $field eq 'Distribution';
    return $self->_search_author($vars) if $field eq 'Author';
    return $self->_search_podver($vars)    if $field eq 'Module';
    return $self->_search_both($vars);
    die;
}

sub Join_pod {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pod_name  = $self->param('name');
    return $self->Main unless $pod_name and $self->user->privs >= 10; # XXX magic number
    my @pods = AnnoCPAN::DBI::Pod->search(name => $pod_name);
    return $self->error("not found") unless @pods;
    return ({ %$vars, pods => \@pods, pod_name => $pods[0]->name}, 
            "join_pod");
}

sub Join_pod_save {
    my ($self) = @_;
    return $self->Main unless $self->user->privs >= 10; # XXX magic number
    # XXX add better error checking
    my ($first, @others) = $self->param_obj('Pod');
    $first->join_pods(@others);
    $self->Join_pod({ message => 'Pods joined'});
}

sub Pod_families {
    my ($self) = @_;
    my @pods = AnnoCPAN::DBI::Pod->search_families;
    return ({ pods => \@pods}, "pod_families");
}

sub podver_uri {
    my ($self, $podver) = @_;
    sprintf "%s/~%s/%s/%s", AnnoCPAN::Config->option('root_uri_rel'),
        $podver->distver->pause_id, $podver->distver->distver, $podver->path;
}

sub choose_podver {
    my ($self, $vars, $pods) = @_;
    my @podvers = map { $_->podvers } @$pods;
    if ($self->param('latest')) {
        @podvers = sort { $b->mtime <=> $a->mtime } @podvers;
        splice @podvers, 1;
    }
    if (@podvers == 1) {
        if ($self->param('redirect')) {
            $self->redirect($self->podver_uri($podvers[0]));
            return;
        } else {
            return ({ podver => $podvers[0] }, "show");
        }
    } else {
        return ({ podvers => \@podvers, pod_name => $pods->[0]->name,
            pods => $pods}, 
            "choose");
    }
}

sub distver_uri {
    my ($self, $distver) = @_;
    sprintf "%s/~%s/%s/", AnnoCPAN::Config->option('root_uri_rel'),
        $distver->pause_id, $distver->distver;
}

sub choose_distver {
    my ($self, $vars, $distvers) = @_;
    if ($self->param('latest')) {
        $distvers = [ sort { $b->mtime <=> $a->mtime } @$distvers ];
        splice @$distvers, 1;
    }
    if (@$distvers == 1) {
        return ({ distver => @$distvers }, "show_dist");
    } else {
        my $dist = $distvers->[0]->dist;
        return ({ distvers => \@$distvers, dist => $dist}, "choose_dist");
    }
}


sub error {
    my ($self, $message) = @_;
    $self->Main({ error => $message });
}

sub _message {
    my ($self, $message, $vars) = @_;
    ({ %{$vars||{}}, message => $message }, "message");
}

sub _error {
    my ($self, $message, $vars) = @_;
    ({ %{$vars||{}}, error => $message }, "error");
}

sub _log {
    my ($self, $message) = @_;
    push @{$self->{log}}, $message;
}

sub About {
    my $parser = AnnoCPAN::PodToHtml->new(annocpan_print => 1);
    my $html;
    my $fh = IO::String->new($html);
    $parser->parse_from_file('about.pod', $fh);
    ({ content => $html }, 'about');
}

sub Faq { ({}, 'faq') }
sub News { ({}, 'news') }
sub Motd { ({}, 'motd') }
sub Note_help { ({}, 'note_help') }
sub Policy { ({}, 'policy') }
sub Contact { ({}, 'contact') }

sub Show_user {
    my ($self) = @_;
    my $u = $self->param_obj('User', 'username');
    ({ a_user => $u }, 'show_user');
}

sub Move {
    my ($self) = @_;
    my $notepos = $self->param_obj('NotePos');
    shift->Show({ podver => $notepos->podver });
}

sub Do_move {
    my ($self) = @_;
    return $self->_do_move if $self->param('fast');
    my ($vars) = $self->_do_move;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

sub _do_move {
    my ($self) = @_;

    my $notepos = $self->param_obj('NotePos');
    my $section = $self->param_obj('Section');

    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("Not logged in; can't move");

    $user->can_move($notepos->note)
        or return $self->_error("Move not authorized");

    $section->podver eq $notepos->section->podver
        or return $self->_error("Move not within the same document");

    my $podver = $section->podver;

    $notepos->section($section);
    $notepos->status(AnnoCPAN::DBI::Note::MOVED);
    $notepos->score(AnnoCPAN::DBI::Note::SCALE);
    $notepos->update;

    $podver->flush_cache;

    $self->_message("note moved", { podver => $podver });
}


sub Hide {
    my ($self) = @_;
    return $self->_hide if $self->param('fast');
    my ($vars) = $self->_hide;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

sub _hide {
    my ($self) = @_;
    my $notepos_id = $self->param('notepos');

    my $notepos = $self->param_obj('NotePos');

    my $note    = $notepos->note;
    my $section = $notepos->section;
    
    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("not logged in; can't move");
    $user->can_hide($note)
        or return $self->_error("move not authorized");

    my $podver = $section->podver;
    $podver->flush_cache;

    $notepos->status(AnnoCPAN::DBI::Note::HIDDEN);
    $notepos->update;

    $self->_message("note hidden", { podver => $notepos->podver });
}

sub Save {
    my ($self) = @_;
    return $self->_save if $self->param('fast');
    my ($vars) = $self->_save;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

# to save new note, need section and note text
# to save edited note, need notepos and note text
sub _save {
    my ($self) = @_;
    my $note_text    = $self->param('note_text');

    my ($note, $podver);

    # get user, see if can edit
    my $user = $self->user
        or return $self->_error("Not logged in; can't save note");

    if ($self->param('notepos')) { # edit existing note
        my $notepos = $self->param_obj('NotePos');
        $podver = $notepos->podver;
        $note   = $notepos->note;

        $user->can_edit($note)
            or return $self->_error("Edit not authorized");
        $note->note($note_text);
        $note->ip($ENV{REMOTE_ADDR});
        #$note->time(time);
        $note->update;
        $note->remove_from_object_index;

    } else { # create new note
        my $section = $self->param_obj('Section');
        $podver  = $section->podver;
        $note = AnnoCPAN::DBI::Note->create({
            pod         => $podver->pod, 
            min_ver     => '',
            max_ver     => '',
            note        => $note_text, 
            ip          => $ENV{REMOTE_ADDR},
            time        => time,
            user        => $self->user,
            section     => $section,
        }) or return $self->_error("Duplicate note?");
    }
    ({ note => $note, podver => $podver, notepos => $note->ref_notepos }, 
        'note');
}

sub New_user {
    ({}, "new_user");
}

sub Create_user {
    my ($self) = @_;
    my $login   = $self->param('login');
    my $passwd  = $self->param('passwd');
    my $passwd2 = $self->param('passwd2');
    my $email   = $self->param('email');
    my %vars = (login => $login, email => $email);

    return ({%vars, error => "missing password"}, "new_user")
        unless (length $passwd);

    return ({%vars, error => "missing login"}, "new_user")
        unless (length $login);

    $login =~ s/^\s+//;
    $login =~ s/\s+$//;

    return ({%vars, error => "invalid login"}, "new_user")
        unless ($login =~ /^\w+$/);

    if (AnnoCPAN::DBI::User->retrieve(username => $login)) {
        return ({%vars, error => 'login already taken'}, "new_user");
    }

    if ($passwd ne $passwd2) {
        return ({%vars, error => "passwords don't match"}, "new_user");
    }

    my $user = AnnoCPAN::DBI::User->create({
        username => $login,
        password => crypt($passwd, $login),
        email    => $email,
        member_since => time,
        privs    => 1,
    });
    $self->set_login_cookies($user);
    $self->Main({%vars, message => "account created"});
}

sub Login {
    my ($self) = @_;
    my $passwd  = $self->param('passwd');

    my $user = eval { $self->param_obj('User', 'username') };
    unless ($user and crypt($passwd, $user->password) eq $user->password) {
        return $self->Main({error => 'invalid login/password'});
    }
    $self->set_login_cookies($user);
    my $from = $self->param('from');
    $self->redirect($from =~ /logout/ ? '/' : $from);
    return;
    #$self->Main({message => "welcome, you have logged in!"});
}

sub Logout {
    my ($self) = @_;
    $self->delete_cookie('key');
    $self->user(undef);
    $self->redirect($self->param('from'));
    return;
    #$self->Main({message => "You have logged out"});
}

sub Prefs {
    my ($self) = @_;
    return $self->error("Can't edit prefs without logging in first!")
        unless $self->user;
    ({}, 'prefs');
}

sub Save_prefs {
    my ($self) = @_;
    # XXX untaint
    my $user = $self->user;
    return $self->error("Can't edit prefs without logging in first!")
        unless $user;
    AnnoCPAN::DBI::Prefs->search(user => $user)->delete_all;
    for my $name (@{AnnoCPAN::Config->option('prefs')}) {
        AnnoCPAN::DBI::Prefs->create({user => $user, name => $name, 
            value => $self->param($name) || '' });
    }
    ({ message => 'Preferences saved'}, 'prefs');
}


sub Delete {
    my ($self) = @_;
    return $self->_delete if $self->param('fast');
    my ($vars) = $self->_delete;
    return $self->Main($vars) if $vars->{error};
    $self->Show($vars);
}

# global delete
sub _delete {
    my ($self) = @_;

    my $notepos = $self->param_obj('NotePos');
    my $note    = $notepos->note;
    my $podver  = $notepos->podver;

    # get user, see if can delete
    my $user = $self->user
        or return $self->_error("not logged in; can't delete");
    $user->can_delete($note)
        or return $self->_error("deletion not authorized");

    $note->delete;

    $self->_message("note deleted", { podver => $podver });
}


sub Main_rss {
    my ($self) = @_;

    my ($vars) = $self->Main;

    my $link = AnnoCPAN::Config->option('root_uri_abs');
    my $rss  = AnnoCPAN::Feed->note_rss(notes => $vars->{recent}, 
        link => $link, title => 'AnnoCPAN Recent Notes');

    ({ %$vars, rss => $rss }, 'rss', 'text/xml');
}


sub Author_recent {
    my ($self, $vars) = @_;
    $vars ||= {};
    my $pause_id  = $self->param('pause_id');
    my @recent = AnnoCPAN::DBI::Note->search_recent_by_author($pause_id);
    ({notes => \@recent, author => uc $pause_id, %$vars }, "show_author_recent");
}

sub Author_rss {
    my ($self, $vars) = @_;
    $vars ||= {};

    my $pause_id  = $self->param('name');
    return $self->Main unless $pause_id;
    my @pods = AnnoCPAN::DBI::Pod->search_by_author($pause_id);
    my @notes = map { $_->notes } @pods;

    my $link = AnnoCPAN::Config->option('root_uri_abs') . "/~$pause_id";
    my $rss  = AnnoCPAN::Feed->note_rss(notes => \@notes, link => $link,
        title => "AnnoCPAN Notes for PAUSE ID '$pause_id'");

    ({ %$vars, rss => $rss }, 'rss', 'text/xml');
}

sub Note_dump {
    my @notes = AnnoCPAN::DBI::Note->retrieve_all;
    ({ notes => \@notes}, "note_dump.xml", "text/xml");
}

sub Podver_note_count {
    my @podvers = AnnoCPAN::DBI::PodVer->search_note_count_all;
    for my $podver (@podvers) {
        ($podver->{path_from_author_dir} = $podver->{dist_path}) 
            =~ s|^authors/id/./../[^/]*/||; 
    }
    ({ podvers => \@podvers}, "podver_note_count.txt", "text/plain");
}

sub Flush {
    my ($self) = @_;
    if ($self->user && $self->user->privs >= 10) {
        AnnoCPAN::DBI::PodVer->flush_cache;
        $self->Main({ message => 'Cache flushed'});
    } else {
        $self->error('Not authorized');
    }
}

sub my_html {
    my ($self, $podver) = @_;
    my $html = '';

    AnnoCPAN::DBI::Note->clear_object_index;

    if (AnnoCPAN::Config->option('cache_html')
        and $self->mode !~ /(Edit|Move|Create)/
    ) {
        $html = $podver->html;
        return $html if $html;
    }
    my $tt = Template->new(
        INCLUDE_PATH => AnnoCPAN::Config->option('template_path'),
        PRE_PROCESS => 'util.tt',
    );
    my $vars = {
        %{ $self->default_vars },
        podver => $podver,
    };
    $tt->process('pod.html', $vars, \$html) or print $@;
    if (AnnoCPAN::Config->option('cache_html')) {
        $podver->html($html);
        $podver->update;
    }
    return $html;
}

sub myuri_filter {
   my $text = shift;
   our $URI_ESCAPES ||= {
       map { ( chr($_), sprintf("%%%02X", $_) ) } (0..255),
   };

   $text =~ s/([^\/?:@+\$,A-Za-z0-9\-_.!~*'()])/$URI_ESCAPES->{$1}/g;
   $text;
}

1;