Merge branch 'master' of github.com:teodesian/tCMS

.gitignore

@@ -6,3 +6,5 @@ www/assets/*.*
 data/DUMMY.json
 data/files/*
 pod2htmd.tmp
+fgEmojiPicker.js
+full-emoji-list.json

Makefile

@@ -17,3 +17,5 @@ reset-dummy-data:
 depend:
 	sudo apt install -y sqlite3 libsqlite3-dev libdbd-sqlite3-perl cpanminus starman  libcal-dav-perl libtext-xslate-perl libserver-starter-perl libplack-perl libcal-dav-perl libconfig-tiny-perl libdatetime-format-http-perl libjson-maybexs-perl libuuid-tiny-perl libcapture-tiny-perl libconfig-simple-perl libdbi-perl libfile-slurper-perl libfile-touch-perl libfile-copy-recursive-perl libxml-rss-perl libmodule-install-perl
 	sudo cpanm Mojo::File Date::Format WWW::SitemapIndex::XML WWW::Sitemap::XML HTTP::Body Pod::Html URL::Encode
+	wget -O www/scripts/fgEmojiPicker.js https://github.com/woody180/vanilla-javascript-emoji-picker/raw/master/fgEmojiPicker.js
+	wget -O www/scripts/full-emoji-list.json https://github.com/woody180/vanilla-javascript-emoji-picker/raw/master/full-emoji-list.json

Readme.md

@@ -4,6 +4,8 @@ tCMS
 A flexible perl CMS which supports multiple data models and content types
 
 Deployment is currently:
+* make depend
+* make install
 * Set up proxy rule in your webserver
 * open tmux or screen
 * `starman -p $PORT www/server.psgi`
@@ -12,6 +14,11 @@ In the future, we'll make systemd service files and rpms/debs etc.
 
 The user guide is self-hosted; After you first login, hit the 'Manual' section in the backend.
 
+Migration of tCMS1 sites
+=========================
+
+See migrate.pl, and modify the $docroot variable appropriately
+
 Content Types
 =============
 * Microblogs

lib/Trog/Routes/HTML.pm

@@ -413,6 +413,7 @@ sub config ($query, $render_cb) {
 
     return $render_cb->('config.tx', {
         title              => 'Configure tCMS',
+        theme_dir          => $td,
         stylesheets        => $css,
         scripts            => $js,
         themes             => _get_themes(),
@@ -522,6 +523,7 @@ sub post ($query, $render_cb) {
 
     return $render_cb->('post.tx', {
         title       => 'New Post',
+        theme_dir   => $td,
         to          => $query->{to},
         failure     => $query->{failure} // -1,
         message     => $query->{message},
@@ -933,6 +935,7 @@ sub manual ($query, $render_cb) {
     my $content = capture { Pod::Html::pod2html(qw{--podpath=lib --podroot=.},"--infile=lib/$infile") };
     return $render_cb->('manual.tx', {
         title       => 'tCMS Manual',
+        theme_dir   => $td,
         content     => $content,
         stylesheets => _build_themed_styles('post.css'),
     });

migrate.pl

@@ -0,0 +1,216 @@
+#!/usr/bin/perl
+
+#Migrate tCMS1 data to tCMS2 flat file data model
+
+use strict;
+use warnings;
+
+use JSON::MaybeXS;
+use File::Slurper();
+use HTML::Parser;
+use UUID::Tiny ':std';
+use File::Copy;
+use DateTime;
+
+#Edit this to be whatever you need it to be
+my $docroot = "/var/www/teodesian.net/doc";
+
+my $dir = "/var/www/teodesian.net/doc/microblog/";
+
+opendir(my $dh, $dir) or die;
+my @days = grep { !/^\./ } readdir $dh;
+closedir $dh;
+
+my $ring = JSON::MaybeXS->new();
+foreach my $day (@days) {
+
+    opendir(my $dht, "$dir/$day") or die;
+    my @times = grep { !/^\./ } readdir $dht;
+    closedir $dht;
+
+    my ($month,$date,$year) = split(/\./,$day);
+
+    foreach my $time (@times) {
+
+        my ($hour, $min, $sec) = split(/:/,$time);
+
+        my $data;
+        my $file = "$dir/$day/$time";
+
+        print "Migrate $file\n";
+        eval {
+            my $content = File::Slurper::read_text($file);
+            $data = $ring->decode($content);
+            $data = json_remap($data);
+        };
+        $data = html_post($file) unless $data;
+
+        my $dt = DateTime->new(
+            year       => $year + 2000,
+            month      => $month,
+            day        => $date,
+            hour       => $hour,
+            minute     => $min,
+            second     => $sec,
+        );
+        $data->{created} = $dt->epoch();
+
+        $data->{id} = $data->{created};
+        $data->{tags} = ['public','news'];
+        $data->{version} = 0;
+
+        open(my $fh, '>', "data/files/$data->{created}") or die;
+        print $fh encode_json([$data]);
+        close $fh;
+    }
+}
+
+# Migrate blog posts
+$dir = "$docroot/blog";
+
+opendir(my $bh, $dir) or die;
+my @blogs = grep { -f "$dir/$_" } readdir $bh;
+closedir $bh;
+
+my $offset = 0;
+
+foreach my $post ( sort {
+    my $anum = $a =~ m/^(\d*)-/;
+    my $bnum = $b =~ m/^(\d*)-/;
+    $b <=> $a
+  }  @blogs) {
+    my $postname = $post;
+    $postname =~ s/^\d*-//g;
+    $postname =~ s/\.post$//g;
+    my $content = File::Slurper::read_text("$dir/$post");
+
+    my $data = {
+        title => $postname,
+        data  => $content,
+        tags  => ['blog','public'],
+    };
+
+    my (undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime) = stat("$dir/$post");
+    my $user = lc(getpwuid($uid));
+    $user = scalar(grep { $user eq $_ } qw{/sbin/nologin www-data}) ? 'nobody' : $user;
+    $data->{user} = $user;
+    $ctime += $offset;
+    $data->{created} = $ctime;
+    $data->{id} = $ctime;
+    $data->{href} = "/blog/$ctime";
+    $data->{version} = 0;
+
+    print "Migrate blog post '$post'\n";
+    open(my $fh, '>', "data/files/$data->{created}") or die;
+    print $fh encode_json([$data]);
+    close $fh;
+
+    $offset--;
+}
+exit 0;
+my $vdir = "$docroot/fileshare/video";
+opendir(my $vh, $vdir) or die;
+my @vidyas = grep { -f "$vdir/$_" && $_ =~ m/\.m4v$/ } readdir $vh;
+closedir $vh;
+
+foreach my $vid ( @vidyas ) {
+    my $postname = $vid;
+    $postname =~ s/_/ /g;
+    $postname =~ s/\.mv4$//g;
+
+    my $data = {
+        title => $postname,
+        data  => "Description forthcoming",
+        tags  => ['video','public'],
+        preview => "/img/sys/testpattern.jpg",
+    };
+
+    my (undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime) = stat("$vdir/$vid");
+    my $user = lc(getpwuid($uid));
+    $user = scalar(grep { $user eq $_ } qw{/sbin/nologin www-data}) ? 'nobody' : $user;
+    $data->{user} = $user;
+    $data->{created} = $ctime;
+    $data->{id} = $ctime;
+    $data->{href} = "/assets/$ctime-$vid";
+    $data->{version} = 0;
+
+    #Copy over the video
+    File::Copy::copy("$vdir/$vid","www/assets/$ctime-$vid");
+
+    print "Migrate video '$vid'\n";
+    open(my $fh, '>', "data/files/$data->{created}") or die;
+    print $fh encode_json([$data]);
+    close $fh;
+}
+
+sub json_remap {
+    my $json = shift;
+
+    return {
+       preview => $json->{"image"},
+       data       => $json->{"comment"},
+       user       => lc($json->{"poster"}),
+       title      => $json->{"title"},
+       audio_href => $json->{"audio"},
+       href       => $json->{"url"},
+       video_href => $json->{"video"},
+    };
+}
+
+sub html_post {
+    my $file = shift;
+    my $is_first_link=1;
+    my $data = { data => '', href => '' };
+
+    my $p = HTML::Parser->new(
+        handlers => [
+            start => [
+                sub {
+                    my ($self,$attr,$text,$tagname) = @_;
+                    if ( $tagname eq 'a' && $is_first_link) {
+                        $data->{href} = $attr->{href};
+                        return;
+                    }
+                    return if $is_first_link;
+                    return if $tagname eq 'hr';
+                    $data->{data} .= $text;
+                },
+                'self, attr, text,tagname'
+            ],
+            text  => [
+                sub {
+                    my ($self,$attr,$text,$tagname) = @_;
+                    if ($is_first_link) {
+                        $data->{title} .= $text;
+                        return;
+                    }
+                    $data->{data} .= $text;
+                },
+                'self, attr, text,tagname'
+            ],
+            end   => [
+                sub {
+                    my ($self,$attr,$text,$tagname) = @_;
+                    if ( $tagname eq 'a' && $is_first_link) {
+                        $is_first_link=0;
+                        return;
+                    }
+                    return if $is_first_link;
+                    $data->{data} .= $text;
+                },
+                'self, attr, text,tagname'
+            ],
+        ],
+    );
+    $p->parse_file($file);
+
+    #Get the user name from ownership
+    my (undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime) = stat($file);
+    my $user = lc(getpwuid($uid));
+    $user = scalar(grep { $user eq $_ } qw{/sbin/nologin www-data}) ? 'nobody' : $user;
+    $data->{user} = $user;
+
+    $data->{created} = $ctime;
+
+    return $data;
+}

www/templates/form_common.tx

@@ -1,4 +1,5 @@
-Content<br /><textarea class="cooltext" name="data" placeholder="Potzrebie"><: $post.data :></textarea>
+Content <button class="coolbutton emojiPicker">😎</button>:
+<br /><textarea class="cooltext" name="data" placeholder="Potzrebie"><: $post.data :></textarea>
 <input type="hidden" name="app" value="<: $app :>" />
 <input type="hidden" name="to"  value="<: $route :>" />
 : if ( $post.id ) {

www/templates/mbengine.tx

@@ -8,3 +8,15 @@
         : include "posts.tx";
     </div>
 </div>
+<script type="text/javascript" src="/scripts/fgEmojiPicker.js"></script>
+<script type="text/javascript">
+new FgEmojiPicker({
+    trigger: ['button.emojiPicker'],
+    position: ['bottom'],
+    dir: `/scripts/`,
+    emit(obj, triggerElement) {
+        const emoji = obj.emoji;
+        document.querySelector('textarea').value += emoji;
+    }
+});
+</script>