CGI::Application::NetNewsIface - a publicly-accessible read-only interface

CGI-Application-NetNewsIface documentation Contained in the CGI-Application-NetNewsIface distribution.

Index

Code Index:

NAME

Top

CGI::Application::NetNewsIface - a publicly-accessible read-only interface for Usenet (NNTP) news.

SYNOPSIS

Top

In a common module:

    use CGI::Application::NetNewsIface;

    sub get_app
    {
        return CGI::Application::NetNewsIface->new(
            PARAMS => {
                'nntp_server' => "nntp.perl.org",
                'articles_per_page' => 10,
                'dsn' => "dbi:SQLite:dbname=./data/mynntp.sqlite",
            }
        );
    }

To set up:

    get_app()->init_cache__sqlite();

To run

    get_app()->run();

PARAMS

Top

nntp_server

The Server to which to connect using NNTP.

articles_per_page

The number of articles to display per page of listing of a newsgroup.

dsn

The DBI 'dsn' for the cache.

FUNCTIONS

Top

$cgiapp->setup()

The setup subroutine as required by CGI::Application.

cgiapp_prerun()

This is the cgiapp_prerun() subroutine.

$cgiapp->update_group($group)

Updates the cache records for the NNTP group $group. This method is used for maintenance, to make sure a script loads promptly.

$cgiapp->init_cache__sqlite()

Initializes the SQLite cache that is pointed by the DBI DSN given as a parameter to the CGI script. This should be called before any use of the CGI Application itself, because otherwise there will be no tables to operate on.

$cgiapp->init_cache__mysql()

Initializes the MySQL cache that is pointed by the DBI DSN given as a parameter to the CGI script. This should be called before any use of the CGI Application itself, because otherwise there will be no tables to operate on.

AUTHOR

Top

Shlomi Fish, <shlomif@iglu.org.il>

BUGS

Top

Please report any bugs or feature requests to bug-cgi-application-netnewsiface@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-NetNewsIface. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

Known Bugs

None, but it doesn't mean there aren't any bugs.

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

Copyright 2006 Shlomi Fish, all rights reserved.

This program is released under the following license: MIT X11.

CGI-Application-NetNewsIface documentation Contained in the CGI-Application-NetNewsIface distribution. 
package CGI::Application::NetNewsIface;

use strict;
use warnings;


use base 'CGI::Application';
use base 'Class::Accessor';

use CGI::Application::Plugin::TT;

use XML::RSS;

use Net::NNTP;

use CGI::Application::NetNewsIface::ConfigData;

use CGI::Application::NetNewsIface::Cache::DBI;

use vars qw($VERSION);

$VERSION = "0.02";

use CGI;

my %modes =
(
    'main' => 
    {
        'url' => "/",
        'func' => "_main_page",
    },
    'groups_list' =>
    {
        'url' => "/group/",
        'func' => "_groups_list_page",
    },
    'group_display' =>
    {
        'url' => "/group/foo.bar/",
        'func' => "_group_display_page",
    },
    'article_display' =>
    {
        'url' => "/group/foo.bar/666",
        'func' => "_article_display_page",
    },
    'css' =>
    {
        'url' => "/style.css",
        'func' => "_css",
    },
    'about_app' =>
    {
        'url' => "/cgi-app-nni/",
        'func' => "_about_app_page",
    }
);

my %urls_to_modes = (map { $modes{$_}->{'url'} => $_ } keys(%modes));

__PACKAGE__->mk_accessors(qw(
    config
    record_tt
));


sub setup
{
    my $self = shift;

    $self->_initialize($self->param('config'));

    $self->start_mode("main");
    $self->mode_param(\&_determine_mode);

    $self->run_modes(
        (map { $_ => $modes{$_}->{'func'}, } keys(%modes)),
        # Remmed out:
        # I think of deprecating it because there's not much difference
        # between it and add.
        # "add_form" => "add_form",
        'redirect_to_main' => "_redirect_to_main",
        'correct_path' => "_correct_path",
    );
}

sub cgiapp_prerun
{
    my $self = shift;

    $self->tt_params(
        'path_to_root' => $self->_get_path_to_root(),
        'show_all_records_url' => "search/?all=1",
    );

    # TODO : There may be a more efficient/faster way to do it, but I'm 
    # anxious to get it to work. -- Shlomi Fish
    $self->tt_include_path(
        [ './templates',
          @{CGI::Application::NetNewsIface::ConfigData->config('templates_install_path')},
        ],
    );

    # This is so the CGI header won't print a character set.
    $self->query()->charset('');
}


sub _redirect_to_main
{
    my $self = shift;

    return "<html><body><h1>URL Not Found</h1></body></html>";
}

sub _correct_path
{
    my $self = shift;

    my $path = $self->_get_path();

    $path =~ m#([^/]+)/*$#;

    my $last_component = $1;

    # This is in case we were passed the script name without a trailing /
    # in which case the last component would be undefined. So consult
    # the request uri.
    if (!defined($last_component))
    {
        # Extract the Request URI
        my $request_uri = $ENV{REQUEST_URI} || "";
        $request_uri =~ m#([^/]+)/*$#;
        $last_component = $1;
        if (!defined($last_component))
        {
            $last_component = "";
        }
    }

    $self->header_type('redirect');
    $self->header_props(-url => "./$last_component/");
}

sub _get_path
{
    my $self = shift;

    my $q = $self->query();

    my $path = $q->path_info();

    return $path;
}

sub _determine_mode
{
    my $self = shift;

    my $path = $self->_get_path();

    if ($path =~ /\/\/$/)
    {
        return "correct_path";
    }

    if ($path eq "/")
    {
        return "main";
    }
    if ($path eq "/style.css")
    {
        return "css";
    }
    elsif ($path eq "/cgi-app-nni/")
    {
        return "about_app";
    }
    elsif ($path =~ s{^/group/}{})
    {
        if ($path eq "")
        {
            return "groups_list";
        }
        elsif ($path =~ s{^([[:lower:][:digit:]\.]+)/}{})
        {
            my $group = $1;
            $self->param('group' => $group);
            if ($path eq "")
            {
                return "group_display";
            }
            else
            {
                if ($path =~ s{^(\d+)$}{})
                {
                    $self->param('article' => $1);
                    return "article_display";
                }
                else
                {
                    return "correct_path";
                }
            }
        }
    }
    else
    {
        return "redirect_to_main";
    }
}

sub _initialize
{
	my $self = shift;
	
    my $config = shift;
	$self->config($config); 

    my $tt = Template->new(
        {
            'BLOCKS' => 
                {
                    'main' => $config->{'record_template'},
                },
        },
    );

    $self->record_tt($tt);

	return 0;
}

sub _remove_leading_slash
{
    my ($self, $string) = @_;
    $string =~ s{^/}{};
    return $string;
}

sub _get_path_wo_leading_slash
{
    my $self = shift;
    return $self->_remove_leading_slash($self->_get_path());
}

sub _get_rel_url_to_root
{
    my ($self, $string) = @_;
    return join("", (map { "../" } split(/\//, $string)));
}

sub _get_path_to_root
{
    my $self = shift;

    return $self->_get_rel_url_to_root($self->_get_path_wo_leading_slash());
}

sub _main_page
{
    my $self = shift;

    return $self->tt_process(
        'main_page.tt',
        {
            'path_to_root' => $self->_get_path_to_root(),
            'title' => "Web Interface to the News Server",
            'nntp_server' => $self->param('nntp_server'),
        },
    );
}

sub _about_app_page
{
    my $self = shift;

    return $self->tt_process(
        'about_app_page.tt',
        {
            'title' => "About CGI-Application-NetNewsIface",
            'path_to_root' => $self->_get_path_to_root(),
        },
    );
}

sub _get_nntp
{
    my $self = shift;
    return Net::NNTP->new($self->param('nntp_server'));
}

sub _groups_list_page
{
    my $self = shift;

    my $nntp = $self->_get_nntp();
    
    my $groups = $nntp->list();

    $nntp->quit();

    return $self->tt_process(
        'groups_list_page.tt',
        {
            'groups' => [ sort { $a cmp $b } keys(%$groups) ],
            'title' => "Groups' List",
        }
    );
}

sub _get_group_display_article_data
{
    my ($self, $nntp, $index) = @_;

    my $head = $nntp->head($index);
    my $body = $nntp->body($index);
    my $subject;
    my $author;
    my $date;
    foreach my $line (@$head)
    {
        if ($line =~ m{^Subject: (.*)\n$})
        {
            $subject = $1;
        }
        elsif ($line =~ m{^From: (.*)\n$})
        {
            $author = $1;
        }
        elsif ($line =~ m{^Date: (.*)\n$})
        {
            $date = $1;
        }
    }
    return
    {
        'idx' => $index,
        'subject' => $subject,
        'author' => $author,
        'date' => $date,
        'lines' => scalar(@$body),
    };
}

sub _group_display_page
{
    my $self = shift;

    my $group = $self->param('group');

    my $nntp = $self->_get_nntp();

    my @info = $nntp->group($group);

    if (! @info)
    {
        $nntp->quit();
        return "<html><body><h1>Error! Unknown Group.</h1></body></html>";
    }

    my ($num_articles, $first_article, $last_article, $group_name) = @info;

    my $max_article = $self->query()->param('max') || $last_article;

    if ($max_article < $first_article)
    {
        $max_article = $first_article;
    }
    elsif ($max_article > $last_article)
    {
        $max_article = $last_article;
    }

    my $min_article = $max_article - $self->param('articles_per_page') + 1;

    if ($min_article < $first_article)
    {
        $min_article = $first_article;
    }

    # TODO
    # Is it possible that article numbers won't be consecutive? How should
    # we deal with it?
    my @articles =
        (map
            { $self->_get_group_display_article_data($nntp, $_) }
            ($min_article .. $max_article)
        );
    $nntp->quit();

    return $self->tt_process(
        'group_display_page.tt',
        {
            'group' => $group,
            'title' => "Articles for Group $group",
            'articles' => [reverse(@articles)],
            'nntp_server' => $self->param('nntp_server'),
            'max_art' => $max_article,
            'min_art' => $min_article,
            'num_arts' => $num_articles,
            'last_art' => $last_article,
            'arts_per_page' => $self->param('articles_per_page'),
        }
    );
}

sub _get_show_headers
{
    my $self = shift;
    return scalar($self->query()->param("show_headers"));
}

sub _get_headers
{
    my ($self, $head) = @_;
    if ($self->_get_show_headers())
    {
        return $head;
    }
    else
    {
        return
        [ grep /^(?:Newsgroups|Date|Subject|To|From|Message-ID): /, @$head]
        ;
    }
}

sub _article_display_page
{
    my $self = shift;

    my $group = $self->param('group');
    my $article = $self->param('article');

    my $nntp = $self->_get_nntp();

    my @info = $nntp->group($group);

    if (! @info)
    {
        $nntp->quit();
        return "<html><body><h1>Error! Unknown Group.</h1></body></html>";
    }

    my ($num_articles, $first_article, $last_article, $group_name) = @info;

    # TODO : Error handling.
    my $head = $nntp->head($article);
    my $body = $nntp->body($article);

    my $article_text = 
        join("", 
            map 
            { 
                my $s = $_; 
                chomp($s);
                my $s_esc = CGI::escapeHTML($s);
                ($s =~ /^(Subject|From):/ ? "<b>$s_esc</b>" : $s_esc) . "\n";
            }
            @{$self->_get_headers($head)},
        ) .
        "<br />\n" .
        join("", 
            map { 
                my $s = $_; 
                chomp($s);
                CGI::escapeHTML($s). "\n";
            }
            @$body
        );

    return 
    $self->tt_process(
        'article_display_page.tt',
        {
            'group' => $group,
            'article' => $article,
            'title' => "$group ($article)",
            'text' => $article_text,
            'show_headers' => $self->_get_show_headers(),
            'first_art' => $first_article,
            'last_art' => $last_article,
            'thread' => $self->_get_thread($nntp),
        },
    );
}

sub _thread_render_node
{
    my ($self, $node, $current) = @_;
    my $subj = CGI::escapeHTML($node->{subject});
    my $node_text = 
        ($node->{idx} == $current) ?
            "<b>$subj</b>" :
            qq|<a href="$node->{idx}">$subj</a>|
        ;

    return "<li>$node_text " .
        CGI::escapeHTML($node->{from}) .
        (exists($node->{subs}) ?
            ("<br /><ul>" .
            join("",
                map 
                    {$self->_thread_render_node($_, $current) } 
                @{$node->{subs}}
            ) .
            "</ul>") :
            ""
        ) .
        "</li>";
}

# TODO :
# 2. Make the current article non-linked and bold.
# 3. Add the date (?).
sub _get_thread
{
    my ($self, $nntp) = @_;
    my $article = $self->param('article');

    my $cache = CGI::Application::NetNewsIface::Cache::DBI->new(
        {
            'nntp' => $nntp,
            'dsn' => $self->param('dsn'),
        },
    );
    $cache->select($self->param('group'));

    my ($thread, $coords) = $cache->get_thread($article);

    return "<ul>" . $self->_thread_render_node($thread, $article) . "</ul>";
}

sub _css
{
    my $self = shift;
    $self->header_props(-type => 'text/css');
    return <<"EOF";
.articles th, .articles td
{ 
    vertical-align:top;
    text-align: left;
}
.articles
{
    border-collapse: collapse; 
}
.articles td, .articles th 
{ 
    border: 1.5pt black solid; 
    padding: 2pt;
}
EOF
}


sub update_group
{
    my $self = shift;
    my $group = shift;

    my $cache = CGI::Application::NetNewsIface::Cache::DBI->new(
        {
            'nntp' => $self->_get_nntp(),
            'dsn' => $self->param('dsn'),
        },
    );
    $cache->select($group);
}


sub init_cache__sqlite
{
    my $self = shift;
    return $self->_init_cache({'auto_inc' => "PRIMARY KEY AUTOINCREMENT"});
}


sub init_cache__mysql
{
    my $self = shift;
    return $self->_init_cache({'auto_inc' => "PRIMARY KEY NOT NULL AUTO_INCREMENT"});
}

sub _init_cache
{
    my $self = shift;
    my $args = shift;

    my $auto_inc = $args->{'auto_inc'};

    require DBI;

    my $dbh = DBI->connect($self->param('dsn'), "", "");
    $dbh->do("CREATE TABLE groups (name varchar(255), idx INTEGER $auto_inc, last_art INTEGER)");
    $dbh->do("CREATE TABLE articles (group_idx INTEGER, article_idx INTEGER, msg_id varchar(255), parent INTEGER, subject varchar(255), frm varchar(255), date varchar(255))");
    $dbh->do("CREATE UNIQUE INDEX idx_groups_name ON groups (name)");
    $dbh->do("CREATE UNIQUE INDEX idx_articles_primary ON articles (group_idx, article_idx)");
    $dbh->do("CREATE INDEX idx_articles_msg_id ON articles (group_idx, msg_id)");
    $dbh->do("CREATE INDEX idx_articles_parent ON articles (group_idx, parent)");
}

1;


1; # End of CGI::Application::NetNewsIface