├── MANIFEST.SKIP ├── README.md ├── TODO.md ├── app.psgi ├── bin ├── autoblog └── blawd ├── dist.ini ├── lib ├── Blawd.pm └── Blawd │ ├── Archive.pm │ ├── Cmd.pm │ ├── Cmd │ ├── Command │ │ ├── mt_export.pm │ │ ├── render.pm │ │ ├── server.pm │ │ └── wp_export.pm │ └── Container.pm │ ├── Entry.pm │ ├── Entry │ ├── API.pm │ ├── HTML.pm │ ├── MultiMarkdown.pm │ └── Text.pm │ ├── Exporter.pm │ ├── Exporter │ └── DB.pm │ ├── Index.pm │ ├── OO.pm │ ├── OO │ └── Role.pm │ ├── Renderable.pm │ ├── Renderer.pm │ ├── Renderer │ ├── API.pm │ ├── Atom.pm │ ├── HTML.pm │ └── RSS.pm │ ├── Storage.pm │ └── Storage │ ├── API.pm │ ├── Directory.pm │ └── Git.pm └── t └── 01.basic.t /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | MANIFEST.SKIP 2 | ^\.gitignore$ 3 | ^\.git/ 4 | /\.svn/ 5 | ^\.svn/ 6 | ~$ 7 | \.sw.$ 8 | \.bak$ 9 | \bblib\b 10 | \bpm_to_blib\b 11 | ^Makefile$ 12 | ^Makefile\.old$ 13 | ^control/ 14 | ^Module-Install-AutoManifest-\d 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Blawd -- a Jekyll/Bloxsom like Blog Built around Git 2 | 3 | Blawd is a blog aware git based content management system, similar to 4 | Bloxsom or Jekyll. It has managed to replace MovableType on my personal 5 | blog, but it is still very very rough. By default it will generate a 6 | tree of HTML documents, but it can be run as a server as well using 7 | [Plack](http://search.cpan.org/dist/Plack). 8 | 9 | ## The Name 10 | 11 | 04:24 <@perigrin> .ety blossom 12 | 04:24 <+phenny> "O.E. blostma, from P.Gmc. *blo-s-, from PIE *bhle-, extended 13 | form of *bhel- 'to thrive, bloom.' This is the native word, now 14 | largely superseded by bloom and flower." - 15 | http://etymonline.com/?term=blossom 16 | 04:25 <@perigrin> interesting 17 | 04:25 <@perigrin> .ety flower 18 | 04:25 <+phenny> "c.1200, from O.Fr. flor, from L. florem (nom. flos) 'flower' 19 | (see flora), from PIE base *bhlo- 'to blossom, flourish' (cf. 20 | M.Ir. blath, Welsh blawd 'blossom, flower,' O.E. blowan 'to 21 | flower, bloom')." - http://etymonline.com/?term=flower 22 | 23 | ## Usage 24 | 25 | blawd server --repo /path/to/blog.git 26 | 27 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # TODO 2 | 3 | * Fix the Tests: They are horrifically stale and do not cover the 4 | general usage of most of the application now. 5 | * Config -- I would like to use 6 | [Config::GitLike](http://search.cpan.org/dist/Config-GitLike/) to 7 | control the configuration stuff. This would live in the repo under a 8 | [Blawd] header or something like that. 9 | * More Index types -- I want to be able to easily auto-create archive 10 | indexes for date ranges (Year, Month, etc) based on aggregating 11 | entries properly. It would be awesome to figure out a way to easily 12 | make this into strings we can store in the config 13 | * Set the Main Index and RSS feed to filter on posts with a time > 14 | DateTime->now -- this will let us work on posts for a while and then 15 | have them "auto post" 16 | * Pipe line of Renderers -- MultiMarkdown is designed to render (via 17 | xslt) into other formats, I'd like to be able to chain Renderer's 18 | together 19 | * Plugin API -- I really would like something like Dist::Zilla's plugin 20 | architecture to be able to control how things are hooked together 21 | * Templates -- A renderer for Template based rendering would be nice, 22 | possibly starting with TT2 or Tiffany -------------------------------------------------------------------------------- /app.psgi: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use 5.10.1; 4 | use lib qw(lib); 5 | 6 | use Encode; 7 | 8 | use Plack::Request; 9 | use Plack::Response; 10 | 11 | use Blawd::Storage; 12 | use Blawd::Cmd::Container; 13 | 14 | my $repo = '/Users/perigrin/dev/the-room/.git/'; 15 | 16 | my $app = sub { 17 | my $req = Plack::Request->new(@_); 18 | my $res = handle_request($req); 19 | return $res->finalize; 20 | }; 21 | 22 | sub handle_request { 23 | my ($req) = @_; 24 | my $storage = Blawd::Storage->create_storage($repo); 25 | my $container = Blawd::Cmd::Container->new( storage => $storage ); 26 | 27 | my $blawd = $container->build_app(); 28 | my $renderer = $blawd->get_renderer('HTML'); 29 | my $res = Plack::Response->new( 200, { Content_Type => 'text/html' } ); 30 | given ( $req->path ) { 31 | $_ =~ s|^/||; 32 | when ('site.css') { 33 | my $css = q[ 34 | html { 35 | background-color: grey; 36 | } 37 | body { 38 | width: 900px; 39 | background: white; 40 | border: 1px solid black; 41 | padding-left: 25px; 42 | padding-right: 25px; 43 | } 44 | ]; 45 | $res->content_type('text/css'); 46 | $res->body( encode_utf8 $css); 47 | return $res; 48 | } 49 | $_ =~ s|\..*?$||; 50 | when ( $blawd->get_entry($_) ) { 51 | my $entry = $blawd->get_entry($_); 52 | $res->body( encode_utf8 $renderer->render_page($entry) ); 53 | return $res; 54 | } 55 | when ( $blawd->get_index($_) ) { 56 | my $index = $blawd->get_index($_); 57 | $res->body( encode_utf8 $renderer->render_page($index) ); 58 | return $res; 59 | } 60 | default { 61 | my $index = $blawd->get_index('index'); 62 | $res->body( encode_utf8 $renderer->render_page($index) ); 63 | return $res; 64 | } 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /bin/autoblog: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | use lib qw(lib); 5 | use File::ChangeNotify; 6 | 7 | use Blawd::Storage::Directory; 8 | use Blawd::Cmd::Container; 9 | 10 | my ($repo, $out) = @ARGV; 11 | die unless $repo && $out; 12 | 13 | my $watcher = File::ChangeNotify->instantiate_watcher( 14 | directories => [$repo], 15 | filter => qr/^[^\.]/, 16 | ); 17 | 18 | while ($watcher->wait_for_events) { 19 | my $storage = Blawd::Storage::Directory->new(location => $repo); 20 | my $container = Blawd::Cmd::Container->new(storage => $storage); 21 | my $blawd = $container->build_app; 22 | $blawd->render_all($out); 23 | } 24 | -------------------------------------------------------------------------------- /bin/blawd: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use 5.10.0; 3 | use lib qw(lib); 4 | use Blawd::Cmd; 5 | 6 | Blawd::Cmd->run; 7 | 8 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Blawd 2 | author = Chris Prather 3 | license = Perl_5 4 | copyright_holder = Tamarou, LLC 5 | copyright_year = 2012 6 | 7 | [AutoPrereqs] 8 | [Prereqs] 9 | Bread::Board = 0 10 | 11 | [@Basic] 12 | [@Git] 13 | changelog = Changes 14 | allow_dirty = dist.ini 15 | allow_dirty = Changes 16 | commit_msg = v%v%n%n%c 17 | tag_format = %v 18 | tag_message = %v 19 | push_to = origin 20 | [AutoVersion] 21 | 22 | [PodSyntaxTests] 23 | [PodCoverageTests] 24 | -------------------------------------------------------------------------------- /lib/Blawd.pm: -------------------------------------------------------------------------------- 1 | package Blawd; 2 | use Blawd::OO; 3 | 4 | our $VERSION = '0.01'; 5 | 6 | has indexes => ( 7 | isa => 'ArrayRef[Blawd::Index]', 8 | is => 'ro', 9 | traits => ['Array'], 10 | handles => { 11 | index => [ 'get', '0' ], 12 | find_index => ['grep'], 13 | }, 14 | required => 1, 15 | ); 16 | 17 | sub get_index { 18 | my ( $self, $name ) = @_; 19 | return unless $name; 20 | my ($idx) = $self->find_index( sub { $_->filename eq $name } ); 21 | return $idx; 22 | } 23 | 24 | has entries => ( 25 | isa => 'ArrayRef', 26 | traits => ['Array'], 27 | handles => { 28 | find_entry => ['grep'], 29 | entries => ['elements'], 30 | }, 31 | required => 1, 32 | ); 33 | 34 | sub get_entry { 35 | my ( $self, $name ) = @_; 36 | return unless $name; 37 | my ($entry) = $self->find_entry( sub { $_->filename eq $name } ); 38 | return $entry; 39 | } 40 | 41 | has renderers => ( 42 | isa => 'ArrayRef', 43 | traits => ['Array'], 44 | handles => { 45 | find_renderer => ['grep'], 46 | renderers => ['elements'], 47 | }, 48 | required => 1, 49 | ); 50 | 51 | sub get_renderer { 52 | my ( $self, $name ) = @_; 53 | return unless $name; 54 | my ($renderer) = $self->find_renderer( 55 | sub { blessed($_) eq "Blawd::Renderer::$name" } 56 | ); 57 | return $renderer; 58 | } 59 | 60 | sub render_all { 61 | my $self = shift; 62 | my ($output_dir) = @_; 63 | 64 | # XXX: this should all eventually be configurable 65 | 66 | for my $entry ($self->entries) { 67 | my $renderer = $self->get_renderer('HTML'); 68 | $renderer->render_to_file( 69 | File::Spec->catfile($output_dir, $entry->filename_base . $renderer->extension), 70 | $entry, 71 | ); 72 | } 73 | 74 | for my $index (@{ $self->indexes }) { 75 | for my $renderer ($self->renderers) { 76 | $renderer->render_to_file( 77 | File::Spec->catfile($output_dir, $index->filename_base . $renderer->extension), 78 | $index, 79 | ); 80 | } 81 | } 82 | } 83 | 84 | __PACKAGE__->meta->make_immutable; 85 | 1; 86 | __END__ 87 | 88 | =head1 NAME 89 | 90 | Blawd - A Blogging application in the style of Jekyll or Blosxome 91 | 92 | =head1 VERSION 93 | 94 | This documentation refers to version 0.01. 95 | 96 | =head1 SYNOPSIS 97 | 98 | $ blawd server --repo $HOME/my-blog/.git 99 | 100 | =head1 DESCRIPTION 101 | 102 | Blawd is a blog aware git based content management system, similar to 103 | Bloxsom or Jekyll. It has managed to replace MovableType on my personal 104 | blog, but it is still very very rough. By default it will generate a 105 | tree of HTML documents, but it can be run as a server as well using 106 | L 107 | 108 | =head1 METHODS 109 | 110 | =head2 get_index (Str $name) 111 | 112 | Retrieved the the named L 113 | 114 | =head2 get_entry (Str $name) 115 | 116 | Retrieve the named Blawd Entry. 117 | 118 | =head1 DEPENDENCIES 119 | 120 | =over 121 | 122 | =item aliased 123 | 124 | =item Bread::Board 125 | 126 | =item DateTime 127 | 128 | =item DBI 129 | 130 | =item Git::PurePerl 131 | 132 | =item Memoize 133 | 134 | =item Module::Pluggable 135 | 136 | =item Moose => 0.92 137 | 138 | =item MooseX::Aliases 139 | 140 | =item MooseX::Types::DateTime 141 | 142 | =item MooseX::Types::DateTimeX 143 | 144 | =item MooseX::Types::Path::Class 145 | 146 | =item namespace::autoclean 147 | 148 | =item Path::Class 149 | 150 | =item Plack 151 | 152 | =item Text::MultiMarkdown => 1.0.30 153 | 154 | =item Try::Tiny 155 | 156 | =item XML::RSS 157 | 158 | =item YAML 159 | 160 | =back 161 | 162 | =head1 BUGS AND LIMITATIONS 163 | 164 | None known currently, please email the author if you find any. 165 | 166 | =head1 AUTHOR 167 | 168 | Chris Prather (chris@prather.org) 169 | 170 | =head1 LICENCE 171 | 172 | Copyright 2009 by Chris Prather. 173 | 174 | This software is free. It is licensed under the same terms as Perl itself. 175 | 176 | =cut 177 | -------------------------------------------------------------------------------- /lib/Blawd/Archive.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Archive; 2 | use Blawd::OO; 3 | extends 'Blawd::Index'; 4 | use URI::Escape; 5 | 6 | sub render_page_HTML { 7 | my $self = shift; 8 | my ($renderer) = @_; 9 | 10 | return '

Archives

    ' . ( 11 | join "\n", 12 | map { 13 | my $link = uri_escape( $_->filename_base ); 14 | "
  • " 15 | . qq[${\$_->title}] 16 | . ' ' 17 | . $_->date 18 | . ")
    • " 19 | } $self->entries 20 | ) . "
"; 21 | } 22 | 23 | sub render_fragment_HTML { 24 | my $self = shift; 25 | $self->render_page_HTML(); 26 | } 27 | 28 | with qw/Blawd::Renderable/; 29 | 30 | __PACKAGE__->meta->make_immutable; 31 | 32 | 1; 33 | __END__ 34 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd; 2 | use Blawd::OO; 3 | extends qw(MooseX::App::Cmd); 4 | 5 | __PACKAGE__->meta->make_immutable; 6 | 1; 7 | __END__ 8 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd/Command/mt_export.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd::Command::mt_export; 2 | use Blawd::OO; 3 | extends qw(MooseX::App::Cmd::Command); 4 | use DBI; 5 | use Path::Class; 6 | use Git::Wrapper; 7 | 8 | sub abstract { q[Import blog data from an existing Movable Type blog] } 9 | 10 | has author => ( isa => 'Str', is => 'ro', ); 11 | 12 | has repo => ( 13 | isa => 'Str', 14 | is => 'ro', 15 | required => 1 16 | ); 17 | 18 | has blog_id => ( isa => 'Int', is => 'ro', default => 1 ); 19 | 20 | has [qw(db host port user pass)] => 21 | ( isa => 'Str', is => 'ro', lazy_build => 1 ); 22 | sub _build_db { '' } 23 | sub _build_host { '127.0.01' } 24 | sub _build_port { 3306 } 25 | sub _build_user { $ENV{USER} } 26 | sub _build_pass { '' } 27 | 28 | sub dsn { 29 | my $s = shift; 30 | qq'DBI:mysql:${\$s->db};host=${\$s->host}'; 31 | } 32 | 33 | has entry_query => ( 34 | isa => 'Str', 35 | is => 'ro', 36 | lazy_build => 1, 37 | ); 38 | 39 | sub _build_entry_query { 40 | my ($self) = @_; 41 | 42 | q{ 43 | SELECT * 44 | FROM mt_entry 45 | WHERE entry_blog_id = ? 46 | ORDER BY entry_authored_on ASC 47 | } 48 | } 49 | 50 | has dbi => ( 51 | is => 'ro', 52 | traits => ['NoGetopt'], 53 | lazy_build => 1, 54 | ); 55 | 56 | sub _build_dbi { 57 | my ($self) = @_; 58 | DBI->connect( $self->dsn, $self->user, $self->pass ); 59 | } 60 | 61 | has git => ( isa => 'Git::Wrapper', is => 'ro', lazy_build => 1, ); 62 | 63 | sub _build_git { 64 | my $self = shift; 65 | Git::Wrapper->new( $self->repo ); 66 | } 67 | 68 | before execute => sub { 69 | my $self = shift; 70 | unless (-d $self->repo) { 71 | dir($self->repo)->mkpath; 72 | $self->git->init; 73 | } 74 | }; 75 | 76 | sub execute { 77 | my $self = shift; 78 | 79 | my $sth = $self->dbi->prepare( $self->entry_query ); 80 | $sth->execute( $self->blog_id ); 81 | 82 | my $i; 83 | while ( my $entry = $sth->fetchrow_hashref ) { 84 | chomp( my $name = lc $entry->{entry_title} ); 85 | $name =~ s/["'#,*]|\.{3}$//g; 86 | $name =~ s{ ::? | \s | [/)(] }{-}gx; 87 | warn $name; 88 | $name = 'untitled' . ++$i unless $name; 89 | dir( $self->repo )->file($name)->openw->print( <<"END_ENTRY" ); 90 | Title: $entry->{entry_title} 91 | Author: ${\$self->author} 92 | Date: $entry->{entry_authored_on} 93 | 94 | # $entry->{entry_title} 95 | $entry->{entry_text} 96 | END_ENTRY 97 | 98 | $self->git->add($name); 99 | } 100 | $self->git->commit( { message => "import blog" } ); 101 | 102 | } 103 | 104 | __PACKAGE__->meta->make_immutable; 105 | 1; 106 | __END__ 107 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd/Command/render.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd::Command::render; 2 | use Blawd::OO; 3 | extends qw(MooseX::App::Cmd::Command); 4 | 5 | use Blawd::Storage; 6 | use Blawd::Cmd::Container; 7 | 8 | sub abstract { q[Render blog as static HTML files] } 9 | 10 | has repo => ( 11 | isa => 'Str', 12 | is => 'ro', 13 | required => 1, 14 | documentation => q[Location of the blog's data files], 15 | ); 16 | 17 | has output_dir => ( 18 | isa => 'Str', 19 | is => 'ro', 20 | required => 1, 21 | documentation => q[Location to put the rendered output], 22 | ); 23 | 24 | has container => ( 25 | traits => [qw(NoGetopt)], 26 | isa => 'Blawd::Cmd::Container', 27 | is => 'ro', 28 | lazy_build => 1, 29 | ); 30 | 31 | sub _build_container { 32 | my $self = shift; 33 | my $storage = Blawd::Storage->create_storage($self->repo); 34 | Blawd::Cmd::Container->new(storage => $storage); 35 | } 36 | 37 | sub execute { 38 | my $self = shift; 39 | my $blawd = $self->container->build_app; 40 | $blawd->render_all($self->output_dir); 41 | } 42 | 43 | __PACKAGE__->meta->make_immutable; 44 | 1; 45 | __END__ 46 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd/Command/server.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd::Command::server; 2 | use 5.10.0; 3 | use Blawd::OO; 4 | use Plack::Loader; 5 | use Plack::Request; 6 | use Plack::Response; 7 | 8 | sub abstract { q[Run a local webserver to serve blog files] } 9 | 10 | extends qw(MooseX::App::Cmd::Command); 11 | 12 | has repo => ( 13 | isa => 'Str', 14 | is => 'ro', 15 | required => 1, 16 | documentation => q[Location of the blog's data files], 17 | ); 18 | 19 | has host => ( 20 | isa => 'Str', 21 | is => 'ro', 22 | default => 'localhost', 23 | documentation => q[Local host for the server to bind to], 24 | ); 25 | 26 | has port => ( 27 | isa => 'Int', 28 | is => 'ro', 29 | default => 1978, 30 | documentation => q[Local port for the server to bind to], 31 | ); 32 | 33 | sub execute { 34 | my $self = shift; 35 | say "Starting up server on http://${\$self->host}:${\$self->port}"; 36 | Plack::Loader->auto( 37 | host => $self->host, 38 | port => $self->port, 39 | )->run( 40 | sub { 41 | my $req = Plack::Request->new(@_); 42 | my $res = $self->handle_request($req); 43 | return $res->finalize; 44 | } 45 | ); 46 | } 47 | 48 | has container => ( 49 | traits => [qw(NoGetopt)], 50 | isa => 'Blawd::Cmd::Container', 51 | is => 'ro', 52 | lazy_build => 1, 53 | ); 54 | 55 | sub _build_container { 56 | my $self = shift; 57 | my $storage = Blawd::Storage->create_storage($self->repo); 58 | Blawd::Cmd::Container->new(storage => $storage); 59 | } 60 | 61 | sub handle_request { 62 | my ( $self, $req ) = @_; 63 | my $blawd = $self->container->build_app(); 64 | my $renderer = $blawd->get_renderer('HTML'); 65 | my $res = Plack::Response->new(200, { Content_Type => 'text/html' }); 66 | given ( $req->path ) { 67 | $_ =~ s|^/||; 68 | when ('site.css') { 69 | my $css = q[ 70 | html { 71 | background-color: grey; 72 | } 73 | body { 74 | width: 900px; 75 | background: white; 76 | border: 1px solid black; 77 | padding-left: 25px; 78 | padding-right: 25px; 79 | } 80 | ]; 81 | $res->content_type('text/css'); 82 | $res->body($css); 83 | return $res; 84 | } 85 | $_ =~ s|\..*?$||; 86 | when ( $blawd->get_entry($_) ) { 87 | my $entry = $blawd->get_entry($_); 88 | $res->body($renderer->render_page($entry)); 89 | return $res; 90 | } 91 | when ( $blawd->get_index($_) ) { 92 | my $index = $blawd->get_index($_); 93 | $res->body($renderer->render_page($index)); 94 | return $res; 95 | } 96 | default { 97 | $res->body($renderer->render_page($blawd->get_index('index'))); 98 | return $res; 99 | } 100 | } 101 | 102 | } 103 | 104 | __PACKAGE__->meta->make_immutable; 105 | 1; 106 | __END__ 107 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd/Command/wp_export.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd::Command::wp_export; 2 | use Blawd::OO; 3 | extends qw(Blawd::Cmd::Command::mt_export); 4 | use Path::Class; 5 | 6 | sub abstract {q[Import blog data from an existing Wordpress blog]} 7 | 8 | sub _build_entry_query { 9 | q{ 10 | SELECT * 11 | FROM wp_posts 12 | where post_status='publish'; 13 | } 14 | } 15 | 16 | sub execute { 17 | my $self = shift; 18 | 19 | my $sth = $self->dbi->prepare( $self->entry_query ); 20 | $sth->execute(); 21 | 22 | my $i; 23 | while ( my $entry = $sth->fetchrow_hashref ) { 24 | chomp( my $name = lc $entry->{entry_title} ); 25 | $name =~ s/["'#,*]|\.{3}$//g; 26 | $name =~ s{ ::? | \s | [/)(] }{-}gx; 27 | warn $name; 28 | $name = 'untitled' . ++$i unless $name; 29 | dir( $self->repo )->file($name)->openw->print( <<"END_ENTRY" ); 30 | Title: $entry->{post_title} 31 | Author: ${\$self->author} 32 | Date: $entry->{post_date} 33 | 34 | ## $entry->{entry_title} 35 | $entry->{entry_content} 36 | END_ENTRY 37 | 38 | $self->git->add($name); 39 | } 40 | $self->git->commit( { message => "import blog" } ); 41 | 42 | } 43 | 44 | __PACKAGE__->meta->make_immutable; 45 | 46 | 1; 47 | __END__ 48 | -------------------------------------------------------------------------------- /lib/Blawd/Cmd/Container.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Cmd::Container; 2 | use Blawd::OO; 3 | use Bread::Board; 4 | use List::MoreUtils qw(uniq); 5 | 6 | has storage => ( 7 | is => 'ro', 8 | does => 'Blawd::Storage::API', 9 | required => 1, 10 | ); 11 | 12 | sub build_app { 13 | my ($self) = @_; 14 | 15 | my $cfg = $self->storage->config; 16 | 17 | my $c = container Blawd => as { 18 | 19 | service title => ($cfg->get(key => 'blawd.title') || 'Blawd'); 20 | service base_uri => 21 | ($cfg->get(key => 'blawd.baseuri') || 'http://localhost/'); 22 | 23 | service app => ( 24 | class => 'Blawd', 25 | lifecycle => 'Singleton', 26 | dependencies => [ 27 | depends_on('indexes'), depends_on('entries'), 28 | depends_on('renderers'), 29 | ], 30 | ); 31 | 32 | service entries => ( 33 | block => sub { 34 | [ 35 | sort { $b->date <=> $a->date } 36 | map { Blawd::Entry->create_entry(%$_) } 37 | $self->storage->find_entries 38 | ]; 39 | }, 40 | ); 41 | 42 | service tags => ( 43 | block => sub { 44 | [ uniq map { @{ $_->tags } } @{ $_[0]->param('entries') } ]; 45 | }, 46 | dependencies => [ depends_on('entries') ], 47 | ); 48 | service renderers => ( 49 | block => sub { 50 | require Blawd::Renderer; 51 | 52 | my %renderer_args = ( 53 | HTML => { 54 | headers => $cfg->get(key => 'blawd.headers') // '', 55 | body_header => $cfg->get(key => 'blawd.bodyheader') 56 | // '', 57 | body_footer => $cfg->get(key => 'blawd.bodyfooter') 58 | // '', 59 | }, 60 | ); 61 | 62 | return [ 63 | map { 64 | my ($type) = /::(\w+)$/; 65 | $_->new( 66 | base_uri => $_[0]->param('base_uri'), 67 | %{ $renderer_args{$type} || {} } 68 | ) 69 | } Blawd::Renderer->renderers 70 | ]; 71 | }, 72 | dependencies => [ depends_on('base_uri') ], 73 | ); 74 | service indexes => ( 75 | block => sub { 76 | require Blawd::Index; 77 | require Blawd::Archive; 78 | my @entries = @{ $_[0]->param('entries') }; 79 | my $entries_per_pages = 80 | $cfg->get(key => 'blawd.entriesperpages') || 10; 81 | 82 | @entries = @entries[0 .. ($entries_per_pages - 1)] 83 | if @entries > $entries_per_pages; 84 | 85 | my %common = ( 86 | title => $_[0]->param('title'), 87 | entries => \@entries, 88 | ); 89 | 90 | return [ 91 | Blawd::Index->new( 92 | filename => 'index', 93 | headers => $_[0]->param('headers'), 94 | %common, 95 | ), 96 | Blawd::Archive->new( 97 | filename => 'archives', 98 | title => 'Archives', 99 | entries => $_[0]->param('entries'), 100 | ), 101 | map { 102 | my $tag = $_; 103 | Blawd::Index->new( 104 | filename => $tag, 105 | title => $_[0]->param('title') . ': ' . $tag, 106 | entries => [ 107 | grep { $_->has_tag($tag) } 108 | @{ $_[0]->param('entries') } 109 | ], 110 | ) 111 | } @{ $_[0]->param('tags') }, 112 | ]; 113 | }, 114 | dependencies => [ 115 | depends_on('title'), depends_on('entries'), depends_on('tags'), 116 | ] 117 | ); 118 | }; 119 | return $c->fetch('app')->get; 120 | } 121 | 122 | 1; 123 | __END__ 124 | -------------------------------------------------------------------------------- /lib/Blawd/Entry.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Entry; 2 | use Module::Pluggable ( 3 | require => 1, 4 | sub_name => 'entry_classes', 5 | search_path => [__PACKAGE__], 6 | except => qr/Meta|Role|API/, 7 | ); 8 | 9 | sub determine_entry_class { 10 | my $class = shift; 11 | 12 | for my $entry_class ($class->entry_classes) { 13 | return $entry_class if $entry_class->is_valid_file(@_); 14 | } 15 | return; 16 | } 17 | 18 | sub create_entry { 19 | my $class = shift; 20 | my %options = @_; 21 | 22 | my $entry_class = $class->determine_entry_class(%options); 23 | die "Could not determine the proper entry class for " . $options{filename} 24 | . " (tried " . join(', ', $class->entry_classes) . ")" 25 | unless defined($entry_class); 26 | return $entry_class->new(%options); 27 | } 28 | 29 | 1; 30 | __END__ 31 | -------------------------------------------------------------------------------- /lib/Blawd/Entry/API.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Entry::API; 2 | use Blawd::OO::Role; 3 | use MooseX::Types::DateTime qw(DateTime); 4 | use List::MoreUtils qw(any); 5 | 6 | with qw( Blawd::Renderable ); 7 | 8 | has storage_author => ( 9 | isa => 'Str', 10 | is => 'ro', 11 | ); 12 | 13 | has author => ( 14 | isa => 'Str', 15 | is => 'ro', 16 | lazy_build => 1, 17 | ); 18 | 19 | has storage_date => ( 20 | isa => DateTime, 21 | is => 'ro', 22 | coerce => 1, 23 | ); 24 | 25 | has date => ( 26 | isa => DateTime, 27 | is => 'ro', 28 | coerce => 1, 29 | lazy_build => 1 30 | ); 31 | 32 | has content => ( 33 | isa => 'Str', 34 | is => 'ro', 35 | required => 1, 36 | ); 37 | 38 | has body => ( 39 | isa => 'Str', 40 | is => 'ro', 41 | lazy_build => 1, 42 | ); 43 | 44 | has tags => ( 45 | isa => 'ArrayRef[Str]', 46 | is => 'ro', 47 | lazy_build => 1, 48 | ); 49 | 50 | requires qw( 51 | _build_author 52 | _build_date 53 | _build_tags 54 | is_valid_file 55 | ); 56 | 57 | sub _build_body { shift->content } 58 | 59 | sub has_tag { 60 | my $self = shift; 61 | my ($tag) = @_; 62 | return any { $_ eq $tag } @{ $self->tags }; 63 | } 64 | 65 | sub render_page_default { shift->body } 66 | sub render_fragment_default { shift->body } 67 | 68 | 1; 69 | __END__ 70 | -------------------------------------------------------------------------------- /lib/Blawd/Entry/HTML.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Entry::HTML; 2 | use Blawd::OO; 3 | 4 | # XXX: eventually use an html parser to parse this stuff out 5 | sub _build_date { $_[0]->storage_date } 6 | sub _build_author { $_[0]->storage_author } 7 | sub _build_title { '' } 8 | sub _build_tags { [] } 9 | 10 | sub _build_body { $_[0]->content } 11 | 12 | sub render_page_HTML { 13 | my $self = shift; 14 | my ($renderer) = @_; 15 | # XXX: should be able to hook into this to add comments, etc 16 | return '
' . "\n" 17 | . $self->render_fragment_HTML($renderer) 18 | . '
' . "\n"; 19 | } 20 | 21 | sub render_fragment_HTML { 22 | my $self = shift; 23 | my ($renderer) = @_; 24 | return '
' . "\n" 25 | . $self->content . "\n" 26 | . "

By: ${\$self->author} on ${\$self->date}

\n" 27 | . "

Tags: " . join(' ', map { 28 | qq[$_] 29 | } @{ $self->tags }) . '

' . "\n" 30 | . '
' . "\n"; 31 | } 32 | 33 | sub is_valid_file { 34 | my $class = shift; 35 | my %options = @_; 36 | return 1 if $options{filename} =~ /\.html?$/; 37 | return 0; 38 | } 39 | 40 | with qw(Blawd::Entry::API); 41 | 42 | __PACKAGE__->meta->make_immutable; 43 | 1; 44 | __END__ 45 | -------------------------------------------------------------------------------- /lib/Blawd/Entry/MultiMarkdown.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Entry::MultiMarkdown; 2 | use Blawd::OO; 3 | use MooseX::Types::DateTime::MoreCoercions qw(DateTime); 4 | use Text::MultiMarkdown (); 5 | use URI::Escape; 6 | 7 | has markdown_instance => ( 8 | isa => 'Text::MultiMarkdown', 9 | is => 'ro', 10 | lazy_build => 1, 11 | handles => [qw(markdown)], 12 | ); 13 | 14 | sub _build_markdown_instance { 15 | Text::MultiMarkdown->new( 16 | document_format => 1, 17 | use_metadata => 1, 18 | strip_metadata => 1, 19 | ); 20 | } 21 | 22 | sub _build_date { 23 | my $c = $_[0]->content; 24 | $c =~ m/^Date:\s+(.*)/m; 25 | return to_DateTime($1) if $1; 26 | return $_[0]->storage_date; 27 | } 28 | 29 | sub _build_author { 30 | $_[0]->content =~ /^Author: (.*)\s*$/m; 31 | return $1 if $1; 32 | return $_[0]->storage_author; 33 | } 34 | 35 | sub _build_title { 36 | $_[0]->content =~ /^Title: (.*)\s*$/m; 37 | return $1 if $1; 38 | return ''; 39 | } 40 | 41 | sub _build_tags { 42 | my $self = shift; 43 | my $content = $self->content; 44 | 45 | return [] unless $content =~ /^Tags: (.*)\s*$/m; 46 | my $tags = $1; 47 | 48 | if ($tags =~ /,/) { 49 | # Comma-based tags 50 | return [ split /\s*,\s*+/, $tags ]; 51 | } else { 52 | return [ split ' ', $tags ]; 53 | } 54 | } 55 | 56 | sub _build_body { 57 | my $self = shift; 58 | my $content = $self->content; 59 | if ((split(/\n/, $content))[0] =~ /^\w+:/) { 60 | $content =~ s/^.*?\n\n//s; 61 | } 62 | return $content; 63 | } 64 | 65 | sub _build_permalink { 66 | my ($self, $renderer) = @_; 67 | my $link = uri_escape($_[0]->filename_base); 68 | qq[permalink]; 69 | } 70 | 71 | sub render_page_HTML { 72 | my $self = shift; 73 | my ($renderer) = @_; 74 | # XXX: should be able to hook into this to add comments, etc 75 | return '
' . "\n" 76 | . $self->render_fragment_HTML($renderer) 77 | . '
' . "\n"; 78 | } 79 | 80 | sub render_fragment_HTML { 81 | my $self = shift; 82 | my ($renderer) = @_; 83 | my $content = $self->content . "\n"; 84 | $content .= "By: ${\$self->author} on ${\$self->date}\n\n"; 85 | $content .= "Tags: " . join ' ', 86 | map { "[$_](" . $renderer->base_uri . $_ . $renderer->extension . ')' } 87 | @{ $self->tags }; 88 | $content .= "\n\n"; 89 | $content .= $self->_build_permalink($renderer); 90 | $content .= "\n"; 91 | return '
' . $self->markdown($content) . '
'; 92 | } 93 | 94 | sub is_valid_file { 95 | my $class = shift; 96 | my (%options) = @_; 97 | return 1 if $options{filename} =~ /\.md(?:wn)?$/; 98 | return 0; 99 | } 100 | 101 | with qw(Blawd::Entry::API); 102 | 103 | __PACKAGE__->meta->make_immutable; 104 | 1; 105 | __END__ 106 | -------------------------------------------------------------------------------- /lib/Blawd/Entry/Text.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Entry::Text; 2 | use Blawd::OO; 3 | 4 | sub _build_date { $_[0]->storage_date } 5 | sub _build_author { $_[0]->storage_author } 6 | sub _build_title { '' } 7 | sub _build_tags { [] } 8 | 9 | sub _build_body { $_[0]->content } 10 | 11 | sub render_page_HTML { 12 | my $self = shift; 13 | my ($renderer) = @_; 14 | # XXX: should be able to hook into this to add comments, etc 15 | return '
' . "\n" 16 | . $self->render_fragment_HTML($renderer) 17 | . '
' . "\n"; 18 | } 19 | 20 | sub render_fragment_HTML { 21 | my $self = shift; 22 | my ($renderer) = @_; 23 | my $content = $self->content; 24 | # XXX: use a real html escaper here or something 25 | $content =~ s/\&/\&/g; 26 | $content =~ s/' . "\n" 28 | . '
' . "\n"
29 |          . $content . "\n"
30 |          . '
' . "\n" 31 | . "

By: ${\$self->author} on ${\$self->date}

\n" 32 | . "

Tags: " . join(' ', map { 33 | qq[$_] 34 | } @{ $self->tags }) . '

' . "\n" 35 | . '' . "\n"; 36 | } 37 | 38 | sub is_valid_file { 39 | my $class = shift; 40 | my %options = @_; 41 | return 1 if $options{filename} =~ /\.txt$/; 42 | return 1 if $options{filename} !~ /\./; 43 | return 0; 44 | } 45 | 46 | with qw(Blawd::Entry::API); 47 | 48 | __PACKAGE__->meta->make_immutable; 49 | 1; 50 | __END__ 51 | -------------------------------------------------------------------------------- /lib/Blawd/Exporter.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Exporter; 2 | 3 | use Blawd::OO::Role; 4 | 5 | use Path::Class; 6 | use Git::Wrapper; 7 | 8 | requires qw/abstract/; 9 | 10 | has author => (isa => 'Str', is => 'ro',); 11 | has git => (isa => 'Git::Wrapper', is => 'ro', lazy_build => 1,); 12 | has repo => ( 13 | isa => 'Str', 14 | is => 'ro', 15 | coerce => 1, 16 | required => 1 17 | ); 18 | 19 | sub _build_git { 20 | my $self = shift; 21 | Git::Wrapper->new($self->repo); 22 | } 23 | 24 | before execute => sub { 25 | my $self = shift; 26 | unless (-d $self->repo) { 27 | dir($self->repo)->mkpath; 28 | $self->git->init; 29 | } 30 | }; 31 | 32 | after execute => sub { 33 | my $self = shift; 34 | $self->git->commit( { message => "import blog" } ); 35 | }; 36 | 37 | 1; 38 | __END__ 39 | -------------------------------------------------------------------------------- /lib/Blawd/Exporter/DB.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Exporter::DB; 2 | 3 | use Blawd::OO::Role; 4 | use DBI; 5 | 6 | has entry_query => ( 7 | isa => 'Str', 8 | is => 'ro', 9 | lazy_build => 1, 10 | ); 11 | 12 | has [qw(db host port user pass)] => 13 | ( isa => 'Str', is => 'ro', lazy_build => 1 ); 14 | sub _build_db { '' } 15 | sub _build_host { '127.0.01' } 16 | sub _build_port { 3306 } 17 | sub _build_user { $ENV{USER} } 18 | sub _build_pass {''} 19 | 20 | requires qw/_build_entry_query dsn/; 21 | 22 | has dbi => ( 23 | is => 'ro', 24 | traits => ['NoGetopt'], 25 | lazy_build => 1, 26 | ); 27 | 28 | sub _build_dbi { 29 | my ($self) = @_; 30 | DBI->connect($self->dsn, $self->user, $self->pass); 31 | } 32 | 33 | 1; 34 | __END__ 35 | -------------------------------------------------------------------------------- /lib/Blawd/Index.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Index; 2 | use Blawd::OO; 3 | 4 | has entries => ( 5 | isa => 'ArrayRef[Object]', 6 | traits => ['Array'], 7 | required => 1, 8 | handles => { 9 | entries => 'elements', 10 | size => 'count', 11 | }, 12 | ); 13 | 14 | sub _build_title { shift->filename_base } 15 | 16 | sub render_page_default { 17 | my $self = shift; 18 | my ($renderer) = @_; 19 | return $self->render_fragment($renderer); 20 | } 21 | 22 | sub render_fragment_default { 23 | my $self = shift; 24 | my ($renderer) = @_; 25 | return join "\n\n", map { $_->render_fragment($renderer) } $self->entries; 26 | } 27 | 28 | sub render_page_HTML { 29 | my $self = shift; 30 | my ($renderer) = @_; 31 | return $self->render_fragment_HTML($renderer); 32 | } 33 | 34 | sub render_fragment_HTML { 35 | my $self = shift; 36 | my ($renderer) = @_; 37 | return '
' . "\n" 38 | . (join "\n", map { $_->render_fragment($renderer) } $self->entries) 39 | . '
' . "\n"; 40 | } 41 | 42 | with qw(Blawd::Renderable); 43 | 44 | __PACKAGE__->meta->make_immutable; 45 | 1; 46 | __END__ 47 | 48 | =head1 NAME 49 | 50 | Blawd::Index 51 | 52 | =head1 SYNOPSIS 53 | 54 | Blawd::Index->new( 55 | title => $self->title, 56 | filename => 'index', 57 | headers => $self->headers, 58 | entries => $self->entries 59 | ), 60 | 61 | =head1 DESCRIPTION 62 | 63 | The Blawd::Index class implements indexes of Entries in a Blawd blog. 64 | 65 | =head1 PRIVATE METHODS 66 | 67 | =head2 _build_renderer 68 | 69 | =head2 _build_author 70 | 71 | =head2 _build_date 72 | 73 | =head2 _build_content 74 | 75 | =head2 _build_title 76 | 77 | =head1 AUTHOR 78 | 79 | Chris Prather (chris@prather.org) 80 | 81 | =head1 LICENCE 82 | 83 | Copyright 2009 by Chris Prather. 84 | 85 | This software is free. It is licensed under the same terms as Perl itself. 86 | 87 | =cut 88 | -------------------------------------------------------------------------------- /lib/Blawd/OO.pm: -------------------------------------------------------------------------------- 1 | package Blawd::OO; 2 | use Moose::Exporter; 3 | use 5.010; 4 | use Moose 0.92 (); 5 | use MooseX::Aliases (); 6 | use namespace::autoclean (); 7 | 8 | my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( 9 | also => [qw(Moose MooseX::Aliases)], 10 | ); 11 | 12 | sub import { 13 | my ($package) = @_; 14 | my $caller = caller; 15 | namespace::autoclean->import( 16 | -cleanee => $caller, 17 | ); 18 | feature->import(':5.10'); 19 | goto $import; 20 | } 21 | 22 | sub unimport { 23 | warn "'no " . __PACKAGE__ . "' is unnecessary"; 24 | goto $unimport; 25 | } 26 | 27 | sub init_meta { 28 | my ($package, %opts) = @_; 29 | Moose->init_meta(%opts); 30 | goto $init_meta if $init_meta; 31 | return Class::MOP::class_of($opts{for_class}); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/Blawd/OO/Role.pm: -------------------------------------------------------------------------------- 1 | package Blawd::OO::Role; 2 | use Moose::Exporter; 3 | use 5.010; 4 | use Moose::Role 0.92 (); 5 | use MooseX::Aliases (); 6 | use namespace::autoclean (); 7 | 8 | my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( 9 | also => [qw(Moose::Role MooseX::Aliases)], 10 | ); 11 | 12 | sub import { 13 | my ($package) = @_; 14 | my $caller = caller; 15 | namespace::autoclean->import( 16 | -cleanee => $caller, 17 | ); 18 | feature->import(':5.10'); 19 | goto $import; 20 | } 21 | 22 | sub unimport { 23 | warn "'no " . __PACKAGE__ . "' is unnecessary"; 24 | goto $unimport; 25 | } 26 | 27 | sub init_meta { 28 | my ($package, %opts) = @_; 29 | Moose::Role->init_meta(%opts); 30 | goto $init_meta if $init_meta; 31 | return Class::MOP::class_of($opts{for_class}); 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/Blawd/Renderable.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderable; 2 | use Blawd::OO::Role; 3 | 4 | has title => ( 5 | isa => 'Str', 6 | is => 'ro', 7 | lazy_build => 1, 8 | ); 9 | 10 | has filename => ( isa => 'Str', is => 'ro', required => 1, ); 11 | has filename_base => ( isa => 'Str', is => 'ro', lazy_build => 1, ); 12 | sub _build_filename_base { 13 | my $self = shift; 14 | my $filename = $self->filename; 15 | $filename =~ s/\.\w+?$//; 16 | return $filename; 17 | } 18 | has extension => ( isa => 'Str', is => 'ro', lazy_build => 1, ); 19 | sub _build_extension { 20 | my $self = shift; 21 | my $filename = $self->filename; 22 | $filename =~ /\.(\w+?)$/; 23 | return $1; 24 | } 25 | 26 | requires qw(_build_title render_page_default render_fragment_default); 27 | 28 | sub render_page { 29 | my $self = shift; 30 | my ($renderer) = @_; 31 | confess "no renderer" unless defined $renderer; 32 | (my $renderer_type = blessed($renderer)) =~ s/.*:://; 33 | my $method = "render_page_$renderer_type"; 34 | if ($self->can($method)) { 35 | return $self->$method($renderer); 36 | } 37 | return $self->render_page_default; 38 | } 39 | 40 | sub render_fragment { 41 | my $self = shift; 42 | my ($renderer) = @_; 43 | confess "no renderer" unless defined $renderer; 44 | (my $renderer_type = blessed($renderer)) =~ s/.*:://; 45 | my $method = "render_fragment_$renderer_type"; 46 | if ($self->can($method)) { 47 | return $self->$method($renderer); 48 | } 49 | return $self->render_fragment_default($renderer); 50 | } 51 | 52 | 1; 53 | __END__ 54 | 55 | =head1 NAME 56 | 57 | Blawd::Renderable 58 | 59 | =head1 SYNOPSIS 60 | 61 | use Blawd::Renderable; 62 | 63 | =head1 DESCRIPTION 64 | 65 | The Blawd::Renderable class implements ... 66 | 67 | =head1 METHODS 68 | 69 | =head2 _build__renderer_instance () 70 | 71 | =head2 link () 72 | 73 | Generate a link to the given Index or Entry. 74 | 75 | =head2 render () 76 | 77 | Render the given Index or Entry into a full HTML document using the C. 78 | 79 | =head2 render_as_fragment () 80 | 81 | Render the given Index or Entry into an HTML fragment using the C. 82 | 83 | =head2 render_to_file (Str $file) 84 | 85 | Render the given Index or Entry into a full HTML document using the 86 | C. Store that document in C<$file>. 87 | 88 | =head1 AUTHOR 89 | 90 | Chris Prather (chris@prather.org) 91 | 92 | =head1 LICENCE 93 | 94 | Copyright 2009 by Chris Prather. 95 | 96 | This software is free. It is licensed under the same terms as Perl itself. 97 | 98 | =cut 99 | -------------------------------------------------------------------------------- /lib/Blawd/Renderer.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderer; 2 | use Module::Pluggable ( 3 | require => 1, 4 | sub_name => 'renderers', 5 | search_path => [__PACKAGE__], 6 | except => qr/Meta|Role|API/, 7 | ); 8 | 9 | 1; 10 | -------------------------------------------------------------------------------- /lib/Blawd/Renderer/API.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderer::API; 2 | use Blawd::OO::Role; 3 | use MooseX::Types::Path::Class qw(File); 4 | 5 | requires qw(render_page extension); 6 | 7 | has base_uri => ( isa => 'Str', is => 'ro', default => '/' ); 8 | 9 | sub render_fragment { shift->render_page(@_) } 10 | 11 | sub render_to_file { 12 | my ( $s, $f, @a ) = @_; 13 | to_File($f)->openw->print( $s->render_page(@a) ); 14 | } 15 | 16 | 1; 17 | __END__ 18 | -------------------------------------------------------------------------------- /lib/Blawd/Renderer/Atom.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderer::Atom; 2 | use Blawd::OO; 3 | use XML::RSS; 4 | with qw(Blawd::Renderer::API); 5 | 6 | use aliased 'XML::Atom::Feed'; 7 | use aliased 'XML::Atom::Entry'; 8 | 9 | sub extension { '.atom' } 10 | 11 | has atom => ( 12 | isa => 'XML::Atom::Feed', 13 | is => 'ro', 14 | lazy_build => 1, 15 | handles => { 16 | feed_title => 'title', 17 | feed_id => 'id', 18 | add_entry => 'add_entry', 19 | feed_as_xml => 'as_xml', 20 | } 21 | ); 22 | 23 | sub _build_atom { Feed->new( Version => 1.0 ) } 24 | 25 | sub render_page { 26 | my ( $self, $index ) = @_; 27 | # if we have multiple actual content renderers, how do we choose which 28 | # one is 'canonical', to point this link to? just hardcoding html for 29 | # now, but this should probably be configurable or something 30 | my $extension = '.html'; 31 | $self->feed_title( $index->title ); 32 | $self->feed_id( $self->base_uri . $index->filename_base . $extension ); 33 | for my $post ( $index->entries ) { 34 | my $entry = Entry->new( Version => 1.0 ); 35 | $entry->title( $post->title ); 36 | $entry->id( $self->base_uri . $post->filename_base . $extension ); 37 | $entry->content( $post->render_fragment($self) ); 38 | $self->add_entry($entry); 39 | } 40 | return $self->feed_as_xml; 41 | } 42 | 43 | __PACKAGE__->meta->make_immutable; 44 | 1; 45 | __END__ 46 | -------------------------------------------------------------------------------- /lib/Blawd/Renderer/HTML.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderer::HTML; 2 | use Blawd::OO; 3 | 4 | with qw(Blawd::Renderer::API); 5 | 6 | sub extension { '.html' } 7 | 8 | has css => ( isa => 'Str', is => 'ro', default => 'site.css' ); 9 | 10 | has headers => ( isa => 'Str', is => 'ro', default => '' ); 11 | has body_header => ( isa => 'Str', is => 'ro', default => '' ); 12 | has body_footer => ( isa => 'Str', is => 'ro', default => '' ); 13 | 14 | sub render_page { 15 | my ( $self, $renderable ) = @_; 16 | my $css = $self->css; 17 | my $headers = $self->headers // ''; 18 | my $body_header = $self->body_header // ''; 19 | my $body_footer = $self->body_footer // ''; 20 | 21 | # XXX: need to figure out how to separate the rss/atom stuff out from here 22 | # this is a pretty big hack 23 | my $filename_base = $renderable->filename_base; 24 | if ($renderable->isa('Blawd::Index')) { 25 | $headers .= < 27 | 28 | HEADERS 29 | } 30 | 31 | my $content = < 33 | 34 | 35 | 36 | 37 | $headers 38 | 39 | 40 | $body_header 41 | PAGE_HEADER 42 | 43 | if ( $renderable->can('render_page_HTML') ) { 44 | $content .= $renderable->render_page_HTML($self); 45 | } 46 | else { 47 | $content .= $renderable->render_page($self); 48 | } 49 | 50 | $content .= < 52 | $body_footer 53 | 54 | 55 | 56 | PAGE_FOOTER 57 | 58 | return $content; 59 | } 60 | 61 | sub render_fragment { 62 | my ( $self, $renderable ) = @_; 63 | if ( $renderable->can('render_fragment_HTML') ) { 64 | return $renderable->render_fragment_HTML($self); 65 | } 66 | else { 67 | return $renderable->render_fragment($self); 68 | } 69 | } 70 | 71 | __PACKAGE__->meta->make_immutable; 72 | 1; 73 | __END__ 74 | 75 | =head1 NAME 76 | 77 | Blawd::Renderer::MultiMarkdown 78 | 79 | =head1 SYNOPSIS 80 | 81 | use Blawd::Renderer::MultiMarkdown; 82 | 83 | =head1 DESCRIPTION 84 | 85 | The Blawd::Renderer::MultiMarkdown class implements conversions from 86 | MultiMarkdown to HTML for Blawd entries. 87 | 88 | =head1 METHODS 89 | 90 | =head2 render (Blawd::Entry::MultiMarkdown $entry) 91 | 92 | Render C<$entry> to a full HTML page. 93 | 94 | =head2 render_as_fragment (Blawd::Entry::MultiMarkdown $entry) 95 | 96 | Render C<$entry> to an HTML fragment. 97 | 98 | =head1 PRIVATE METHODS 99 | 100 | =head2 _build_markdown_instance 101 | 102 | =head1 AUTHOR 103 | 104 | Chris Prather (chris@prather.org) 105 | 106 | =head1 LICENCE 107 | 108 | Copyright 2009 by Chris Prather. 109 | 110 | This software is free. It is licensed under the same terms as Perl itself. 111 | 112 | =cut 113 | -------------------------------------------------------------------------------- /lib/Blawd/Renderer/RSS.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Renderer::RSS; 2 | use Blawd::OO; 3 | use XML::RSS; 4 | with qw(Blawd::Renderer::API); 5 | 6 | sub extension { '.rss' } 7 | 8 | has rss => ( 9 | isa => 'XML::RSS', 10 | is => 'ro', 11 | lazy_build => 1, 12 | ); 13 | 14 | sub _build_rss { XML::RSS->new( version => '1.0' ) } 15 | 16 | sub render_page { 17 | my ( $self, $index ) = @_; 18 | 19 | # if we have multiple actual content renderers, how do we choose which 20 | # one is 'canonical', to point this link to? just hardcoding html for 21 | # now, but this should probably be configurable or something 22 | my $extension = '.html'; 23 | $self->rss->channel( 24 | title => $index->title, 25 | link => $self->base_uri . $index->filename_base . $extension, 26 | ); 27 | for my $entry ( $index->entries ) { 28 | $self->rss->add_item( 29 | title => $entry->title, 30 | link => $self->base_uri . $entry->filename_base . $extension, 31 | description => $entry->render_fragment($self), 32 | dc => { 33 | date => $entry->date . 'Z', 34 | author => $entry->author, 35 | } 36 | ); 37 | } 38 | return $self->rss->as_string; 39 | } 40 | 41 | __PACKAGE__->meta->make_immutable; 42 | 1; 43 | __END__ 44 | 45 | =head1 NAME 46 | 47 | Blawd::Renderer::RSS - A class to render Blawd::Indexes as RSS 48 | 49 | =head1 SYNOPSIS 50 | 51 | use Blawd::Renderer::RSS; 52 | 53 | =head1 DESCRIPTION 54 | 55 | The Blawd::Renderer::RSS class implements a renderer for RSS. 56 | 57 | =head1 METHODS 58 | 59 | =head2 render_as_fragment (Blawd::Index $index) 60 | 61 | Render an Index as RSS 62 | 63 | =head2 render (Blawd::Index $index) 64 | 65 | Render an Index as RSS 66 | 67 | =head1 PRIVATE METHODS 68 | 69 | =head2 _build_rss 70 | 71 | =head1 AUTHOR 72 | 73 | Chris Prather (chris@prather.org) 74 | 75 | =head1 LICENCE 76 | 77 | Copyright 2009 by Chris Prather. 78 | 79 | This software is free. It is licensed under the same terms as Perl itself. 80 | 81 | =cut 82 | -------------------------------------------------------------------------------- /lib/Blawd/Storage.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Storage; 2 | use Module::Pluggable ( 3 | require => 1, 4 | sub_name => 'storage_classes', 5 | search_path => [__PACKAGE__], 6 | except => qr/Meta|Role|API/, 7 | ); 8 | 9 | sub determine_storage_class { 10 | my $class = shift; 11 | 12 | for my $storage_class ($class->storage_classes) { 13 | return $storage_class if $storage_class->is_valid_location(@_); 14 | } 15 | return; 16 | } 17 | 18 | sub create_storage { 19 | my $class = shift; 20 | my ($location) = @_; 21 | 22 | my $storage_class = $class->determine_storage_class($location); 23 | die "Could not determine the proper storage class for " . $location 24 | . " (tried " . join(', ', $class->storage_classes) . ")" 25 | unless defined($storage_class); 26 | return $storage_class->new(location => $location); 27 | } 28 | 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/Blawd/Storage/API.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Storage::API; 2 | use Blawd::OO::Role; 3 | 4 | use Scalar::Util qw(reftype); 5 | use Blawd::Entry; 6 | 7 | requires qw(find_entries is_valid_location config); 8 | 9 | has location => ( 10 | isa => 'Str', 11 | is => 'ro', 12 | required => 1, 13 | ); 14 | 15 | sub new_entry { shift; return {@_} } 16 | 17 | 1; 18 | __END__ 19 | 20 | =head1 NAME 21 | 22 | Blawd::Storage::API - A interface for Blawd Storage Classes 23 | 24 | =head1 SYNOPSIS 25 | 26 | package Blawd::Storage::Git; 27 | use Moose; 28 | with qw(Blawd::Storage::API); 29 | 30 | =head1 DESCRIPTION 31 | 32 | The Blawd::Storage::API Role implements an interface for Blawd Storage 33 | Classes 34 | 35 | =head1 METHODS 36 | 37 | =head2 default_entry_class 38 | 39 | Default entry storage type. Currently defaults to 40 | L. 41 | 42 | =head2 new_entry 43 | 44 | Creates a new entry instance based on the class name in 45 | C. 46 | 47 | =head1 AUTHOR 48 | 49 | Chris Prather (chris@prather.org) 50 | 51 | =head1 LICENCE 52 | 53 | Copyright 2009 by Chris Prather. 54 | 55 | This software is free. It is licensed under the same terms as Perl itself. 56 | 57 | =cut 58 | -------------------------------------------------------------------------------- /lib/Blawd/Storage/Directory.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Storage::Directory; 2 | use Blawd::OO; 3 | 4 | use Config::GitLike; 5 | use File::Spec; 6 | 7 | has config => ( 8 | is => 'rw', 9 | isa => 'Config::GitLike', 10 | lazy => 1, 11 | default => sub { 12 | my $self = shift; 13 | my $config_file = File::Spec->catfile( $self->location, '.blawd' ); 14 | if ( -r $config_file ) { 15 | my $c = Config::GitLike->new( confname => $config_file ); 16 | return $c; 17 | } 18 | else { 19 | confess('an alternative to a .blawd file is not yet supported'); 20 | } 21 | } 22 | ); 23 | 24 | with qw(Blawd::Storage::API); 25 | 26 | sub _slurp { 27 | my $self = shift; 28 | my ($file) = @_; 29 | open my $fh, '<', $file; 30 | local $/; 31 | return scalar <$fh>; 32 | } 33 | 34 | sub find_entries { 35 | my $self = shift; 36 | my $dir = $self->location; 37 | 38 | my @output; 39 | 40 | # glob('*') doesn't include dotfiles 41 | for my $file ( glob( File::Spec->catfile( $dir, '*' ) ) ) { 42 | next unless -r $file; 43 | my @stat = stat($file); 44 | my ( $uid, $mtime ) = ( $stat[4], $stat[9] ); 45 | my @userdata = getpwuid($uid); 46 | my ( $user, $gcos ) = ( $userdata[0], $userdata[6] ); 47 | $gcos =~ s/,.*//; 48 | 49 | push @output, 50 | $self->new_entry( 51 | content => $self->_slurp($file), 52 | filename => File::Spec->abs2rel( $file, $dir ), 53 | storage_author => $gcos // $user, 54 | storage_date => $mtime, 55 | ); 56 | } 57 | 58 | return @output; 59 | } 60 | 61 | sub is_valid_location { 62 | my $class = shift; 63 | my ($location) = @_; 64 | return -d $location && -r File::Spec->catfile( $location, '.blawd' ); 65 | } 66 | 67 | __PACKAGE__->meta->make_immutable; 68 | 69 | 1; 70 | -------------------------------------------------------------------------------- /lib/Blawd/Storage/Git.pm: -------------------------------------------------------------------------------- 1 | package Blawd::Storage::Git; 2 | use Blawd::OO; 3 | 4 | use Git::PurePerl; 5 | use Try::Tiny; 6 | 7 | has git => ( 8 | is => 'ro', 9 | isa => 'Git::PurePerl', 10 | lazy => 1, 11 | default => sub { Git::PurePerl->new(gitdir => shift->location) }, 12 | handles => qr/.*/, 13 | ); 14 | 15 | with qw(Blawd::Storage::API); 16 | 17 | sub blawd_branch { return shift->master } # 'master' should be set by a config setting 18 | 19 | sub find_entries { 20 | my ($self) = @_; 21 | 22 | my $commit = $self->master; 23 | my $tree = $commit->tree; 24 | 25 | my @output; 26 | for my $entry ( $tree->directory_entries ) { 27 | given ( $entry->object ) { 28 | when ( $_->kind eq 'blob' ) { 29 | push @output, 30 | $self->new_entry( 31 | content => $_->content, 32 | filename => $entry->filename, 33 | storage_author => $commit->author->name, 34 | storage_date => $commit->committed_time, 35 | ) unless $entry->filename =~ /^\./; 36 | } 37 | } 38 | } 39 | return @output; 40 | } 41 | 42 | sub is_valid_location { 43 | my $class = shift; 44 | my ($location) = shift; 45 | 46 | my $valid = 1; 47 | try { 48 | my $git = Git::PurePerl->new(gitdir => $location); 49 | $git->all_objects; 50 | } 51 | catch { 52 | $valid = 0; 53 | }; 54 | 55 | return $valid; 56 | } 57 | 58 | __PACKAGE__->meta->make_immutable; 59 | 1; 60 | __END__ 61 | 62 | =head1 NAME 63 | 64 | Blawd::Storage::Git - use Git as storage for Blawd blogs. 65 | 66 | =head1 VERSION 67 | 68 | This documentation refers to version 0.01. 69 | 70 | =head1 SYNOPSIS 71 | 72 | use Blawd::Storage::Git; 73 | 74 | =head1 DESCRIPTION 75 | 76 | The Blawd::Storage::Git class implements ... 77 | 78 | =head1 METHODS 79 | 80 | =head2 find_entries (Git::PurePerl::Object::Commit $commit) 81 | 82 | Find all the entries in a given commit. 83 | 84 | =head2 blawd_branch 85 | 86 | The Branch that this Blawd instance renders from. 87 | 88 | =head1 BUGS AND LIMITATIONS 89 | 90 | None known currently, please email the author if you find any. 91 | 92 | =head1 AUTHOR 93 | 94 | Chris Prather (chris@prather.org) 95 | 96 | =head1 LICENCE 97 | 98 | Copyright 2009 by Chris Prather. 99 | 100 | This software is free. It is licensed under the same terms as Perl itself. 101 | 102 | =cut 103 | -------------------------------------------------------------------------------- /t/01.basic.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use Test::More; 4 | use Test::Deep; 5 | 6 | use Try::Tiny; 7 | use Path::Class; 8 | use Blawd; 9 | 10 | use aliased 'Blawd::Cmd::Container'; 11 | use aliased 'Blawd::Storage'; 12 | 13 | BEGIN { 14 | try { use Git::Wrapper } 15 | catch { plan skip_all => 'Tests Require Git::Wrapper ' }; 16 | } 17 | 18 | my $directory = 'my-blog'; 19 | dir($directory)->rmtree; 20 | dir($directory)->mkpath; 21 | 22 | my $g = Git::Wrapper->new($directory); 23 | $g->init; 24 | 25 | my $hello = dir($directory)->file('hello'); 26 | $hello->openw->print('Hello World'); 27 | $g->add('hello'); 28 | my $cfg = dir($directory)->file('.blawd'); 29 | $cfg->openw->print("---\ntitle: Blawd\n"); 30 | $g->add('.blawd'); 31 | $g->commit( { message => 'first post' } ); 32 | 33 | my $storage = Storage->create_storage("$directory/.git"); 34 | ok( my $blog = Container->new( storage => $storage )->build_app ); 35 | 36 | ok( my @entries = $blog->entries, 'got entries' ); 37 | is( @entries, 1, 'only one entry' ); 38 | 39 | ok( $_->does('Blawd::Entry::API'), 'does Blawd::Entry::API' ) for @entries; 40 | is( 41 | $entries[0]->date, 42 | DateTime->from_epoch( 43 | epoch => $hello->stat->mtime, 44 | time_zone => 'America/New_York' 45 | ), 46 | 'right mtime' 47 | ); 48 | 49 | my ($author) = $g->config('user.name'); 50 | is( $entries[0]->author, $author, 'right author' ); 51 | is( $entries[0]->content, 'Hello World', 'right content' ); 52 | like( 53 | $entries[0]->render_fragment_HTML, 54 | qr"
\nHello World\n",
 55 |     'render correctly'
 56 | );
 57 | 
 58 | isa_ok( $blog->index, 'Blawd::Index' );
 59 | ok( my $renderer = $blog->get_renderer('HTML'), 'got renderer' );
 60 | like(
 61 |     $blog->index->render_fragment_HTML($renderer),
 62 |     qr"
\nHello World\n",
 63 |     'index renders'
 64 | );
 65 | 
 66 | my $bye = dir($directory)->file('goodbye');
 67 | $bye->openw->print('Goodbye World');
 68 | $g->add('goodbye');
 69 | $g->commit( { message => 'second post' } );
 70 | 
 71 | $blog = Container->new( storage => $storage )->build_app;
 72 | ok( @entries = $blog->entries, 'got entries' );
 73 | is( scalar @entries, 2, 'got two entries' );
 74 | ok( $_->does('Blawd::Entry::API'), 'does Blawd::Entry::API' ) for @entries;
 75 | 
 76 | # is( $entries[-1]->date, DateTime->from_epoch( epoch => $hello->stat->mtime, ),
 77 | #     'right mtime' );
 78 | is( $entries[-1]->author,  $author,       'right author' );
 79 | is( $entries[-1]->content, 'Hello World', 'right content' );
 80 | like(
 81 |     $entries[-1]->render_fragment_HTML,
 82 |     qr"
\nHello World\n",
 83 |     'render correctly'
 84 | );
 85 | 
 86 | # is( $entries[0]->date, DateTime->from_epoch( epoch => $bye->stat->mtime, ),
 87 | #     'right mtime' );
 88 | is( $entries[0]->author,  $author,         'right author' );
 89 | is( $entries[0]->content, 'Goodbye World', 'right content' );
 90 | like(
 91 |     $entries[0]->render_fragment_HTML,
 92 |     qr"
\nGoodbye World\n",
 93 |     'render correctly'
 94 | );
 95 | 
 96 | #$blog = Container->new( config => Config->new )->build_app;
 97 | isa_ok( $blog->index, 'Blawd::Index' );
 98 | is( $blog->index->size, 2, 'index is the right size' );
 99 | like(
100 |     $blog->get_index('index')->render_fragment_HTML($renderer),
101 |     qr|
\n
\nGoodbye World|m,
102 |     'index renders'
103 | );
104 | 
105 | is_deeply( $entries[0], $blog->get_entry('goodbye'), 'entry compares okay' );
106 | 
107 | for ( 3 .. 15 ) {
108 |     my $post = dir($directory)->file( 'lorem' . $_ );
109 |     $post->openw->print(<<"END_POST");
110 | Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod
111 | tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim
112 | veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea
113 | commodo consequat. Duis aute irure dolor in reprehenderit in voluptate
114 | velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint
115 | occaecat cupidatat non proident, sunt in culpa qui officia deserunt
116 | mollit anim id est laborum.
117 | 
118 | END_POST
119 | 
120 |     $g->add( 'lorem' . $_ );
121 |     $g->commit( { message => 'lorem post ' . $_ } );
122 | }
123 | 
124 | $blog = Container->new( storage => $storage )->build_app;
125 | isa_ok( $blog->get_index('index'), 'Blawd::Index' );
126 | is( $blog->get_index('index')->size, 10, 'index is the right size' );
127 | like(
128 |     $blog->get_index('index')->render_fragment_HTML($renderer),
129 |     qr|
\n
\nLorem|m,
130 |     'index renders'
131 | );
132 | like(
133 |     ( $blog->entries )[-1]->render_fragment_HTML,
134 |     qr"
\nLorem",
135 |     'render correctly'
136 | );
137 | 
138 | {
139 |     my $renderer = $blog->get_renderer('RSS');
140 |     die "couldn't find RSS renderer" unless $renderer;
141 |     ok( my $rss = $blog->get_index('index')->render_page_default($renderer),
142 |         'got RSS' );
143 |     is( $blog->get_index('index')->render_page_default($renderer),
144 |         $rss, 'fragment is the full RSS' );
145 | 
146 |     # ok( $blog->get_index('rss')->render_to_file('/tmp/blawd_test_rss'),
147 |     #     'render to file' );
148 |     # is( file('/tmp/blawd_test_rss')->slurp, $rss, 'file output is good' );
149 | }
150 | done_testing;
151 | dir($directory)->rmtree;
152 | file('/tmp/blawd_test_rss')->remove;
153 | 


--------------------------------------------------------------------------------