home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / tutorial / eg / now-what < prev    next >
Encoding:
Text File  |  1990-03-11  |  10.8 KB  |  488 lines
  1. #!/usr/bin/perl
  2.  
  3. ($program = $0) =~ s,.*/,,;
  4.  
  5. $| = 1;
  6.  
  7. &source('sys/ioctl.pl');
  8.  
  9.  
  10. @SW = ( '-draftmessage draftmessage',
  11.               '-draftfolder +folder',
  12.               '-nodraftfolder',
  13.               '-editor editor',
  14.               '-noeditor',
  15.               '-prompt prompt',
  16.               '-help'
  17.       );
  18.  
  19.  
  20. %cmds = (
  21.     ' ',    'help',
  22.     "\n",    'help',
  23.     '?',    'help',
  24.     'E',    'switch-editor',
  25.     'L',    'display-alternate',
  26.     'Q',    'quit-delete',
  27.     's',    'spell',
  28.     'd',    'quit-delete',
  29.     'e',    'edit',
  30.     'h',    'header',
  31.     't',    'type',
  32.     'l',    'list',
  33.     'p',    'push',
  34.     'q',    'quit',
  35.     'r',    'refile',
  36.     'S',    'send',
  37.     'w',    'whom',
  38.     'W',    'watch',
  39.     'y',    'syslog',
  40.     '!',    'shell'    
  41. );
  42.  
  43. #print "args are $0 $ARGS\n";
  44. #print "environment:\n";
  45. #for $key ( sort grep(/^[a-z]+$/, keys %ENV)) {
  46.     #printf "\t%%-12s = %s\n", $key, $ENV{$key};
  47. #} 
  48.  
  49. if ($ENV{'mhaltmsg'}) {
  50.     unlink '@';
  51.     symlink($ENV{'mhaltmsg'}, '@'); 
  52.     $linked = 1;
  53. }
  54.  
  55. while (($cmd, $fun) = each %cmds) {
  56.     $fun =~ s/-/_/g;
  57.     if (eval "!defined &$fun") {
  58.     print $program, ": warning: key `", $cmd, 
  59.         "' bound to undefined function `",$fun, "'\n";
  60.     } 
  61. } 
  62.  
  63. ($draftmessage = $ENV{'mhdraft'});
  64.  
  65. &mh_profile; 
  66.  
  67. if ($MH{$program}) {
  68.     unshift(@ARGV,split(' ',$MH{$program}));
  69. }
  70.  
  71. &mh_parse;
  72.  
  73. if ($MH{'msg-protect'}) {
  74.     $mask = oct($MH{'msg-protect'});
  75.     umask (~$mask & 0777);
  76. } 
  77.  
  78. die "$program: only one draft at a time!\n" 
  79.     if $#ARGV > 0;
  80.  
  81. $draftmessage = shift if $#ARGV == 0;
  82.  
  83. ($editor = $SW{'editor'}) || 
  84. ($editor = $ENV   {'mheditor'})  ||
  85. ($editor = $MH    {'editor'}) || 
  86. ($editor = $ENV   {'EDITOR'}) ||
  87. ($editor = 'vi');
  88.  
  89. ($pager = $MH{'listproc'})  ||
  90. ($pager = $ENV{'PAGER'})    ||
  91. ($pager = 'more');
  92.  
  93. $SW{'nodraftfolder'} ||
  94.     ($draftfolder = $SW{'draftfolder'}) || 
  95.     ($draftfolder = $MH    {'draft-folder'});
  96.  
  97. $SW{'noeditor'} = 1 unless $draftmessage;
  98.  
  99. if ($draftfolder) {
  100.     $draftmessage = &mhpath($draftfolder, 
  101.         $SW{'draftmessage'} ? $SW{'draftmessage'} : 'last')
  102.         unless $draftmessage;
  103. } else {
  104.     $draftmessage = $MH{'path'} . '/' . 'drafts'
  105.         unless $draftmessage;
  106. } 
  107.  
  108. $SIG{'TERM'} = 'quit';
  109.  
  110. &edit unless $SW{'noeditor'};
  111.  
  112. $prompt = 'What now' unless $prompt = $SW{'prompt'};
  113.  
  114. $SIG{'CONT'} = 'continue';
  115.  
  116. for (;;) {
  117.     print "\n$prompt? ";
  118.     $cmd = &readtty;
  119.     ($fun = $cmds{$cmd}) =~ s/-/_/g;
  120.     if (defined $cmds{$cmd}) {
  121.     if (eval "defined &$fun") {
  122.         print $cmds{$cmd}, "\n";
  123.         &$fun;
  124.     } else {
  125.         print "$program: can't call undefined subroutine $fun\n";
  126.     }
  127.     } else {
  128.     printf "$cmd -- unknown command: `%s' (0x%02x)\n", $cmd, ord($cmd);
  129.     } 
  130. } 
  131.  
  132. exit (0);
  133.  
  134.  
  135. # ----------------------------------------------------------------------
  136. sub mh_parse {
  137.     local(@argdesc) =  @SW;
  138.     local($wantarg);
  139.  
  140.     grep(s/(\W)/\\$1/g, @argdesc);
  141.  
  142.     while ($ARGV[0] =~ /^-.+/) {
  143.     $ARGV = shift @ARGV;
  144.  
  145.     unless (@matches = grep(/$ARGV/, @argdesc)) {
  146.         print "$program: unknown option: $ARGV\n";
  147.         exit 1;
  148.         &usage;
  149.     } 
  150.  
  151.     for (@matches) { s/\\(\W)/$1/g; } 
  152.  
  153.     if ($#matches > $[) {
  154.         print "$program: ambiguous switch $ARGV matches:\n";
  155.         for (@matches) { 
  156.         print "\    ", $_, "\n"; 
  157.         }
  158.         exit 1;
  159.     } 
  160.  
  161.     ($switch,$wantarg) = $matches[$[] =~ /^-(\S+)\s*(\S*)/;
  162.  
  163.     $SW{$switch} = $wantarg ? shift @ARGV : 1;
  164.     if ($SW{$switch} =~ /^(['"]).*$/ && $SW{$switch} !~ /^(['"]).*\1$/) {
  165.         do {
  166.         $SW{$switch} .= ' ' . (shift @ARGV);
  167.         } until $#ARGV < 0 || $SW{$switch} =~ /^(['"]).*\1$/;
  168.         $SW{$switch} =~ s/^(['"])(.*)\1$/$2/;
  169.     } 
  170.     }
  171. }
  172.  
  173. # ----------------------------------------------------------------------
  174. sub source {
  175.     local($file) = @_;
  176.     local($return) = 0;
  177.  
  178.     $return = do $file;
  179.     die "couldn't do \"$file\": $!" unless defined $return;
  180.     die "couldn't parse \"$file\": $@" if $@;
  181.     die "couldn't run \"$file\"" unless $return;
  182. } 
  183.  
  184. # ----------------------------------------------------------------------
  185. sub usage {
  186.     # global $SW
  187.     $pos = 0;
  188.  
  189.     print "syntax: $0 [switches] [files]\n   switches are:\n    ";
  190.     $pos = 4;
  191.  
  192.     for (@SW) {
  193.     if (($pos += length) > 80)  {
  194.         print "\n    ";
  195.         $pos = 4 + length;
  196.     } 
  197.     print $_, " ";
  198.     $pos++;
  199.     } 
  200.     print "\n";
  201.     exit(1);
  202. } 
  203.  
  204. # ----------------------------------------------------------------------
  205. sub mh_profile {
  206.     local($PROFILE);
  207.  
  208.     ($PROFILE = $ENV{"MH"}) || ($PROFILE = $ENV{"HOME"} . "/.mh_profile");
  209.  
  210.     open PROFILE || "$0: can't read mh_profile $PROFILE: $!\n";
  211.  
  212.     while (<PROFILE>) {
  213.     next if /^#/;
  214.     next unless ($key, $value) = /([^:\s]+):\s*(.+)/;
  215.     $key =~ tr/A-Z/a-z/;
  216.     $MH{$key} = $value;
  217.     } 
  218.     close PROFILE;
  219.     $MH{'path'} = $ENV{'HOME'} . '/' . $MH{'path'};
  220. } 
  221.  
  222. # ----------------------------------------------------------------------
  223. sub mhpath {
  224.     local($folder, $msg) = ($_[0], $_[1]);
  225.     local($biggest) = 0;
  226.  
  227.     $folder =~ s/^\+//;
  228.  
  229.     $folder = $MH{'path'} . '/' . $folder 
  230.     unless $folder =~ m!^/!;
  231.  
  232.     if (-d $folder) {
  233.     if ($msg eq 'new' || $msg eq 'last') {
  234.         opendir(FOLDER, $folder) 
  235.         || die "$program: can't opendir $folder: $!\n";
  236.         while ($msg = readdir(FOLDER)) {
  237.         next unless $msg =~ /^\d+$/;
  238.         $biggest = $msg if $msg > $biggest;
  239.         } 
  240.         closedir FOLDER;
  241.         $msg = $biggest + (($msg eq 'new') ? 1 : 0);
  242.     } 
  243.     } else {
  244.     if (-t) {{
  245.         print "Create folder \"$folder\"? ";
  246.         chop($answer = <STDIN>);
  247.         last     if 'yes' =~ /^$answer/i;
  248.         &exit(0)    if 'no' =~ /^$answer/;
  249.         print "$answer: unknown response\n";
  250.         redo;
  251.     }}
  252.     if (defined $MH{'folder-protect'}) {
  253.         $mode = oct($MH{'folder-protect'});
  254.     } else {
  255.         $mode = 0755;
  256.     } 
  257.     mkdir($folder,$mode) || die "program: can't mkdir $folder: $!\n";
  258.     } 
  259.  
  260.     $folder . '/' . $msg;
  261. } 
  262.  
  263. # ----------------------------------------------------------------------
  264. sub readtty {
  265.     local($cmd);
  266.     &cbreak;
  267.     $cmd = getc(STDIN);
  268. } 
  269.  
  270.  
  271. # ----------------------------------------------------------------------
  272. sub continue { 
  273.     print "$prompt? ";
  274.     &cbreak; 
  275. }
  276.  
  277. # ----------------------------------------------------------------------
  278. sub cbreak {
  279.     &set_cbreak(1);
  280. } 
  281.  
  282. # ----------------------------------------------------------------------
  283. sub cooked {
  284.     &set_cbreak(0);
  285. } 
  286.  
  287. # ----------------------------------------------------------------------
  288. sub set_cbreak {
  289.     local($on) = $_[0];
  290.     local($sgttyb);
  291.  
  292.     $sgttyb_t   = 'C4 S' unless $sgttyb_t;
  293.  
  294.     ioctl(STDIN,$TIOCGETP,$sgttyb) 
  295.     || die "Can't ioctl TIOCGETP: $!";
  296.  
  297.  
  298.     @ary = unpack($sgttyb_t,$sgttyb);
  299.     if ($on) {
  300.     $ary[4] |= $CBREAK;
  301.     $ary[4] &= ~$ECHO;
  302.     } else {
  303.     $ary[4] &= ~$CBREAK;
  304.     $ary[4] |= $ECHO;
  305.     }
  306.     $sgttyb = pack($sgttyb_t,@ary);
  307.     ioctl(STDIN,$TIOCSETP,$sgttyb)
  308.         || die "Can't ioctl TIOCSETP: $!";
  309.  
  310. }
  311.  
  312. # ----------------------------------------------------------------------
  313. sub help {
  314.     print "Key\tRoutine\n";
  315.     for $key (sort keys %cmds) {
  316.     next if $key =~ /\s/;
  317.     $fun = $cmds{$key};
  318.     $fun =~ s/_/-/g;
  319.     print "$key\t$fun\n";
  320.     }
  321. } 
  322.  
  323. # ----------------------------------------------------------------------)
  324. sub quit {
  325.     $SIG{'TTOU'} = "IGNORE";
  326.     print "$program: draft left on $draftmessage\n"
  327.     if -e $draftmessage;
  328.     &cooked;
  329.     &exit(0);
  330. } 
  331.  
  332. sub exit {
  333.     unlink '@' if $linked;
  334.     exit $_[0];
  335. } 
  336. # ----------------------------------------------------------------------
  337. sub edit {
  338.     local($status, $sigs, $next);
  339.     $status = &run($editor,$draftmessage);
  340.     $sigs = $status & 0xff;;
  341.     $status >>= 8;
  342.     if ($status == 255) {
  343.     print "$program: couldn't exec $editor: $!\n";
  344.     return $status;
  345.     } 
  346.     $editor = $next if $next = $MH{$editor.'-next'};
  347.     return 0 unless $status;
  348.     print "$program: problems with edit--$draftmessage ", 
  349.     $sigs ? "preserved" : "deleted", ".\n" if $status;
  350.     unlink $draftmessage if $status && !$sigs;
  351.     exit 1;
  352. } 
  353.  
  354. # ----------------------------------------------------------------------
  355. sub switch_editor {
  356.     local($neweditor);
  357.     if ($neweditor = &prompt('New editor')) { 
  358.     $editor = $neweditor;
  359.     &edit;
  360.     } else {
  361.     print "(editor still $editor)\n";
  362.     } 
  363. } 
  364.  
  365. # ----------------------------------------------------------------------
  366. sub list {
  367.     &run($pager,$draftmessage);
  368. } 
  369.  
  370. # ----------------------------------------------------------------------
  371. sub intr { } 
  372. sub run {
  373.     local(@cmd);
  374.     $SIG{'INT'} = $SIG{'QUIT'} = 'intr';
  375.     &cooked;
  376.     @cmd = split(' ',"@_");
  377.     $status = system @cmd;
  378.     &cbreak;
  379.     $mystat = ($status >> 8) & 0xff;
  380.     if ($mystat == 0xff) {
  381.     print "$program: couldn't run \"@_\": $!\n";
  382.     } else {
  383.     print "$program: \"@_\" returned $mystat\n"
  384.         if $mystat;
  385.     } 
  386.     $SIG{'INT'} = $SIG{'QUIT'} = 'DEFAULT';
  387.     return $status;
  388. } 
  389.  
  390.  
  391. # ----------------------------------------------------------------------
  392. sub quit_delete {
  393.     unlink($draftmessage) 
  394.     || warn "$program: unable to unlink $draftmessage: $!\n";
  395.     &quit;
  396. } 
  397.  
  398. # ----------------------------------------------------------------------
  399. sub push {
  400.     &exit(&run('send','-push', $draftmessage));
  401. } 
  402.  
  403. # ----------------------------------------------------------------------
  404. sub refile {
  405.      local($folder);
  406.      return unless $folder = &prompt("Refile into");
  407.      &run('refile',$folder);
  408. } 
  409.  
  410. # ----------------------------------------------------------------------
  411. sub send {
  412.     &exit(&run('send',$draftmessage));
  413. } 
  414.  
  415. # ----------------------------------------------------------------------
  416. sub spell {
  417.     local($spell) = $MH{'spellproc'};
  418.     $spell = 'spell' unless $spell;
  419.     &run($spell, $draftmessage);
  420. } 
  421.  
  422. # ----------------------------------------------------------------------
  423. sub display_alternate {
  424.     local($alt) = $ENV{'mhaltmsg'};
  425.     if (! $alt) {
  426.     print "No alternate message to display\n";
  427.     } else {
  428.     &run($pager,$alt);
  429.     } 
  430. } 
  431.  
  432. # ----------------------------------------------------------------------
  433. sub prompt {
  434.     local($prompt) = $_[0];
  435.     local($retval);
  436.     &cooked;
  437.     print "$prompt? ";
  438.     chop($retval = <STDIN>);
  439.     return $retval;
  440. } 
  441.  
  442. # ----------------------------------------------------------------------
  443. sub whom {
  444.     &run('whom', $draftmessage);
  445. } 
  446.  
  447. # ----------------------------------------------------------------------
  448. sub watch {
  449.     &exit(&run('send -nopush -watch -verbose', $draftmessage));
  450. } 
  451.  
  452. # ----------------------------------------------------------------------
  453. sub syslog {
  454.     &run('tail -f /usr/spool/mqueue/syslog');
  455. } 
  456.  
  457. # ----------------------------------------------------------------------
  458. sub header {
  459.     if (!open draftmessage) {
  460.     warn "$program: no $draft message\n";
  461.     return;
  462.     } 
  463.     while (<draftmessage>) {
  464.     last if /^-*$/;
  465.     print;
  466.     } 
  467.     close draftmessage;
  468. } 
  469.  
  470. # ----------------------------------------------------------------------
  471. sub type {
  472.     if (!open draftmessage) {
  473.     warn "$program: no $draft message\n";
  474.     return;
  475.     } 
  476.  
  477.     print while <draftmessage>;
  478.  
  479.     close draftmessage;
  480. } 
  481.  
  482. # ----------------------------------------------------------------------
  483. sub shell {
  484.     local($cmd);
  485.     return unless $cmd = &prompt('Shell command');
  486.     &run($cmd);
  487. } 
  488.