package Rhetoric::Storage::File;
use common::sense;
use aliased 'Squatting::H';
use Data::Dump 'pp';
use DateTime;
use Cwd;
use File::Copy;
use File::Basename;
use File::Find::Rule;
use File::Path::Tiny;
use File::ShareDir ':ALL';
use IO::All;
use Method::Signatures::Simple;
use Ouch;
use Rhetoric::Helpers ':all';
# shortcuts for File::Path::Tiny
*mk = *File::Path::Tiny::mk;
our $storage = H->new({
init => method($config) {
$self->root($config->{'storage.file.path'});
$self->archive_format($config->{'archive_format'});
$self;
},
install => method {
my $root = $self->root;
mk("$root/posts");
mk("$root/categories");
mk("$root/categories/Perl");
my $share = File::ShareDir::dist_dir('Rhetoric');
# TODO - Don't use system()
# TODO - Move this to Rhetoric::Meta
mk("$root/menu");
system("cp '$share/menu/'* '$root/menu'");
# TODO - Move this to Rhetoric::Meta
mk("$root/pages");
system("cp '$share/pages/'* '$root/pages'");
# TODO - Move this to Rhetoric::Meta
#mk("$root/widgets");
system("rsync -a '$share/widgets/' '$root/widgets/'");
my $cwd = getcwd;
chdir "$root/widgets/sidebar";
symlink("init.pl", "00_init.pl");
symlink("search.pl", "01_search.pl");
symlink("content.pl", "02_about.pl");
symlink("categories.pl", "03_categories.pl");
symlink("archives.pl", "04_archives.pl");
symlink("cleanup.pl", "99_cleanup.pl");
chdir $cwd;
# TODO - Move this to Rhetoric::Meta
$self->meta(title => "Rhetoric") unless (-e "$root/title");
$self->meta(subtitle => "Simple Blogging for Perl") unless (-e "$root/subtitle");
$self->meta('copy' => "COPYRIGHT (C) 2011 SOMESITE.COM. ALL RIGHTS RESERVED") unless (-e "$root/copy");
return 1;
},
meta => method($k, $v) {
my $root = $self->root;
if (defined($v)) {
wl("$root/$k", "$v");
} else {
$v = rl("$root/$k");
}
return $v;
},
new_post => method($post) {
ref($post) eq 'HASH' && H->bless($post);
my ($title, $body, $format, $schedule);
$title = $post->title;
$body = $post->body;
$format = $post->format || 'pod';
my ($Y, $M, $D, $h, $m, $s);
if ($schedule) {
# FIXME - use $post->posted_on instead of $schedule
($Y, $M, $D, $h, $m, $s) = split('/', $schedule);
} else {
($Y, $M, $D, $h, $m, $s) = now();
}
my $dt = DateTime->new(
year => $Y,
month => $M,
day => $D,
hour => $h,
minute => $m,
second => $s,
);
my $root = $self->root;
my $post_path = sprintf("$root/posts/%d/%02d/%02d/%02d/%02d/%02d", $Y, $M, $D, $h, $m, $s);
mk($post_path);
wl("$post_path/title", $title);
wl("$post_path/slug", slug($title));
wl("$post_path/body", $body);
wl("$post_path/format", $format);
$post->slug(slug($title));
$post->format($format);
$post->year($Y);
$post->month($M);
$post->posted_on($dt);
$post->author($ENV{USER});
return $post;
},
# fetch a post
post => method($y, $m, $slug) {
my $root = $self->root;
my $partial_post_path = "$root/posts/$y/$m";
my @files = File::Find::Rule
->file()
->name('slug')
->in($partial_post_path);
my ($file) = grep { my $test_slug = rl($_); $test_slug eq $slug } @files;
if ($file) {
my $post_path = dirname($file);
my $title = rl("$post_path/title");
my $format = rl("$post_path/format");
chomp($format);
my $body = $F->$format(io("$post_path/body")->all);
my @s = split('/', $post_path);
my ($Y, $M, $D, $h, $m, $s) = @s[-6 .. -1];
my $posted_on = DateTime->new(year => $Y, month => $M, day => $D, hour => $h, minute => $m, second => $s);
my $post = H->new({
title => $title,
slug => $slug,
body => $body,
format => $format,
posted_on => $posted_on,
year => $Y,
month => $M,
day => $D,
hour => $h,
minute => $m,
second => $s,
author => ($Rhetoric::CONFIG{user} // file_owner("$post_path/title")),
});
my @comment_files = glob("$post_path/comments/*");
my $comment_count = scalar(@comment_files);
$post->comment_count($comment_count);
return $post;
} else {
return undef;
}
},
# FIXME - This implementation is not efficient,
# FIXME because it scans the entire post history every time.
posts => method($count, $page) {
my $root = $self->root;
my @all_posts = reverse sort (
File::Find::Rule
->file()
->name('slug')
->in("$root/posts")
);
$count = (@all_posts < $count) ? scalar(@all_posts) : $count;
my $pager = Data::Page->new(
scalar(@all_posts), # total # of posts
$count, # posts per page
$page # current page
);
my @p = $pager->splice(\@all_posts);
my @posts = map {
my @d = (split('/', $_))[-7 .. -1]; # d for directory
my $slug = rl($_);
my ($y, $m) = ($d[0], $d[1]);
$self->post($y, $m, $slug);
} @p;
return (\@posts, $pager);
},
categories => method {
my $root = $self->root;
my $category_path = "$root/categories";
my @c = sort (
map { basename($_) }
File::Find::Rule
->directory()
->mindepth(1)
->maxdepth(1)
->in($category_path)
);
},
# TODO - list of category posts
category_posts => method($category) {
([], undef);
},
#
archives => method {
my $root = $self->root;
my $post_path = "$root/posts";
my @d = reverse sort (
File::Find::Rule
->directory()
->mindepth(2)
->maxdepth(2)
->in($post_path)
);
my @ad = map {
my $path = $_;
$path =~ s/^$post_path\///;
my ($year, $month) = split('/', $path);
my $name = DateTime
->new(year => $year, month => $month)
->strftime($self->archive_format);
my $archive = H->new({
year => $year,
month => $month,
name => $name,
});
} @d;
@ad;
},
#
archive_posts => method($y, $m) {
my $root = $self->root;
my @all_posts = reverse sort (
File::Find::Rule
->file()
->name('slug')
->in("$root/posts/$y/$m")
);
my @posts = map {
my @d = (split('/', $_))[-7 .. -1]; # d for directory
my $slug = rl($_);
my ($y, $m) = ($d[0], $d[1]);
$self->post($y, $m, $slug);
} @all_posts;
(\@posts, undef);
},
#
comments => method($post) {
my $root = $self->root;
my $post_path = sprintf('%s/posts/%s/%s/%s/%s/%s/%s',
$root,
$post->year, $post->month, $post->day,
$post->hour, $post->minute, $post->second,
);
my @comment_files = sort glob("$post_path/comments/*");
my @comments = map {
my ($name,$email,$url,@body) = io($_)->slurp;
chomp($name, $email, $url);
my $body = join('', @body);
H->new({
name => $name,
email => $email,
url => $url,
body => $body,
});
} @comment_files;
\@comments;
},
#
new_comment => method($year, $month, $slug, $comment) {
ref($comment) eq 'HASH' && H->bless($comment);
my @errors;
push @errors, ['name'] if (not $comment->name);
push @errors, ['email'] if (not $comment->email);
push @errors, ['body'] if (not $comment->body);
if (@errors) {
ouch('InvalidComment', \@errors);
}
my $post = $self->post($year, $month, $slug);
my $root = $self->root;
my $post_path = sprintf('%s/posts/%s/%s/%s/%s/%s/%s',
$root,
$post->year, $post->month, $post->day,
$post->hour, $post->minute, $post->second,
);
warn("$post_path/comments");
mk("$post_path/comments");
my @comment_files = sort glob("$post_path/comments/*");
my $index = '001';
if (@comment_files) {
warn "previous comments existed";
my $last = (split('/', $comment_files[-1]))[-1];
$last =~ s/^0*//;
warn "last is $last";
$index = sprintf('%03d', $last + 1);
}
warn $index;
my $format = $comment->format || 'pod';
my $body = $F->$format($comment->body);
io("$post_path/comments/$index") < $comment->name . "\n";
io("$post_path/comments/$index") << $comment->email . "\n";
io("$post_path/comments/$index") << $comment->url . "\n";
io("$post_path/comments/$index") << $body . "\n";
$comment->success(1);
$comment;
},
# XXX - this needs to take TT or perl expressions
menu => method($menu) {
my $root = $self->root;
my $menu_path = "$root/menu";
if (defined($menu)) {
my $i = 1;
for (@$menu) {
my $name = $_->name;
my $url = $_->url;
io(sprintf("$menu_path/%02d_%s", $i, $menu)) < $url;
$i++;
}
} else {
my @menu_files = sort glob("$menu_path/*");
$menu = [ map {
my $filename = $_;
my $url = rl($filename);
my ($name) = fileparse($filename);
chomp($url);
$name =~ s/^\d*_//;
H->new({ name => $name, url => $url });
} @menu_files ];
}
return $menu;
},
});
1;
__END__
=head1 NAME
Rhetoric::Storage::File - filesystem-based storage for Rhetoric blog data
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 API
=head2 Package Variables
=head3 $storage
=head2 Methods for $storage
=head3 $storage->init
=head3 $storage->meta($key, $value)
=head3 $storage->new_post($post)
=head3 $storage->post($year, $month, $slug)
=head3 $storage->posts($count, $after)
=head3 $storage->categories
=head3 $storage->category_posts
=head3 $storage->archives
=head3 $storage->archive_posts($year, $month)
=head3 $storage->comments($post)
=head3 $storage->new_comment($year, $month, $slug, $comment)
=cut
# Local Variables: ***
# mode: cperl ***
# indent-tabs-mode: nil ***
# cperl-close-paren-offset: -2 ***
# cperl-continued-statement-offset: 2 ***
# cperl-indent-level: 2 ***
# cperl-indent-parens-as-block: t ***
# cperl-tab-always-indent: nil ***
# End: ***
# vim:tabstop=2 softtabstop=2 shiftwidth=2 shiftround expandtab