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