Mercurial > hg > Members > anatofuz > slides
comparison lib/CLI.pm @ 36:74859abd87cc
update cli tool
author | Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 07 May 2018 12:59:27 +0900 |
parents | |
children | 202d1ab8775a |
comparison
equal
deleted
inserted
replaced
35:0d0c8ed9adb4 | 36:74859abd87cc |
---|---|
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 } | |
86 $self->cmd_open(path($target)); | |
87 } | |
88 | |
89 sub cmd_open { | |
90 my($self,$slide) = @_; | |
91 | |
92 my $target; | |
93 | |
94 if ($slide){ | |
95 $target = $slide; | |
96 } else { | |
97 $slide = 'slide.html'; | |
98 $target = $self->_search_recently_day()->child($slide); | |
99 } | |
100 | |
101 if($target->realpath){ | |
102 system 'open', ($target->realpath); | |
103 } else { | |
104 croak 'dont found slide.html'; | |
105 } | |
106 } | |
107 | |
108 sub cmd_upload { | |
109 say "[AUTO]hg addremove"; | |
110 my ($stdout,$stderr,$exit) = capture { | |
111 system("hg addremove"); | |
112 system("hg add"); | |
113 }; | |
114 | |
115 | |
116 croak "didn't add" if $stderr; | |
117 | |
118 say "[AUTO]hg commit -m auto-Update generated slides by script"; | |
119 | |
120 ($stdout,$stderr,$exit) = capture { system('hg commit -m "auto-Update generated slides by script"');}; | |
121 | |
122 if ($stderr) { say $stderr; croak "didn't commit";} | |
123 | |
124 say "[AUTO]hg push"; | |
125 | |
126 ($stdout,$stderr,$exit) = capture { system('hg push'); }; | |
127 | |
128 if ( $stderr ) { | |
129 say $stderr; | |
130 croak "didn't commit"; | |
131 } else { | |
132 say $stdout; | |
133 } | |
134 } | |
135 | |
136 sub _y_m_d { | |
137 my $t = localtime; | |
138 # ex... 2018/02/14 | |
139 ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); | |
140 } | |
141 | |
142 sub _search_recently_day { | |
143 my($self) = @_; | |
144 my ($y,$m,$d) = _y_m_d(); | |
145 my $root_dir = path($self->root_dir)->child($y)->child($m); | |
146 | |
147 my $date = shift @{ [sort { $b->stat->mtime <=> $a->stat->mtime } $root_dir->children]}; | |
148 return $date; | |
149 } | |
150 | |
151 sub cmd_memo { | |
152 my ($self) = @_; | |
153 my ($y,$m,$d) = _y_m_d(); | |
154 my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt')->touchpath; | |
155 exec $ENV{EDITOR},($memo->realpath); | |
156 } | |
157 | |
158 sub cmd_edit { | |
159 my ($self) = @_; | |
160 my $recent_day = $self->_search_recently_day(); | |
161 my @targets = $recent_day->children(qr/\.md$/); | |
162 my $target = pop @targets; | |
163 exec $ENV{EDITOR},($target->realpath); | |
164 } | |
165 | |
166 sub cmd_zip { | |
167 my ($self) = @_; | |
168 my $recent_day = $self->_search_recently_day(); | |
169 my $t = localtime; | |
170 my $zip = $recent_day->child('zip.txt')->touch->opena; | |
171 | |
172 $t-= ONE_WEEK; | |
173 | |
174 for(1..7){ | |
175 my($y,$m,$d)=($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); | |
176 my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt'); | |
177 | |
178 unless ($memo->exists) { | |
179 $t += ONE_DAY; | |
180 next; | |
181 } | |
182 | |
183 say $zip "$y-$m-$d----"; | |
184 say $zip $memo->slurp; | |
185 say $zip "----------"; | |
186 $t += ONE_DAY; | |
187 } | |
188 } | |
189 | |
190 | |
191 1; |