Bryar::DataSource::FlatFile - Blog entries from flat files, a la blosxom


Bryar documentation Contained in the Bryar distribution.

Index


Code Index:

NAME

Top

Bryar::DataSource::FlatFile - Blog entries from flat files, a la blosxom

SYNOPSIS

Top

	$self->all_documents(...);
	$self->search(...);
    $self->add_comment(...);

DESCRIPTION

Top

Just like blosxom, this data source pulls blog entries out of flat files in the file system.

METHODS

Top

all_documents

    $self->all_documents

Returns all documents making up the blog.

all_but_recent

    $self->all_but_recent

Return all documented except recent() ones.

entry_glob

Returns a glob pattern which matches blog posts. This defaults to *.txt.

id_to_file

Takes a Bryar ID, converts it to a file name.

file_to_id

Vice versa.

    $self->search($bryar, $config, %params)

A more advanced search for specific documents

make_document

Turns a filename into a Bryar::Document, by parsing the file blosxom-style.

add_comment

    Class->add_comment($bryar, 
                       document => $doc,
                         author => $author,
                            url => $url,
                        content => $content );

Records the given comment details.

LICENSE

Top

This module is free software, and may be distributed under the same terms as Perl itself.

AUTHOR

Top

Copyright (C) 2003, Simon Cozens simon@kasei.com

some parts Copyright 2007 David Cantrell david@cantrell.org.uk


Bryar documentation Contained in the Bryar distribution.
package Bryar::DataSource::FlatFile;
use Cwd;
use File::Basename;
use Bryar::Document;
use File::Find::Rule;
use 5.006;
use strict;
use warnings;
use Carp;
our $VERSION = '1.2';

my %UID_Cache;

sub all_documents {
    # my ($self, $config) = @_;
    # croak "Must pass in a Bryar::Config object" unless UNIVERSAL::isa($config, "Bryar::Config");
    # my $where = getcwd;
    # chdir($config->datadir); # Damn you, F::F::R.
    # my @docs = map { $self->make_document($_) }
    #             File::Find::Rule->file()
    #                             ->name($self->entry_glob)
    #                             ->maxdepth($config->depth)
    #                             ->in(".");
    # chdir($where);
    # return @docs;
    my ($self, $config) = @_;
    croak "Must pass in a Bryar::Config object" unless UNIVERSAL::isa($config, "Bryar::Config");
    my @docs = sort { $b->epoch() <=> $a->epoch() } $self->search($config);
    return @docs;
}

sub all_but_recent {
    my ($self, $config) = @_;
    croak "Must pass in a Bryar::Config object" unless UNIVERSAL::isa($config, "Bryar::Config");
    my @docs = sort { $b->epoch() <=> $a->epoch() } $self->search($config);
    return @docs[$config->recent() .. $#docs];
}

sub entry_glob { "*.txt" }

sub id_to_file { return $_[1].".txt" }
sub file_to_id { my $file = $_[1]; $file =~ s/.txt$//; $file; }

sub search {
    my ($self, $config, %params) = @_;
    croak "Must pass in a Bryar::Config object" unless UNIVERSAL::isa($config, "Bryar::Config");
    my $was = getcwd;
    my $where = $config->datadir."/";
    if ($params{subblog}) { $where .= $params{subblog}; }
    chdir($where); # Damn you, F::F::R.
    
    my $find = File::Find::Rule->file();
    if ($params{id}) { $find->name($self->id_to_file($params{id})) }
                else { $find->name($self->entry_glob) }
    $find->maxdepth($config->depth);
    if ($params{since})   { $find->mtime(">".$params{since}) }
    if ($params{before})  { $find->mtime("<".$params{before}) }
    my @docs;
    local $/;
    if ($params{content}) { $find->grep(qr/\b\Q$params{content}\E\b/i) }

    @docs = sort { $b->epoch() <=> $a->epoch() } grep { $_->epoch() <= time () } map { $self->make_document($_) } $find->in(".");
    $params{limit} ||= @docs;
    chdir($was);
    return grep { defined } @docs[0..$params{limit}-1];
}

sub make_document {
    my ($self, $file) = @_;
    return unless $file;
    open(my($in), '<:utf8', $file) or return;
    my $when = (stat $in)[9];
    local $/ = "\n";
    my $fileuid = (stat _)[4];
    my $who;
        if (exists $UID_Cache{$fileuid}) {
        $who = $UID_Cache{$fileuid};
    } else {
        $who = $UID_Cache{$fileuid} = getpwuid($fileuid);
    }
    my $title = <$in>;
    chomp $title;
    local $/;
    my $content = <$in>;
    close $in;
    my $id = $self->file_to_id($file);

    my $comments = [];
    $comments = [_read_comments($id, $id.".comments") ]
        if -e $id.".comments";

    my $dir = dirname($file);
    $dir =~ s{^\./?}{};
    my $category = $dir || "main";
    return Bryar::Document->new(
        title    => $title,
        content  => $content,
        epoch    => $when,
        author   => $who,
        id       => $id,
        category => $category,
        comments => $comments
    );
}

sub _read_comments {
    my ($id, $file) = @_;
    open(COMMENTS, '<:utf8', $file) or die $!;
    local $/;
    # Watch carefully
    my $stuff = <COMMENTS>;
    my @rv;
    for (split /-----\n/, $stuff) {
        push @rv,
            Bryar::Comment->new(
                id => $id,
                map {/^(\w+): (.*)/; $1 => $2 } split /\n/, $_
            )
    }
    return @rv;
}

sub add_comment {
    my ($self, $config) = (shift, shift);
    my %params = @_;

    s/\n/\r/g for values %params;

    my @links = ("$params{url} $params{content}" =~ m!(http://)!g);
    if(@links > 3) { # more than three links is definitely spam
        $config->frontend->report_error('Comment failure', 'Attempt to spam the journal.');
    } elsif(length($params{content}) < 1) { # real content always has, errm, content
        $config->frontend->report_error('Comment failure', 'Attempt to post with no content.');
    } elsif(@links) {
        my($email, $author) = map { # kill funny chars to avoid remote
            my $foo = $_;           # execution in open(). Yuck.
            $foo =~ s/[^\w @]/_/g;
            $foo;
        } @params{qw(email author)};
        open(MAIL, "| mail -s \"$email $author maybe tried to spam the journal\" ".$config->email())
            or $config->frontend->report_error('Comment failure', "Cannot send mail: $!");
        print MAIL "$_: $params{$_}\n" for keys %params;
        print MAIL "\nEnvironment\n";
        print MAIL "$_: $ENV{$_}\n" for keys %ENV;
        close MAIL
            or $config->frontend->report_error('Comment failure', "Cannot send mail: $!");
        # FIXME: this is not an error
        $config->frontend->report_error("Your comment is being held for approval.");
    } else {
        my $file = $params{document}->id.".comments";
        $params{url} = "http://".$params{url}
            if($params{url} && $params{url} !~ /^http:\/\//);
        # This probably fails with subblogs, but I don't use them.
        chdir $config->datadir."/";
        open(OUT, ">>:utf8", $file)
            or $config->frontend->report_error("Cannot open $file", $!);
        delete $params{document};
        print OUT "$_: $params{$_}\n" for keys %params;
        print OUT "-----\n";
        # Looks a bit like blosxom, doesn't it?
        close OUT;
        # now send mail
        open(MAIL, '| mail -s "Someone commented in the journal" '.$config->email())
            or $config->frontend->report_error('Comment failure', "Cannot send mail: $!");
        print MAIL "$_: $params{$_}\n" for keys %params;
        print MAIL "\nEnvironment\n";
        print MAIL "$_: $ENV{$_}\n" for keys %ENV;
        close MAIL
            or $config->frontend->report_error('Comment failure', "Cannot send mail: $!");
    }
}

1;