view release on metacpan or  search on metacpan

lib/Bryar/Frontend/Base.pm  view on Meta::CPAN

    sub send_header {...}
    sub get_header {...}

=head1 DESCRIPTION

This abstracts the work of front-ending Bryar, to make real front-end
classes tidier.

=head1 METHODS

You provide these.

=head2 obtain_url

Returns the full URL for this page.

=head2 obtain_path_info

Returns the path info from the server: the part of the URL after
F<bryar.cgi> or whatever.

=head2 obtain_params

Returns a hash of CGI parameters.

=head2 send_data

Write stuff to the browser. This will only be called once.

=head2 send_header

Write stuff to the browser, first.

=head2 get_header

Read a HTTP header.

=cut

sub obtain_url { croak "Don't use Bryar::FrontEnd::Base directly"; }
sub obtain_params { croak "Abstract base class. ABSTRACT BASE CLASS."; }

sub parse_args {
    my $self = shift;
    my $config = shift;
    my %params = $self->obtain_params();
    my %args = $self->parse_path($config);
    if (my $search = $params{search}) {
        $args{content} = $search if $search =~ /\S{3,}/; # Avoid trivials.
    }
    for (qw(comments format)) {
		$args{$_} = $params{$_} if exists $params{$_};
    }
    $self->process_new_comment($config, %params) if $params{newcomment};
    return %args;
}

sub parse_path {
    my ($self, $config) = @_;
    my $pi = $self->obtain_path_info();
    my @pi = split m{/}, $pi;
    shift @pi while @pi and not$pi[0];
    #...

    my %args;
    if ($pi[-1] and $pi[-1] eq "xml") { $args{format} = "xml"; pop @pi; }
    if ($pi[-1] and $pi[-1] =~ /^id_([0-9]+)/) { $args{id} = $1; pop @pi; }
    if ($pi[0] and $pi[0] =~ /^([a-zA-Z]\w*)/
               and $pi[0] !~ /^(?:before)_[0-9]+$/) { # We have a subblog
        $args{subblog} = $1;
        shift @pi;
    }
    if (@pi == 1 and $pi[0] =~ /^before_([0-9]+)$/) {
        $args{before} = $1;
        $args{limit} = $config->{recent};
    } elsif (@pi) { # Time/date handling
        my ($from, $til) = _make_from_til(@pi);
        if ($from and $til) {
            $args{before} = $til;
            $args{since} = $from;
        }
    } else {
        $args{limit}   = $config->{recent} if $args{subblog};
    }

    return %args;
}

sub process_new_comment {
    my ($self, $config, %params) = @_;
    my ($doc) = $config->source->search($config, id => $params{id});
    $self->report_error("Couldn't find Doc $params{id}") unless $doc;
    $config->source->add_comment(
        $config,
        document => $doc,
        author => $params{author},
        url => $params{url},
        email => $params{email},
        content => $params{content},
        epoch => time
    );
}

my $mon = 0;
my %mons = map { $_ => $mon++ }
    qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

sub _make_from_til {
    my ($y, $m, $d) = @_;
    if (!$y) { return (0,0) }
    my ($fm, $tm) = (0, 11);
    if ($m and exists $mons{$m}) { $fm = $tm = $mons{$m}; }
    my ($fd, $td);
    if ($d) { $fd = $td = $d }
    else { 
        $fd = 1;
        my $when = timelocal(0,0,0,1, $tm, $y);
        $td = Time::Piece->new($when)->month_last_day;
    }
    return (timelocal(0,0,0, $fd, $fm, $y),
            timelocal(59,59,23, $td, $tm, $y));