pmnew

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 use strict;
   4 require v5.10.0;
   5 our $VERSION = 'v0.2';
   6 BEGIN
   7 {
   8     our $PROGRAM_DIR = $ENV{XR_PERL_SOURCE_DIR};
   9     unless($PROGRAM_DIR) {
  10         $PROGRAM_DIR = $0;
  11         $PROGRAM_DIR =~ s/[^\/\\]+$//;
  12         $PROGRAM_DIR =~ s/(.)\/+$/$1/;
  13         $PROGRAM_DIR = "." unless($PROGRAM_DIR);
  14     }
  15     unshift @INC,
  16         map "$PROGRAM_DIR/$_",qw{modules lib ../modules ..lib};
  17 }
  18 my %OPTS;
  19 my @OPTIONS = qw/stdout|o stdin|i simple|s help|h|? version|ver edit-me manual|man/;
  20 if(@ARGV)
  21 {
  22     require Getopt::Long;
  23     require MyPlace::Usage;
  24     Getopt::Long::GetOptions(\%OPTS,@OPTIONS);
  25     MyPlace::Usage::Process(\%OPTS,$VERSION);
  26 }
  27 else
  28 {
  29     require MyPlace::Usage;
  30     MyPlace::Usage::PrintHelp();
  31     exit 0;
  32 }
  33
  34
  35 my $module_name=shift;
  36 if(!$module_name) {
  37     require MyPlace::Usage;
  38     MyPlace::Usage::PrintHelp();
  39     exit 0;
  40 }
  41
  42 our $PROGRAM_DIR;
  43 my $OUTPUT_DIR=$PROGRAM_DIR . "/modules";
  44
  45 #Output to STDOUT
  46 if($OPTS{stdout}) {
  47     open FO,">&STDOUT" or die("fatal: can't not duplicate STDOUT\n");
  48 }
  49 else {
  50     my $pn = $module_name;
  51     $pn =~ s/::/\//g;
  52     die "Can't not locate script directory.\n" if(!$OUTPUT_DIR);
  53     die "Direcoty not exists:\"$OUTPUT_DIR\"\n" if (! -d $OUTPUT_DIR);
  54     my $fn="$OUTPUT_DIR/$pn.pm";
  55     my $dn=$fn;
  56     $dn =~ s/\/[^\/]+$/\//;
  57     if(!-d $dn) {
  58         system("mkdir","-p",$dn) and die("$!\n");
  59     }
  60     exit system("r-vim",$fn) if(-f $fn);
  61     open FO,"|-","r-vim - -c \"file \"$fn\"\"" or die("$!\n");
  62 }
  63
  64
  65
  66 my @TEXT;
  67
  68 if($OPTS{simple}) {
  69     @TEXT = ("#!/usr/bin/perl -w\n","use strict;\n");
  70 }
  71 elsif($OPTS{read}) {
  72     @TEXT = <STDIN>;
  73 }
  74 elsif(open FI,"<","$OUTPUT_DIR/perl_module.template") {
  75     @TEXT=<FI>;
  76     close FI;
  77 }
  78 else {
  79 @TEXT=<<'EOF'
  80 #!/usr/bin/perl -w
  81 use strict;
  82 use warnings;
  83 BEGIN {
  84     require Exporter;
  85     our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
  86     $VERSION        = 1.00;
  87     @ISA            = qw(Exporter);
  88     @EXPORT         = qw();
  89     @EXPORT_OK      = qw();
  90 }
  91 1;
  92 EOF
  93 ;
  94 }
  95 use Env qw/USER HOSTNAME/;
  96 use POSIX qw/strftime/;
  97 my $DATE= strftime("%Y-%m-%d %H:%M",localtime());
  98 $USER="xiaoranzzz" unless($USER);
  99 my $EMAIL="$USER\@" . (defined $HOSTNAME ? $HOSTNAME : "myplace.hell");
 100 foreach(@TEXT) {
 101     s/___NAME___/$module_name/g;
 102     s/___AUTHOR___/$USER/g;
 103     s/___EMAIL___/$EMAIL/g;
 104     s/___DATE___/$DATE/g;
 105     print FO $_;
 106 }
 107 close FO;
 108
 109 __END__
 110
 111 =pod
 112
 113 =head1  NAME
 114
 115 pmnew - create new perl module
 116
 117 =head1  SYNOPSIS
 118
 119 pmnew [options] <module name>
 120
 121 =head1  OPTIONS
 122
 123 =over 12
 124
 125 =item B<-i>,B<--stdin>
 126
 127 Read template from STDIN
 128
 129 =item B<-o>,B<--stdout>
 130
 131 Write to STDOUT
 132
 133 =item B<-s>,B<--simple>
 134
 135 Disable using template.
 136
 137 =item B<--version>
 138
 139 Print version infomation.
 140
 141 =item B<-h>,B<--help>
 142
 143 Print a brief help message and exits.
 144
 145 =item B<--manual>,B<--man>
 146
 147 View application manual
 148
 149 =item B<--edit-me>
 150
 151 Invoke 'editor' against the source
 152
 153 =back
 154
 155 =head1  FILES
 156
 157 =item B<$XR_PERL_MODULE_DIR>
 158
 159     Output directory environment variable
 160
 161 =item $XR_PERL_MODULE_DIR\B<perl_module.template>
 162
 163     Module template file
 164
 165 =back
 166
 167 =head1  DESCRIPTION
 168
 169 Create perl module with custumized template. By default, created module
 170 will saved in directory "$XR_PERL_MODULE_DIR".
 171
 172 =head1  CHANGELOG
 173
 174     2008-05-06 15:07 xiaoranzzz <xiaoranzzz@myplace.hell>
 175
 176         * initial version 0.1
 177
 178     2010-11-09 20:56 xiaoranzzz  <xiaoranzzz@myplace.hell>
 179
 180         * rewrote, version 0.2
 181
 182 =head1  AUTHOR
 183
 184 xiaoranzzz <xiaoranzzz@myplace.hell>
 185
 186 =cut
 187
 188
 189