view lib/Slideshow/Util.pm @ 33:2eac67c0d7da fix

auto-Update generated slides by script
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 01 May 2018 09:25:17 +0900
parents 952136cc268f
children 448db64959d0
line wrap: on
line source

package Slideshow::Util;
use strict;
use warnings;
use utf8;

use Carp qw/ croak /;

use base 'Exporter';

use Time::Piece;
use feature 'say';
use Path::Tiny;
use File::chdir;
use Capture::Tiny qw/capture/;

our @EXPORT = qw/
    getopts
    new
    set_template
    build_recently 
    build_pinpoint 
    open_slide
    edit_slide
    edit_memo
    upload
/;

sub getopts {
    my ($arg,$path)  = @_;

    unless (defined $arg){
        return { help => 1};
    }

    if ($arg eq "new") {
        return[\new(set_template('lib/template.md'),"slides")];
    } elsif ( $arg eq "upload") {
        return [\upload() ];
    } elsif ( $arg eq "build") {
        return [\build_recently()];
    } elsif ( $arg eq "build-open"){
        return [\build_recently("slides"),\open_slide()];
    } elsif ( $arg eq "open"){
        return [\open_slide("slides")];
    } elsif ( $arg eq "edit"){
        return [\edit_slide("slides")];
    } elsif ( $arg eq "memo"){
        return [\edit_memo("slides")];
    } else {
        return { help => 1};
    }

}

sub set_template {
    my $template = shift;
    my $file  = path($template);
    return $file;
}

sub new {
    my ($template,$root_directory_name) = @_;
    my $root_dir = path($root_directory_name);
    my $t = localtime;

    # ex... 2018/02/14
    my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d'));
    my $slide = $root_dir->child($y .'/'. $m .'/'. $d .'/'.'slide.md')->touchpath;
    $template->copy($slide);
}

sub _search_recently {
    my ($root_directory_name) = @_;
    my $t = localtime;

    # ex... 2018/02/14
    my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d'));
    my $root_dir = path($root_directory_name.'/'.$y.'/'.$m);

    my $date = shift @{ [sort { $b->stat->mtime <=> $a->stat->mtime } $root_dir->children]};

    return $date;
}



sub build_recently {
    my $target = shift // "slides";
    my $recently = _search_recently($target);
    _build($recently);
}

sub build_pinpoint {
    my $target = shift;

    my $target_path = path($target);

    my $dir = $target_path->dirname;
    my $slide = $target_path->basename;

   _build($dir,$slide);
}

sub edit_memo {
    my $target = shift // "slides";
    my $root_dir = path($target);
    my $t = localtime;

    # ex... 2018/02/14
    my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d'));
    my $memo = $root_dir->child($y .'/'. $m .'/'. $d .'/'.'memo.txt')->touchpath;
    exec $ENV{EDITOR}, ($memo->realpath);
}

sub edit_slide {
    my $arg = shift // "slides";
    my $recently = _search_recently($arg);
    my $target = $recently->child('slide.md');
    exec $ENV{EDITOR}, ($target->realpath);
}

sub open_slide {
    my $recently = _search_recently(shift);
    my $target = $recently->child('slide.html');

    if ( $target->realpath){
        system "open", ($target->realpath);
    }  else {
        say "didn't slide.html";
    }
}

sub _build {
    my ($dir,$target) = @_;
    use Capture::Tiny;

    $target //= 'slide.md';

    say "[AUTO] BUILD at $dir/$target";

    local $CWD = $dir;

    my ($stdout,$stderr,$exit) = capture {
        system("slideshow build ${target} -t s6cr");
    };

    if ($stderr){
        croak "Perl can't build....";
    }
}


sub upload {

    say "[AUTO]hg addremove";
    my ($stdout,$stderr,$exit) = capture {
        system("hg addremove");
        system("hg add");
    };

    if ($stderr) {
        croak "didn't add";
    }

    say "[AUTO]hg commit -m auto-Update generated slides by script";

    ($stdout,$stderr,$exit) = capture {
        system('hg commit -m "auto-Update generated slides by script"');
    };

    if ($stderr) {
        say $stderr;
        croak "didn't commit";
    }

    say "[AUTO]hg push";

    ($stdout,$stderr,$exit) = capture {
        system('hg push');
    };

    if ( $stderr ) {
        say $stderr;
        croak "didn't commit";
    } else {
        say $stdout;
    }
}

1;