parent
4f09e4759b
commit
eac8b2f945
3 changed files with 352 additions and 0 deletions
@ -0,0 +1,20 @@ |
|||||||
|
name = MJB-Backend-Jekyll |
||||||
|
abstract = Manage Jekyll Blog Repositories |
||||||
|
author = Kaitlyn Parkhurst <symkat@symkat.com> |
||||||
|
license = Perl_5 |
||||||
|
copyright_holder = Kaitlyn Parkhurst |
||||||
|
copyright_year = 2022 |
||||||
|
version = 0.001 |
||||||
|
|
||||||
|
[@Basic] |
||||||
|
|
||||||
|
[Prereqs] |
||||||
|
Moo = 0 |
||||||
|
IPC::Run3 = 0 |
||||||
|
Cwd = 0 |
||||||
|
File::Path = 0 |
||||||
|
Storable = 0 |
||||||
|
Mojo::File = 0 |
||||||
|
|
||||||
|
[AutoPrereqs] |
||||||
|
|
||||||
@ -0,0 +1,324 @@ |
|||||||
|
package MJB::Backend::Jekyll; |
||||||
|
use Moo; |
||||||
|
use IPC::Run3 qw( run3 ); |
||||||
|
use Cwd qw( getcwd ); |
||||||
|
use File::Path qw( make_path ); |
||||||
|
use Storable qw( dclone ); |
||||||
|
use Mojo::File; |
||||||
|
|
||||||
|
# The root path for the repositories |
||||||
|
has root => ( |
||||||
|
is => 'ro', |
||||||
|
required => 1, |
||||||
|
trigger => sub { |
||||||
|
my ( $self, $value ) = @_; |
||||||
|
make_path( $value ); |
||||||
|
}, |
||||||
|
); |
||||||
|
|
||||||
|
# The domain name for this jekyll blog |
||||||
|
has domain => ( |
||||||
|
is => 'ro', |
||||||
|
required => 1, |
||||||
|
); |
||||||
|
|
||||||
|
# The full path to the git repo this is backed by. |
||||||
|
has repo => ( |
||||||
|
is => 'ro', |
||||||
|
required => 1, |
||||||
|
); |
||||||
|
|
||||||
|
has repo_path => ( |
||||||
|
is => 'lazy', |
||||||
|
); |
||||||
|
|
||||||
|
sub _build_repo_path { |
||||||
|
my ( $self ) = @_; |
||||||
|
|
||||||
|
return $self->root . "/" . $self->domain; |
||||||
|
} |
||||||
|
|
||||||
|
# The full path to the git repo to clone when using |
||||||
|
# init on a new repository. |
||||||
|
has init_from => ( |
||||||
|
is => 'ro', |
||||||
|
required => 1, |
||||||
|
); |
||||||
|
|
||||||
|
sub init { |
||||||
|
my ( $self ) = @_; |
||||||
|
|
||||||
|
# Refuse to overwrite an already-existing site. |
||||||
|
die "Error: Cannot init when the target directory already exists." |
||||||
|
if -d $self->repo_path; |
||||||
|
|
||||||
|
# Clone the template repo |
||||||
|
$self->system_command( [ qw( git clone ), $self->init_from, $self->repo_path ] ); |
||||||
|
|
||||||
|
# Update the origin that is set |
||||||
|
$self->system_command( [ qw( git remote set-url origin ), $self->repo ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
# Confirm the origin updated |
||||||
|
my $return = $self->system_command( [ qw( git remote get-url origin ) ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
if ( $return->{stdout} ne $self->repo . "\n" ) { |
||||||
|
die "Error: Unable to initialize and set repo."; |
||||||
|
} |
||||||
|
|
||||||
|
# Push the repo to the store |
||||||
|
$self->system_command( [ qw( git push origin master ) ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
return $self; |
||||||
|
} |
||||||
|
|
||||||
|
sub list_posts { |
||||||
|
my ( $self ) = @_; |
||||||
|
|
||||||
|
$self->_ensure_repository_is_latest; |
||||||
|
|
||||||
|
my $posts = Mojo::File->new( $self->repo_path . "/_posts" ); |
||||||
|
|
||||||
|
my $data; |
||||||
|
|
||||||
|
# TODO: Sort by date for the listing on the front end. |
||||||
|
foreach my $file ( $posts->list->each ) { |
||||||
|
my $title = $self->get_title_of_post($file->path); |
||||||
|
my $path = $file->to_string; |
||||||
|
|
||||||
|
$data->{titles}->{$title} = $path; |
||||||
|
$data->{files}->{$path} = $title; |
||||||
|
} |
||||||
|
|
||||||
|
return $data; |
||||||
|
} |
||||||
|
|
||||||
|
sub get_title_of_post { |
||||||
|
my ( $self, $file ) = @_; |
||||||
|
|
||||||
|
open my $lf, "<", $file |
||||||
|
or die "Failed to open $file for reading: $!"; |
||||||
|
while ( defined( my $line = <$lf> ) ) { |
||||||
|
if ( $line =~ /^title: (.+)$/ ) { |
||||||
|
close $lf; |
||||||
|
return $line; |
||||||
|
} |
||||||
|
} |
||||||
|
close $lf; |
||||||
|
return undef; |
||||||
|
} |
||||||
|
|
||||||
|
# Think about this.... |
||||||
|
# probably want 'slug: ' as an override for the file path |
||||||
|
sub _post_path { |
||||||
|
my ( $self, $headers ) = @_; |
||||||
|
|
||||||
|
my $title = $headers->{title}; |
||||||
|
|
||||||
|
$title = lc($title); |
||||||
|
$title =~ s/[^a-zA-Z0-9-_]+/_/g; |
||||||
|
$title =~ s/[_]+/_/g; |
||||||
|
$title =~ s/_$//g; |
||||||
|
$title =~ s/^_//g; |
||||||
|
|
||||||
|
return $self->repo_path . "/_posts/" . $title . ".markdown"; |
||||||
|
} |
||||||
|
|
||||||
|
sub create_post { |
||||||
|
my ( $self, $headers, $content ) = @_; |
||||||
|
|
||||||
|
# Check if the repo exists, and Update the repo if needed |
||||||
|
$self->_ensure_repository_is_latest; |
||||||
|
|
||||||
|
# Get the file path to write to. |
||||||
|
my $post_path = $self->_post_path( $headers ); |
||||||
|
|
||||||
|
# Ensure the post doesn't exist |
||||||
|
die "Error: Cannot create post that already exists at " . $post_path |
||||||
|
if -f $post_path; |
||||||
|
|
||||||
|
# Create the post |
||||||
|
open my $sf, ">", $post_path |
||||||
|
or die "Failed to open $post_path for writing: $!"; |
||||||
|
|
||||||
|
print $sf "---\n"; |
||||||
|
print $sf join( "\n", map { "$_: " . $headers->{$_} } keys %$headers ); |
||||||
|
print $sf "\n---\n"; |
||||||
|
print $sf $content; |
||||||
|
|
||||||
|
close $sf; |
||||||
|
|
||||||
|
# Add the file to git |
||||||
|
$self->system_command( [ qw( git add ), $post_path ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
# Commit the file |
||||||
|
$self->system_command( [ qw( git commit -m ), "Created " . $headers->{title} ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
# Push the repo to the store server |
||||||
|
$self->system_command( [ qw( git push origin master ) ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
sub update_post { |
||||||
|
my ( $self, $file, $headers, $content ) = @_; |
||||||
|
|
||||||
|
$self->delete_post( $file ); |
||||||
|
|
||||||
|
$self->create_post( $headers, $content ); |
||||||
|
} |
||||||
|
|
||||||
|
sub delete_post { |
||||||
|
my ( $self, $title, $file ) = @_; |
||||||
|
|
||||||
|
# Check if the repo exists and update the repo if needed |
||||||
|
$self->_ensure_repository_is_latest; |
||||||
|
|
||||||
|
# Ensure the post exists - irony |
||||||
|
die "Error: Cannot delete post that doesn't exists at " . $file |
||||||
|
if ! -f $file; |
||||||
|
|
||||||
|
# git rm the file |
||||||
|
$self->system_command( [ qw( git rm ), $file ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
# git commit the file |
||||||
|
$self->system_command( [ qw( git commit -m ), "Deleted post $title" ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
# Push the repo to the store server |
||||||
|
$self->system_command( [ qw( git push origin master ) ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
} |
||||||
|
|
||||||
|
sub history { |
||||||
|
# Check if the repo exists |
||||||
|
|
||||||
|
# Do a git history |
||||||
|
|
||||||
|
# Format the results into a data structure |
||||||
|
|
||||||
|
# Return the data structure |
||||||
|
} |
||||||
|
|
||||||
|
# Helper function to ensure the repo exists and has the latest |
||||||
|
# changes. |
||||||
|
sub _ensure_repository_is_latest { |
||||||
|
my ( $self ) = @_; |
||||||
|
|
||||||
|
# Check for the repo -- if it doesn't exist, clone it. |
||||||
|
if ( ! -d $self->repo_path ) { |
||||||
|
$self->system_command( [ qw( git clone ), $self->repo, $self->repo_path ] ); |
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
# Run a git pull with fast forward |
||||||
|
$self->system_command( [ qw( git pull --ff-only origin master ) ], { |
||||||
|
chdir => $self->repo_path, |
||||||
|
}); |
||||||
|
|
||||||
|
return 1; |
||||||
|
} |
||||||
|
|
||||||
|
sub system_command { |
||||||
|
my ( $self, $cmd, $settings ) = @_; |
||||||
|
|
||||||
|
$settings ||= {}; |
||||||
|
|
||||||
|
# Change the directory, if requested. |
||||||
|
if ( $settings->{chdir} ) { |
||||||
|
# Throw an error if that directory doesn't exist. |
||||||
|
die "Error: directory " . $settings->{chdir} . "doesn't exist." |
||||||
|
unless -d $settings->{chdir}; |
||||||
|
|
||||||
|
# Change to that directory, or die with error. |
||||||
|
chdir $settings->{chdir} |
||||||
|
or die "Failed to chdir to " . $settings->{chdir} . ": $!"; |
||||||
|
|
||||||
|
$settings->{return_chdir} = getcwd(); |
||||||
|
} |
||||||
|
|
||||||
|
# Mask values we don't want exposed in the logs. |
||||||
|
my $masked_cmd = dclone($cmd); |
||||||
|
if ( ref $settings->{mask} eq 'HASH' ) { |
||||||
|
foreach my $key ( keys %{$settings->{mask}} ) { |
||||||
|
my $value = $settings->{mask}{$key}; |
||||||
|
$masked_cmd = [ map { s/\Q$key\E/$value/g; $_ } @{$masked_cmd} ]; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
# Log the lines |
||||||
|
my ( $out, $err ); |
||||||
|
my $ret = run3( $cmd, \undef, sub { |
||||||
|
chomp $_; |
||||||
|
# Mask values we don't want exposed in the logs. |
||||||
|
if ( ref $settings->{mask} eq 'HASH' ) { |
||||||
|
foreach my $key ( keys %{$settings->{mask}} ) { |
||||||
|
my $value = $settings->{mask}{$key}; |
||||||
|
s/\Q$key\E/$value/g; |
||||||
|
} |
||||||
|
} |
||||||
|
$out .= "$_\n"; |
||||||
|
}, sub { |
||||||
|
chomp $_; |
||||||
|
# Mask values we don't want exposed in the logs. |
||||||
|
if ( ref $settings->{mask} eq 'HASH' ) { |
||||||
|
foreach my $key ( keys %{$settings->{mask}} ) { |
||||||
|
my $value = $settings->{mask}{$key}; |
||||||
|
s/\Q$key\E/$value/g; |
||||||
|
} |
||||||
|
} |
||||||
|
$err .= "$_\n"; |
||||||
|
}); |
||||||
|
|
||||||
|
# Check stderr for errors to fail on. |
||||||
|
if ( $settings->{fail_on_stderr} ) { |
||||||
|
my @tests = @{$settings->{fail_on_stderr}}; |
||||||
|
|
||||||
|
while ( my $regex = shift @tests ) { |
||||||
|
my $reason = shift @tests; |
||||||
|
|
||||||
|
if ( $err =~ /$regex/ ) { |
||||||
|
die $reason; |
||||||
|
} |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
# Return to the directory we started in if we chdir'ed. |
||||||
|
if ( $settings->{return_chdir} ) { |
||||||
|
chdir $settings->{return_chdir} |
||||||
|
or die "Failed to chdir to " . $settings->{chdir} . ": $!"; |
||||||
|
} |
||||||
|
|
||||||
|
if ( $ENV{MJB_DEBUG} ) { |
||||||
|
require Data::Dumper; |
||||||
|
print Data::Dumper::Dumper({ |
||||||
|
stdout => $out, |
||||||
|
stderr => $err, |
||||||
|
exitno => $ret, |
||||||
|
}); |
||||||
|
} |
||||||
|
|
||||||
|
return { |
||||||
|
stdout => $out, |
||||||
|
stderr => $err, |
||||||
|
exitno => $ret, |
||||||
|
}; |
||||||
|
} |
||||||
|
|
||||||
|
1; |
||||||
@ -0,0 +1,8 @@ |
|||||||
|
#!/usr/bin/env perl |
||||||
|
use warnings; |
||||||
|
use strict; |
||||||
|
use Test::More; |
||||||
|
|
||||||
|
use_ok( "MJB::Backend::Jekyll" ); |
||||||
|
|
||||||
|
done_testing; |
||||||
Loading…
Reference in new issue