sident

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # sident
   5 # File ID: da340b94-f743-11dd-8d53-000475e441b9
   6 #
   7 # Lists RCS-like keywords in files. Replacement for ident(1).
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2004– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18
  19 local $| = 1;
  20
  21 our %Opt = (
  22
  23     'expanded' => 0,
  24     'filesfrom' => "",
  25     'help' => 0,
  26     'known' => 0,
  27     'namesonly' => 0,
  28     'quiet' => 0,
  29     'unique' => 0,
  30     'verbose' => 0,
  31     'version' => 0,
  32     'xml' => 0
  33
  34 );
  35
  36 our $progname = $0;
  37 $progname =~ s/^.*\/(.*?)$/$1/;
  38 our $VERSION = '0.1.0';
  39
  40 Getopt::Long::Configure('bundling');
  41 GetOptions(
  42
  43     'expanded-only|e' => \$Opt{'expanded'},
  44     'filenames-from|f=s' => \$Opt{'filesfrom'},
  45     'filenames-only|l' => \$Opt{'namesonly'},
  46     'help|h' => \$Opt{'help'},
  47     'known-keywords-only|k' => \$Opt{'known'},
  48     'quiet|q+' => \$Opt{'quiet'},
  49     'unique-keywords|u' => \$Opt{'unique'},
  50     'verbose|v+' => \$Opt{'verbose'},
  51     'version' => \$Opt{'version'},
  52     'xml|x' => \$Opt{'xml'}
  53
  54 ) || die("$progname: Option error. Use -h for help.\n");
  55
  56 $Opt{'verbose'} -= $Opt{'quiet'};
  57 $Opt{'help'} && usage(0);
  58 if ($Opt{'version'}) {
  59     print_version();
  60     exit(0);
  61 }
  62
  63 exit(main());
  64
  65 sub main {
  66     # {{{
  67     my $Retval = 0;
  68
  69     my @Keywords = (
  70                     # List of recognised keywords {{{
  71                     "Id",
  72                     "Author", "LastChangedBy",
  73                     "Date", "LastChangedDate",
  74                     "LastChangedRevision", "Revision", "Rev",
  75                     "URL", "HeadURL",
  76                     "Header",
  77                     "Name",
  78                     "Locker",
  79                     "Log",
  80                     "RCSfile",
  81                     "Source",
  82                     "State"
  83                     # }}}
  84                    );
  85     my $Keyw = $Opt{'known'}
  86         ? join('|', @Keywords)
  87         : '[A-Za-z]+'; # Used in regexps
  88
  89     if ($Opt{'xml'}) {
  90         print(<<END);
  91 <?xml version="1.0"?>
  92 <sident>
  93 END
  94     }
  95
  96     my @Files = @ARGV;
  97     my $exit_val = 0;
  98
  99     if (length($Opt{'filesfrom'})) {
 100         # {{{
 101         if (open(FromFP, "<$Opt{'filesfrom'}")) {
 102             while(<FromFP>) {
 103                 chomp;
 104                 push(@Files, $_);
 105             }
 106             close(FromFP);
 107         } else {
 108             die("$progname: $Opt{'filesfrom'}: " .
 109                 "Cannot read filenames from file: $!\n");
 110         }
 111         # }}}
 112     }
 113
 114     for (@Files) {
 115         # {{{
 116         my @Out = ();
 117         my $File = $_;
 118         if (open(FromFP, "<$File")) {
 119             while (<FromFP>) {
 120                 $Opt{'expanded'} || s/(\$($Keyw)\$)/push(@Out, $1)/ge;
 121                 s/(\$($Keyw)::? .*? \$)/push(@Out, $1)/ge;
 122             }
 123             if (scalar(@Out)) {
 124
 125                 if ($Opt{'unique'}) {
 126                     my %Done = ();
 127                     my @Out2 = @Out;
 128                     @Out = ();
 129                     for my $Curr (@Out2) {
 130                         if (!defined($Done{$Curr})) {
 131                             push(@Out, $Curr);
 132                             $Done{$Curr} = 1;
 133                         }
 134                     }
 135                 }
 136
 137                 $Opt{'xml'} && print("  <file>\n");
 138                 if ($Opt{'namesonly'}) {
 139                     if ($Opt{'xml'}) {
 140                         printf("    <filename>%s</filename>\n",
 141                             txt_to_xml($File)
 142                         );
 143                     } else {
 144                         print("$File\n");
 145                     }
 146                 } else {
 147                     if ($Opt{'xml'}) {
 148                         printf("    <filename>%s</filename>\n",
 149                             txt_to_xml($File)
 150                         );
 151                     } else {
 152                         print("\n$File:\n");
 153                     }
 154                     $Opt{'xml'} && print("    <keywords>\n");
 155                     for (@Out) {
 156                         if ($Opt{'xml'}) {
 157                             printf("      <keyword>%s</keyword>\n",
 158                                 txt_to_xml($_));
 159                         } else {
 160                             print("     $_\n");
 161                         }
 162                     }
 163                     $Opt{'xml'} && print("    </keywords>\n");
 164                 }
 165                 $Opt{'xml'} && print("  </file>\n");
 166             } else {
 167                 if ($Opt{'verbose'} && !-d $File) {
 168                     $Opt{'xml'} && print("  <file>\n");
 169                     if ($Opt{'xml'}) {
 170                         printf("    <filename>%s</filename>\n",
 171                             txt_to_xml($File)
 172                         );
 173                     } else {
 174                         print("\n$File:\n");
 175                     }
 176                     $Opt{'xml'} && print("  </file>\n");
 177                 }
 178             }
 179         } else {
 180             warn("$progname: $File: Cannot read file: $!\n");
 181             $exit_val = 1;
 182         }
 183         # }}}
 184     }
 185
 186     $Opt{'xml'} && print("</sident>\n");
 187
 188     return $exit_val;
 189     # }}}
 190 } # main()
 191
 192 sub print_version {
 193     # Print program version {{{
 194     print("$progname $VERSION\n");
 195     return;
 196     # }}}
 197 } # print_version()
 198
 199 sub usage {
 200     # Send the help message to stdout {{{
 201     my $Retval = shift;
 202
 203     if ($Opt{'verbose'}) {
 204         print("\n");
 205         print_version();
 206     }
 207     print(<<"END");
 208
 209 Usage: $progname [options] [file [files [...]]]
 210
 211 Lists RCS-like keywords in a file.
 212
 213 Options:
 214
 215   -e, --expanded-only
 216     List only expanded keywords.
 217   -f, --filenames-from x
 218     Read filenames from file x in addition to files specified on the
 219     command line.
 220   -h, --help
 221     Show this help.
 222   -k, --known-keywords-only
 223     Only list keywords known to Subversion and CVS.
 224   -l, --filenames-only
 225     Suppress normal output; only list names of files which contain
 226     keywords.
 227   -q, --quiet
 228     Be more quiet. Can be repeated to increase silence.
 229   -u, --unique-keywords
 230     List keywords only once per file, avoid duplicates.
 231   -v, --verbose
 232     Increase level of verbosity. Can be repeated.
 233     One -v also list files without keywords.
 234   --version
 235     Print version information.
 236   -x, --xml
 237     Create XML output.
 238
 239 END
 240     exit($Retval);
 241     # }}}
 242 } # usage()
 243
 244 sub msg {
 245     # Print a status message to stderr based on verbosity level {{{
 246     my ($verbose_level, $Txt) = @_;
 247
 248     if ($Opt{'verbose'} >= $verbose_level) {
 249         print(STDERR "$progname: $Txt\n");
 250     }
 251     return;
 252     # }}}
 253 } # msg()
 254
 255 sub txt_to_xml {
 256     # Return a XML-safe version of a string {{{
 257     my $Txt = shift;
 258
 259     $Txt =~ s/&/&amp;/gs;
 260     $Txt =~ s/</&lt;/gs;
 261     $Txt =~ s/>/&gt;/gs;
 262     return($Txt);
 263     # }}}
 264 } # txt_to_xml()
 265
 266 __END__
 267
 268 # Plain Old Documentation (POD) {{{
 269
 270 =pod
 271
 272 =encoding UTF-8
 273
 274 =head1 NAME
 275
 276 sident
 277
 278 =head1 SYNOPSIS
 279
 280 sident [options] [file [files [...]]]
 281
 282 =head1 DESCRIPTION
 283
 284 Replacement for ident(1), lists RCS-like keywords in a file.
 285
 286 =head1 OPTIONS
 287
 288 =over 4
 289
 290 =item B<-e>, B<--expanded-only>
 291
 292 List only expanded keywords.
 293
 294 =item B<-f>, B<--filenames-from> x
 295
 296 Read filenames from file F<x> in addition to files specified on the
 297 command line.
 298
 299 =item B<-h>, B<--help>
 300
 301 Print a brief help summary.
 302
 303 =item B<-k>, B<--known-keywords-only>
 304
 305 Only list keywords known to Subversion and CVS.
 306
 307 =item B<-l>, B<--filenames-only>
 308
 309 Suppress normal output; only list names of files which contains
 310 keywords.
 311
 312 =item B<-u>, B<--unique-keywords>
 313
 314 Only list keywords once per file, avoid duplicates.
 315
 316 =item B<-q>, B<--quiet>
 317
 318 Be more quiet. Can be repeated to increase silence.
 319
 320 =item B<-v>, B<--verbose>
 321
 322 In addition to list keywords, also list names of files without keywords.
 323
 324 =item B<--version>
 325
 326 Print version information.
 327
 328 =item B<-x>, B<--xml>
 329
 330 Create XML output.
 331
 332 =back
 333
 334 =head1 BUGS
 335
 336 None that I know of.
 337
 338 =head1 AUTHOR
 339
 340 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 341
 342 =head1 COPYRIGHT
 343
 344 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 345 This is free software; see the file F<COPYING> for legalese stuff.
 346
 347 =head1 LICENCE
 348
 349 This program is free software: you can redistribute it and/or modify it
 350 under the terms of the GNU General Public License as published by the
 351 Free Software Foundation, either version 2 of the License, or (at your
 352 option) any later version.
 353
 354 This program is distributed in the hope that it will be useful, but
 355 WITHOUT ANY WARRANTY; without even the implied warranty of
 356 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 357 See the GNU General Public License for more details.
 358
 359 You should have received a copy of the GNU General Public License along
 360 with this program.
 361 If not, see L<http://www.gnu.org/licenses/>.
 362
 363 =head1 SEE ALSO
 364
 365 ident(1)
 366
 367 =cut
 368
 369 # }}}
 370
 371 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :