comparison lib/CLI.pm @ 52:73b27e5c1d79 default tip

auto-Update generated slides by script
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 16 Apr 2019 18:58:24 +0900
parents ccfc78c23c66
children
comparison
equal deleted inserted replaced
51:5f949b153f65 52:73b27e5c1d79
1 package CLI;
2 use strict;
3 use warnings;
4 use utf8;
5
6 #use DDP { deparse => 1 };
7
8 use Smart::Options;
9 use Smart::Options::Declare;
10 use Time::Piece;
11 use Time::Seconds;
12 use Capture::Tiny qw/capture/;
13 use Path::Tiny;
14 use File::chdir;
15 use Carp qw/croak/;
16
17 use Class::Tiny qw/ template root_dir/;
18 use feature 'say';
19
20 sub run {
21 my($self,@args) = @_;
22 my $opt = Smart::Options->new->options(
23 file => { describe => 'target file', alias => 'f'}
24 );
25 $opt->subcmd(
26 new => Smart::Options->new(),
27 build => Smart::Options->new(),
28 open => Smart::Options->new->default('target' => 'slide.md'),
29 build_open => Smart::Options->new->default('target' => 'slide.md'),
30 upload => Smart::Options->new(),
31 memo => Smart::Options->new(),
32 edit => Smart::Options->new(),
33 zip => Smart::Options->new(),
34 );
35
36 my $result = $opt->parse(@args);
37 my $command = $result->{command} // "open";
38
39 my $option = $result->{cmd_option}->{f} || $result->{cmd_option}->{file} || 0;
40
41 my $call = $self->can("cmd_$command");
42 croak 'undefine subcommand' unless $call;
43 $self->$call($option);
44 }
45
46 sub cmd_new {
47 my ($self) = @_;
48 my ($y,$m,$d) = _y_m_d();
49 my $slide = path($self->root_dir)->child($y)->child($m)->child($d)->child('slide.md')->touchpath;
50 path($self->template)->copy($slide);
51 }
52
53 sub cmd_build {
54 my($self,$target) = @_;
55
56 if ($target){
57 $target = path($target);
58 $self->_build($target->dirname,$target->basename);
59 } else {
60 $self->_build($self->_search_recently_day());
61 }
62 }
63
64 sub _build {
65 my ($self,$dir,$target) = @_;
66
67 $target //= 'slide.md';
68
69 say "[AUTO] BUILD at $dir/$target";
70
71 local $CWD = $dir;
72
73 my ($stdout,$stderr,$exit) = capture {
74 system("slideshow build ${target} -t s6cr");
75 };
76
77 croak "Perl can't build...." if $stderr;
78 }
79
80 sub cmd_build_open {
81 my($self,$target) = @_;
82 $self->cmd_build($target);
83 if($target){
84 $target =~ s/\.md$/\.html/;
85 } else {
86 my @targets = $self->_search_recently_day()->children(qr/(?<!pdf)\.html$/);
87 $target = pop @targets;
88 }
89 $self->cmd_open(path($target));
90 }
91
92 sub cmd_open {
93 my($self,$slide) = @_;
94
95 my $target;
96
97 if ($slide){
98 $target = $slide;
99 } else {
100 $slide = 'slide.html';
101 $target = $self->_search_recently_day()->child($slide);
102 }
103
104 if($target->realpath){
105 system 'open', ($target->realpath);
106 } else {
107 croak 'dont found slide.html';
108 }
109 }
110
111 sub cmd_upload {
112 say "[AUTO]hg addremove";
113 my ($stdout,$stderr,$exit) = capture {
114 system("hg addremove");
115 system("hg add");
116 };
117
118
119 croak "didn't add" if $stderr;
120
121 say "[AUTO]hg commit -m auto-Update generated slides by script";
122
123 ($stdout,$stderr,$exit) = capture { system('hg commit -m "auto-Update generated slides by script"');};
124
125 if ($stderr) { say $stderr; croak "didn't commit";}
126
127 say "[AUTO]hg push";
128
129 ($stdout,$stderr,$exit) = capture { system('hg push'); };
130
131 if ( $stderr ) {
132 say $stderr;
133 croak "didn't commit";
134 } else {
135 say $stdout;
136 }
137 }
138
139 sub _y_m_d {
140 my $t = localtime;
141 # ex... 2018/02/14
142 ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d'));
143 }
144
145 sub _search_recently_day {
146 my ($self) = @_;
147 my ($y,$m,$d) = _y_m_d();
148 my $root_dir = path($self->root_dir)->child($y)->child($m);
149
150 my $date = shift @{ [sort { $b->stat->mtime <=> $a->stat->mtime } $root_dir->children]};
151 return $date;
152 }
153
154 sub cmd_memo {
155 my ($self) = @_;
156 my ($y,$m,$d) = _y_m_d();
157 my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt')->touchpath;
158 exec $ENV{EDITOR},($memo->realpath);
159 }
160
161 sub cmd_edit {
162 my ($self) = @_;
163 my $recent_day = $self->_search_recently_day();
164 my @targets = $recent_day->children(qr/\.md$/);
165 my $target = pop @targets;
166 exec $ENV{EDITOR},($target->realpath);
167 }
168
169 sub cmd_zip {
170 my ($self) = @_;
171 my $recent_day = $self->_search_recently_day();
172 my $t = localtime;
173 my $zip = $recent_day->child('zip.txt')->touch->opena;
174
175 $t-= ONE_WEEK;
176
177 for(0..7){
178 my($y,$m,$d)=($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d'));
179 my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt');
180
181 unless ($memo->exists) {
182 $t += ONE_DAY;
183 next;
184 }
185
186 say $zip "$y-$m-$d----";
187 say $zip $memo->slurp;
188 say $zip "----------";
189 $t += ONE_DAY;
190 }
191 }
192
193 1;