|  | @@ -4,7 +4,8 @@
 | 
	
		
			
			| 4 | 4 |  use strict;
 | 
	
		
			
			| 5 | 5 |  use warnings;
 | 
	
		
			
			| 6 | 6 |  
 | 
	
		
			
			| 7 |  | -sub usage; sub mkexec; sub guesstype; sub getcmd; sub launch_editor;
 | 
	
		
			
			|  | 7 | +sub usage; sub mkexec; sub guesstype; sub guesspurpose;
 | 
	
		
			
			|  | 8 | +sub getcmd; sub launch_editor;
 | 
	
		
			
			| 8 | 9 |  
 | 
	
		
			
			| 9 | 10 |  my $DEFAULT_TYPE = 'sh';
 | 
	
		
			
			| 10 | 11 |  my $DEFAULT_MODE = 0755;
 | 
	
	
		
			
			|  | @@ -17,7 +18,7 @@ my $DEFAULT_EDIT = 0;
 | 
	
		
			
			| 17 | 18 |  ## '''' ##   ' ' '  '   '    '     '      '       '        '         '
 | 
	
		
			
			| 18 | 19 |  
 | 
	
		
			
			| 19 | 20 |  my $force = $DEFAULT_FORCE;
 | 
	
		
			
			| 20 |  | -my $name; my $type; my $edit;
 | 
	
		
			
			|  | 21 | +my $name; my $type; my $purpose; my $edit;
 | 
	
		
			
			| 21 | 22 |  
 | 
	
		
			
			| 22 | 23 |  foreach (@ARGV) {
 | 
	
		
			
			| 23 | 24 |      if (m/-f|--force/) {
 | 
	
	
		
			
			|  | @@ -26,6 +27,8 @@ foreach (@ARGV) {
 | 
	
		
			
			| 26 | 27 |          $edit++;
 | 
	
		
			
			| 27 | 28 |      } elsif (m/-E|--no-edit/) {
 | 
	
		
			
			| 28 | 29 |          $edit = 0;
 | 
	
		
			
			|  | 30 | +    } elsif (defined $type) {
 | 
	
		
			
			|  | 31 | +        $purpose = $_;
 | 
	
		
			
			| 29 | 32 |      } elsif (defined $name) {
 | 
	
		
			
			| 30 | 33 |          $type = $_;
 | 
	
		
			
			| 31 | 34 |      } else {
 | 
	
	
		
			
			|  | @@ -35,6 +38,7 @@ foreach (@ARGV) {
 | 
	
		
			
			| 35 | 38 |  
 | 
	
		
			
			| 36 | 39 |  usage unless defined $name;
 | 
	
		
			
			| 37 | 40 |  $type = guesstype $name unless defined $type;
 | 
	
		
			
			|  | 41 | +$purpose = guesspurpose $name unless defined $purpose;
 | 
	
		
			
			| 38 | 42 |  
 | 
	
		
			
			| 39 | 43 |  my $bangs = {
 | 
	
		
			
			| 40 | 44 |      pl   => `which perl`,
 | 
	
	
		
			
			|  | @@ -46,8 +50,18 @@ my $bangs = {
 | 
	
		
			
			| 46 | 50 |  };
 | 
	
		
			
			| 47 | 51 |  
 | 
	
		
			
			| 48 | 52 |  my $templates = {
 | 
	
		
			
			| 49 |  | -    pl   => "use strict;\nuse warnings;\n",
 | 
	
		
			
			| 50 |  | -    py   => "if __name__ == '__main__':\n"
 | 
	
		
			
			|  | 53 | +    py => {
 | 
	
		
			
			|  | 54 | +        ''      => "if __name__ == '__main__':\n",
 | 
	
		
			
			|  | 55 | +        test    => "import unittest\n\n\n"
 | 
	
		
			
			|  | 56 | +                   . "class TestCase(unittest.TestCase):\n"
 | 
	
		
			
			|  | 57 | +                   . "    pass\n\n\n"
 | 
	
		
			
			|  | 58 | +                   . "if __name__=='__main__':\n"
 | 
	
		
			
			|  | 59 | +                   ."    unittest.main()\n",
 | 
	
		
			
			|  | 60 | +    },
 | 
	
		
			
			|  | 61 | +    pl => {
 | 
	
		
			
			|  | 62 | +        ''      => "use strict;\nuse warnings;\n",
 | 
	
		
			
			|  | 63 | +        test    => "use strict;\nuse warnings;\nuse Test::More;\n\n",
 | 
	
		
			
			|  | 64 | +    }
 | 
	
		
			
			| 51 | 65 |  };
 | 
	
		
			
			| 52 | 66 |  
 | 
	
		
			
			| 53 | 67 |  my $editors = [ qw/ vim editor / ];
 | 
	
	
		
			
			|  | @@ -57,6 +71,11 @@ $cmds->{vim}->{run}     = "vim +\"normal G\$\" '%s'";
 | 
	
		
			
			| 57 | 71 |  $cmds->{editor}->{test} = "editor --version 2>/dev/null";
 | 
	
		
			
			| 58 | 72 |  $cmds->{editor}->{run}  = "editor '%s'";
 | 
	
		
			
			| 59 | 73 |  
 | 
	
		
			
			|  | 74 | +unless (exists $templates->{$type}->{$purpose}) {
 | 
	
		
			
			|  | 75 | +    warn "undefined purpose '$purpose' for type '$type'\n";
 | 
	
		
			
			|  | 76 | +    $purpose = "";
 | 
	
		
			
			|  | 77 | +}
 | 
	
		
			
			|  | 78 | +
 | 
	
		
			
			| 60 | 79 |  
 | 
	
		
			
			| 61 | 80 |  ## ... ##   # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
 | 
	
		
			
			| 62 | 81 |  ## RUN ## ----------------------------------------------------------------- #
 | 
	
	
		
			
			|  | @@ -66,7 +85,7 @@ if (exists $bangs->{$type}) {
 | 
	
		
			
			| 66 | 85 |      $force and -e $name
 | 
	
		
			
			| 67 | 86 |          and (defined `cp "$name" "$name~"` or die $!);
 | 
	
		
			
			| 68 | 87 |      (not -e $name or $force)
 | 
	
		
			
			| 69 |  | -        and mkexec $name, mkbody($type);
 | 
	
		
			
			|  | 88 | +        and mkexec $name, mkbody($type, $purpose);
 | 
	
		
			
			| 70 | 89 |      chmod $DEFAULT_MODE, $name;
 | 
	
		
			
			| 71 | 90 |      launch_editor $name if $edit;
 | 
	
		
			
			| 72 | 91 |  } else {
 | 
	
	
		
			
			|  | @@ -79,7 +98,7 @@ if (exists $bangs->{$type}) {
 | 
	
		
			
			| 79 | 98 |  ## '''' ##   ..............................................................-'
 | 
	
		
			
			| 80 | 99 |  
 | 
	
		
			
			| 81 | 100 |  sub usage {
 | 
	
		
			
			| 82 |  | -    print STDERR "usage: $0 [-f|-E] filename [type]\n";
 | 
	
		
			
			|  | 101 | +    print STDERR "usage: $0 [-f|-E] filename [type] [purpose]\n";
 | 
	
		
			
			| 83 | 102 |      exit 0;
 | 
	
		
			
			| 84 | 103 |  }
 | 
	
		
			
			| 85 | 104 |  
 | 
	
	
		
			
			|  | @@ -89,10 +108,23 @@ sub guesstype {
 | 
	
		
			
			| 89 | 108 |      return ( $ext ? $ext : $DEFAULT_TYPE);
 | 
	
		
			
			| 90 | 109 |  }
 | 
	
		
			
			| 91 | 110 |  
 | 
	
		
			
			|  | 111 | +sub guesspurpose {
 | 
	
		
			
			|  | 112 | +    my $name = shift;
 | 
	
		
			
			|  | 113 | +    my $testword = '[tT][eE][sS][tT]';
 | 
	
		
			
			|  | 114 | +    return 'test' if $name =~ m|^test_|i;
 | 
	
		
			
			|  | 115 | +    return 'test' if $name =~ m|_test.py$|i;
 | 
	
		
			
			|  | 116 | +    return 'test' if $name =~ m|_test.pl$|i;
 | 
	
		
			
			|  | 117 | +    return 'test' if $name =~ m|\btest\w*/|i;
 | 
	
		
			
			|  | 118 | +    return 'test' if $name =~ m|.*Test/|i;
 | 
	
		
			
			|  | 119 | +    return 'test' if $name =~ m|\bt/|;
 | 
	
		
			
			|  | 120 | +    return ''
 | 
	
		
			
			|  | 121 | +}
 | 
	
		
			
			|  | 122 | +
 | 
	
		
			
			| 92 | 123 |  sub mkbody {
 | 
	
		
			
			| 93 | 124 |      my $type = shift;
 | 
	
		
			
			|  | 125 | +    my $purpose = shift;
 | 
	
		
			
			| 94 | 126 |      my $tmpl = "";
 | 
	
		
			
			| 95 |  | -    $tmpl .= $templates->{$type} if exists $templates->{$type};
 | 
	
		
			
			|  | 127 | +    $tmpl .= $templates->{$type}->{$purpose} if exists $templates->{$type};
 | 
	
		
			
			| 96 | 128 |      return sprintf "#!%s\n%s\n", $bangs->{$type}, $tmpl;
 | 
	
		
			
			| 97 | 129 |  }
 | 
	
		
			
			| 98 | 130 |  
 |