`til-kron` works
[sunny256-utils.git] / q3r
blob2e4fb639c738860e28dd7cd233f0fff7149b4816
1 #!/usr/bin/env perl
3 #=======================================================================
4 # q3r
5 # File ID: ba028ba2-2287-11e2-b260-00c0a8deee11
6 # [Description]
8 # Character set: UTF-8
9 # ©opyleft 2012– Øyvind A. Holm <sunny@sunbase.org>
10 # License: GNU General Public License version 2 or later, see end of
11 # file for legal stuff.
12 #=======================================================================
14 use strict;
15 use warnings;
16 use Getopt::Long;
17 use Fcntl ':flock';
19 local $| = 1;
21 our $Debug = 0;
23 our %Std = (
25 'sumfile' => 'Files.sha1',
29 our %Opt = (
31 'after' => 0,
32 'before' => 0,
33 'debug' => 0,
34 'help' => 0,
35 'sumfile' => $Std{'sumfile'},
36 'text' => '',
37 'verbose' => 0,
38 'version' => 0,
42 our $progname = $0;
43 $progname =~ s/^.*\/(.*?)$/$1/;
44 our $VERSION = '0.00';
46 Getopt::Long::Configure('bundling');
47 GetOptions(
49 'after|a' => \$Opt{'after'},
50 'before|b' => \$Opt{'before'},
51 'debug' => \$Opt{'debug'},
52 'help|h' => \$Opt{'help'},
53 'sumfile|s=s' => \$Opt{'sumfile'},
54 'text|t=s' => \$Opt{'text'},
55 'verbose|v+' => \$Opt{'verbose'},
56 'version' => \$Opt{'version'},
58 ) || die("$progname: Option error. Use -h for help.\n");
60 $Opt{'debug'} && ($Debug = 1);
61 $Opt{'help'} && usage(0);
62 if ($Opt{'version'}) {
63 print_version();
64 exit(0);
67 my $text = $Opt{'text'};
68 length($text) || die("$progname: Filename text not specified (-t option)\n");
69 $text =~ s/ /_/g;
71 $Opt{'after'} && $Opt{'before'} && die("$progname: Cannot combine --after and --before\n");
73 my @files = @ARGV;
75 for (@files) {
76 (-f $_ || -l $_) || die("$progname: $_: File not found, aborting. No files renamed.\n");
77 valid_filename($_) || die("$progname: $_: Invalid file name, aborting. No files renamed.\n");
80 # Better safe than sorry, check that no files with the same name already
81 # exist before renaming.
82 for my $curr (@files) {
83 my $new = $curr;
84 $new = new_name($text, $new);
85 -e $new && die("$progname: $new: File already exists, aborting. No files renamed.\n");
88 my ($use_sumfile, $sumfp, $sumdata);
90 if (-f $Opt{'sumfile'}) {
91 $use_sumfile = 1;
92 open($sumfp, '+<', $Opt{'sumfile'})
93 or die("$progname: $Opt{'sumfile'}: Cannot open file for read+write: $!\n");
94 flock($sumfp, LOCK_EX)
95 or die("$progname: $Opt{'sumfile'}: Cannot flock(): $!\n");
96 $sumdata = join('', <$sumfp>);
97 } else {
98 $use_sumfile = 0;
99 $sumdata = '';
102 for my $curr (@files) {
103 my $new = $curr;
104 $new = new_name($text, $new);
105 $sumdata =~ s/$curr/$new/;
106 -e $new || rename($curr, $new) || die("$progname: $curr: Cannot rename file to '$new': $!\n");
107 $Opt{'verbose'} && printf("%s renamed to %s\n", $curr, $new);
110 if ($use_sumfile) {
111 seek($sumfp, 0, 0)
112 or die("$progname: $Opt{'sumfile'}: Cannot seek(): $!\n");
113 truncate($sumfp, 0)
114 or warn("$progname: $Opt{'sumfile'}: Cannot truncate file: $!\n");
116 print($sumfp $sumdata);
117 $use_sumfile && close($sumfp);
120 sub valid_filename {
121 # Check that source filenames are formatted properly {{{
122 my $filename = shift;
123 # Examples of valid file names:
124 # 20110313T231244Z.zoom0084.m4a
125 # 20110405T223726Z.zo010013.mov
126 # I.e. standard Zoom file names processed by datefn(1)
127 return($filename =~ /^
128 20\d\d # Year
129 [0-1]\d # Month
130 [0-3]\d # Day
132 [0-2]\d # Hours
133 [0-5]\d # Minutes
134 [0-5]\d # Seconds
139 [^\.]*? # Extension
140 $/x) && 1 || 0;
141 # }}}
142 } # valid_filename()
144 sub new_name {
145 # Return new file name {{{
146 my ($text, $filename) = @_;
147 if ($Opt{'after'}) {
148 $filename =~ s/^(.*?Z)\.(.*?)\.([^\.]*?)$/$1.$2.$text.$3/;
149 } elsif ($Opt{'before'}) {
150 $filename =~ s/^(.*?Z)\.(.*?)\.([^\.]*?)$/$1.$text.$2.$3/;
151 } else {
152 $filename =~ s/^(.*?Z)\.(.*?)\.([^\.]*?)$/$1.$text.$3/;
154 return($filename);
155 # }}}
156 } # new_name()
158 sub print_version {
159 # Print program version {{{
160 print("$progname v$VERSION\n");
161 return;
162 # }}}
163 } # print_version()
165 sub usage {
166 # Send the help message to stdout {{{
167 my $Retval = shift;
169 if ($Opt{'verbose'}) {
170 print("\n");
171 print_version();
173 print(<<"END");
175 Rename files created by the Zoom Q3HD to something useful.
177 Usage: $progname -t "Text for file names" [options] [files [...]]
179 Options:
181 -a, --after
182 Place text after existing text.
183 -b, --before
184 Place text before existing text.
185 -h, --help
186 Show this help.
187 -s X, --sumfile X
188 Specify name of file containing file checksums.
189 Default: '$Std{'sumfile'}'.
190 -t X, --text X
191 Insert X into file name.
192 -v, --verbose
193 Increase level of verbosity. Can be repeated.
194 --version
195 Print version information.
196 --debug
197 Print debugging messages.
200 exit($Retval);
201 # }}}
202 } # usage()
204 sub msg {
205 # Print a status message to stderr based on verbosity level {{{
206 my ($verbose_level, $Txt) = @_;
208 if ($Opt{'verbose'} >= $verbose_level) {
209 print(STDERR "$progname: $Txt\n");
211 return;
212 # }}}
213 } # msg()
215 sub D {
216 # Print a debugging message {{{
217 $Debug || return;
218 my @call_info = caller;
219 chomp(my $Txt = shift);
220 my $File = $call_info[1];
221 $File =~ s#\\#/#g;
222 $File =~ s#^.*/(.*?)$#$1#;
223 print(STDERR "$File:$call_info[2] $$ $Txt\n");
224 return('');
225 # }}}
226 } # D()
228 __END__
230 # Plain Old Documentation (POD) {{{
232 =pod
234 =head1 NAME
238 =head1 SYNOPSIS
240 [options] [file [files [...]]]
242 =head1 DESCRIPTION
246 =head1 OPTIONS
248 =over 4
250 =item B<-h>, B<--help>
252 Print a brief help summary.
254 =item B<-v>, B<--verbose>
256 Increase level of verbosity. Can be repeated.
258 =item B<--version>
260 Print version information.
262 =item B<--debug>
264 Print debugging messages.
266 =back
268 =head1 BUGS
272 =head1 AUTHOR
274 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
276 =head1 COPYRIGHT
278 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
279 This is free software; see the file F<COPYING> for legalese stuff.
281 =head1 LICENCE
283 This program is free software: you can redistribute it and/or modify it
284 under the terms of the GNU General Public License as published by the
285 Free Software Foundation, either version 2 of the License, or (at your
286 option) any later version.
288 This program is distributed in the hope that it will be useful, but
289 WITHOUT ANY WARRANTY; without even the implied warranty of
290 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
291 See the GNU General Public License for more details.
293 You should have received a copy of the GNU General Public License along
294 with this program.
295 If not, see L<http://www.gnu.org/licenses/>.
297 =head1 SEE ALSO
299 =cut
301 # }}}
303 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :