File Coverage

blib/lib/Rhetoric/Storage/File.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

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__