123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163
  1. #!/usr/bin/perl
  2. # make an executable file
  3. use strict;
  4. use warnings;
  5. sub usage; sub mkexec; sub guesstype; sub guesspurpose;
  6. sub getcmd; sub launch_editor;
  7. my $DEFAULT_TYPE = 'sh';
  8. my $DEFAULT_MODE = 0755;
  9. my $DEFAULT_FORCE = 0;
  10. my $DEFAULT_EDIT = 0;
  11. ## .... ## . . . . . . . . . . .
  12. ## INIT ## -------------------------------------------------------------------
  13. ## '''' ## ' ' ' ' ' ' ' ' ' ' '
  14. my $force = $DEFAULT_FORCE;
  15. my $edit = $DEFAULT_EDIT;
  16. my $name; my $type; my $purpose;
  17. foreach (@ARGV) {
  18. if (m/\b-f\b|\b--force\b/) {
  19. $force++;
  20. } elsif (m/\b-e\b|\b--edit\b/) {
  21. $edit++;
  22. } elsif (defined $type) {
  23. $purpose = $_;
  24. } elsif (defined $name) {
  25. $type = $_;
  26. } else {
  27. $name = $_;
  28. }
  29. }
  30. usage unless defined $name;
  31. $type = guesstype $name unless defined $type;
  32. $purpose = guesspurpose $name unless defined $purpose;
  33. my $bangs = {
  34. pl => `which perl`,
  35. sh => '/bin/sh',
  36. py => `which python`,
  37. bash => '/bin/bash',
  38. sed => `which sed`,
  39. bc => `which bc`,
  40. exp => `which expect` . " -f",
  41. };
  42. my $templates = {
  43. py => {
  44. '' => "if __name__ == '__main__':\n",
  45. test => "import unittest\n\n\n"
  46. . "class TestCase(unittest.TestCase):\n"
  47. . " pass\n\n\n"
  48. . "if __name__ == '__main__':\n"
  49. ." unittest.main()\n",
  50. },
  51. pl => {
  52. '' => "use strict;\nuse warnings;\n",
  53. test => "use strict;\nuse warnings;\nuse Test::More;\n\n",
  54. },
  55. bash => {
  56. 'ffoo' => "\n. \"\$(ffoom path)\" || exit 3\n\n"
  57. . "ffoo import pretty\n\n"
  58. . "FFOO_DEBUG=true",
  59. },
  60. };
  61. my $editors = [ qw/ vim editor / ];
  62. my $cmds;
  63. $cmds->{vim}->{test} = "vim --version 2>/dev/null";
  64. $cmds->{vim}->{run} = "vim +\"normal G\$\" '%s'";
  65. $cmds->{editor}->{test} = "editor --version 2>/dev/null";
  66. $cmds->{editor}->{run} = "editor '%s'";
  67. unless ($purpose eq ""
  68. or exists $templates->{$type}->{$purpose}) {
  69. warn "undefined purpose '$purpose' for type '$type'\n";
  70. $purpose = "";
  71. }
  72. ## ... ## # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
  73. ## RUN ## ----------------------------------------------------------------- #
  74. ## ''' ## # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
  75. if (exists $bangs->{$type}) {
  76. $force and -e $name
  77. and (defined `cp "$name" "$name~"` or die $!);
  78. (not -e $name or $force)
  79. and mkexec $name, mkbody($type, $purpose);
  80. chmod $DEFAULT_MODE, $name;
  81. launch_editor $name if $edit;
  82. } else {
  83. die "unknown type: $type\n";
  84. }
  85. ## .... ## ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''-.
  86. ## SUBZ ## ----------------------------------------------------------------- :
  87. ## '''' ## ..............................................................-'
  88. sub usage {
  89. print STDERR "usage: $0 [-f|-e] filename [type] [purpose]\n";
  90. exit 0;
  91. }
  92. sub guesstype {
  93. my $name = shift;
  94. my ($ext) = $name =~ m|\.(\w+)$|;
  95. return ( $ext ? $ext : $DEFAULT_TYPE);
  96. }
  97. sub guesspurpose {
  98. my $name = shift;
  99. my $testword = '[tT][eE][sS][tT]';
  100. return 'test' if $name =~ m|^test_|i;
  101. return 'test' if $name =~ m|_test.py$|i;
  102. return 'test' if $name =~ m|_test.pl$|i;
  103. return 'test' if $name =~ m|\btest\w*/|i;
  104. return 'test' if $name =~ m|.*Test/|i;
  105. return 'test' if $name =~ m|\bt/|;
  106. return ''
  107. }
  108. sub mkbody {
  109. my $type = shift;
  110. my $purpose = shift;
  111. my $tmpl = "";
  112. $tmpl .= $templates->{$type}->{$purpose}
  113. if exists $templates->{$type}
  114. and exists $templates->{$type}->{$purpose};
  115. return sprintf "#!%s\n%s\n", $bangs->{$type}, $tmpl;
  116. }
  117. sub mkexec {
  118. my ($name, $body) = @_;
  119. open EXE, ">", $name or die "cannot open $name for writing: $!\n";
  120. -W EXE or die "file $name is not writable\n";
  121. print EXE $body;
  122. close EXE or die "cannot close $name: $!\n";
  123. }
  124. sub get_cmd {
  125. foreach (@$editors) {
  126. return $cmds->{$_}->{run} if `$cmds->{$_}->{test}`
  127. }
  128. warn "no supported editor available\n";
  129. return;
  130. }
  131. sub launch_editor {
  132. my $name = shift;
  133. my $form = get_cmd;
  134. if ($form) {
  135. my $command = sprintf get_cmd, $name;
  136. exec "$command";
  137. } else { return }
  138. warn "failed to launch editor: $form\n";
  139. }