rename_by_firstline

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 use strict;
   4 require v5.10.0;
   5 our $VERSION = 'v0.1';
   6
   7 BEGIN
   8 {
   9     my $PROGRAM_DIR = $0;
  10     $PROGRAM_DIR =~ s/[^\/\\]+$//;
  11     $PROGRAM_DIR = "./" unless($PROGRAM_DIR);
  12     unshift @INC,
  13         map "$PROGRAM_DIR$_",qw{modules lib ../modules ..lib};
  14 }
  15
  16 my %OPTS;
  17 my @OPTIONS = qw/help|h|? version|ver edit-me manual|man/;
  18
  19 if(@ARGV)
  20 {
  21     require Getopt::Long;
  22     require MyPlace::Usage;
  23     Getopt::Long::GetOptions(\%OPTS,@OPTIONS);
  24     MyPlace::Usage::Process(\%OPTS,$VERSION);
  25 }
  26 else
  27 {
  28     require MyPlace::Usage;
  29     MyPlace::Usage::PrintHelp();
  30 }
  31
  32 die("Invalid Usage\n") unless(@ARGV);
  33 foreach my $org_filename (@ARGV)
  34 {
  35     if(-f $org_filename)
  36     {
  37         if(open FI,"<",$org_filename)
  38         {
  39             my $new_basename;
  40             while(<FI>)
  41             {
  42                 s/^[\s\n\r]+//;
  43                 s/[\s\n\r]+$//;
  44                 next unless($_);
  45                 $new_basename = $_;
  46                 last;
  47             }
  48             close FI;
  49             if($new_basename)
  50             {
  51                 my $ext_name = "";
  52                 my $dirname = $org_filename;
  53                 if($dirname =~ m/^(.*)\.([^\.]+)$/)
  54                 {
  55                     $dirname = $1;
  56                     $ext_name = ".$2";
  57                 }
  58                 if($dirname =~ /^(.+)\/[^\/]*$/) {
  59                     $dirname = "$1/";
  60                 }
  61                 else {
  62                     $dirname = "";
  63                 }
  64                 my $new_name = "$dirname$new_basename$ext_name";
  65                 if($new_name eq $org_filename)
  66                 {
  67                     print STDERR "$org_filename: New name is the same as orginal name\n";
  68                     next;
  69                 }
  70                 else
  71                 {
  72                     print STDERR "Rename $org_filename to $new_name\n";
  73                     system("mv","-v","--",$org_filename,$new_name) unless($OPTS{'--test'});
  74                 }
  75             }
  76             else
  77             {
  78                 print STDERR "$org_filename MAYBE NOT contains any NON-EMPTY line\n";
  79                 print STDERR "$org_filename Skipped.\n";
  80             }
  81         }
  82         else
  83         {
  84             print STDERR "$!\n";
  85         }
  86     }
  87     else {
  88         print STDERR "File not accessible : $org_filename\n";
  89     }
  90 }
  91
  92 __END__
  93
  94 =pod
  95
  96 =head1  NAME
  97
  98 rename_by_firstline - rename files according to the FIRST NON-EMPTY LINE
  99
 100 =head1  SYNOPSIS
 101
 102 rename_by_firstline [options] file1 [file2...]
 103
 104 =head1  OPTIONS
 105
 106 =over 12
 107
 108 =item B<--version>
 109
 110 Print version infomation.
 111
 112 =item B<-h>,B<--help>
 113
 114 Print a brief help message and exits.
 115
 116 =item B<--manual>,B<--man>
 117
 118 View application manual
 119
 120 =item B<--edit-me>
 121
 122 Invoke 'editor' against the source
 123
 124 =item B<--test>
 125
 126 Do not perform renaming action
 127
 128 =back
 129
 130 =head1  DESCRIPTION
 131
 132 rename files according to the FIRST NON-EMPTY LINE
 133
 134 =head1  CHANGELOG
 135
 136     2010-06-08  xiaoranzzz  <xiaoranzzz@myplace.hell>
 137
 138         * file created.
 139
 140 =head1  AUTHOR
 141
 142 xiaoranzzz <xiaoranzzz@myplace.hell>
 143
 144 =cut
 145
 146