Term-Clui-1.70/README0000644000076400017510000000653611466424047011565 0ustar pjb The Command-Line User Interface Term::Clui NEW ! Now with mouse ! NEW ! Now with speech ! Term::Clui offers a high-level user interface, with subroutines &choose &ask &edit &view &confirm and &sorry. It works at a higher level than widgets; it gives command-line applications a consistent "look and feel". Its metaphor for the computer is a human-like conversation-partner, and as each answer/response is completed it is summarised onto one line, and remains on screen, so that the history of the dialogue gradually accumulates on the screen and is available for review, or for cut/paste. Also included is the file-selector module Term::Clui::FileSelect, with its main subroutine &select_file. Term::Clui doesn't yet work under Windows. To install just: perl Makefile.PL ; make ; make install For up-to-date source, see http://search.cpan.org/~pjb &edit and &view use the default EDITOR and PAGER from the user's environment, except that if &view is called with a very short text a builtin viewer is used, allowing the user to choose whether the text remains on-screen or is cleared. &confirm expects Y,y,N or n. &ask respects left and right arrows and backspace, ctrl-B moves to the beginning, ctrl-E to the end, and ctrl-D or ctrl-X clear the current string. &choose maintains a DBM database of what the user chose last time in response to the same question, and if it's still in the list this time then &choose highlights it as the default. Thus &choose manages its own defaults, and menus using Term::Clui autoconfigure themselves to the user's preferences. When &choose is called in an array context, it offers the user a multiple choice; mouse-button3 or the Spacebar mark items in a multiple choice. If the choices won't fit on the screen the user is asked for a substring clue. The programmer can pass &ask a default string, as an optional second argument. &select_file obeys options modelled after those of Tk::FileDialog.pm and Tk::SimpleFileSelect.pm Term::Clui is fast, very easy for both programmer and user, and has few external dependencies. It doesn't use curses which is a whole-of -screen interface; it uses a portable subset of vt100 sequences (up left right normal reverse clrtoeol and mouse-reporting). It handles window size changes, using Term::ReadKey or Term::Size if available; if not, it tries `tput`. For the user, Version 1.50 introduced a significant upgrade: mouse- -handling. The user can now select an item in &choose using the mouse and left-click, as well as by using the arrowkeys and return as before (or q or ctrl-X to quit); button3 or the spacebar mark items in a multiple choice. Since version 1.62, mouse-handling can be disabled by setting CLUI_MOUSE=OFF; by default, it is on. Since version 1.60, a speaking interface is provided for the visually impaired user. It employs either eflite or espeak. Speech is turned on if the CLUI_SPEAK environment variable is set to a non-empty string; by default, it is off. If speakup is running, then it is silenced while Term::Clui runs, and then restored. Because Term::Clui's metaphor for the computer is a human-like conversation-partner, this works very naturally, and the application needs no modification. A calling-interface-compatible Python3-module is included. Peter Billam http://www.pjb.com.au/comp/contact.html Term-Clui-1.70/MANIFEST0000644000076400017510000000032211466443557012030 0ustar pjbChanges Clui.pm Clui/FileSelect.pm Makefile.PL test.pl MANIFEST README META.yml examples/login_shell examples/test_script examples/linux_admin examples/audio_stuff examples/choose py/TermClui.py py/test_script Term-Clui-1.70/Changes0000644000076400017510000000750412360140014012153 0ustar pjb20140999 1.70 20140712 1.69 ask() displays a default of "0" 20130703 1.68 handle Haiku's \eO[ABCD] arrow-keys 20130323 1.67 Home and End work in sub ask; bug fixes in sub ask_password 20120905 1.66 ask_filename strips trailing space after filename-completion 20120327 1.65 also ask_filename introduced 20120310 view uses antiword, wv or catdoc on .doc files 20101118 1.63 CLUI_MOUSE=OFF ask() pronounces the char being backspaced 20101110 1.62 CLUI_MOUSE=OFF disables mouse-handling; bug fixed in ask_for_clue 20101109 1.62 speech uses espeak if eflite isn't there, ctrl-X quits choose() 20101108 1.62 speech silences speakup if it's running 20101021 1.61 bug fixed in ask() with a default 20101017 1.60 Spoken interface; see CLUI_SPEAK, emacspeak, eflite 20100516 1.56 ^C calls endwin and raises SIGINT 20100515 1.55 narrow_the_clue only leaves mouse-mode if we're in mouse-mode 20100504 1.54 help_text() introduced; Delete works in ask; various bugs fixed 20100502 1.53 TermClui.py does stty sane on return; bug fixed in audio_stuff 20100501 1.52 disable debugging :-) 20100430 1.51 bug fixed: &ask accepts spaces 20100426 1.50 &choose supports mouse !! and utf8 clues supported 20091104 1.44 ask() handles left-arrow at start of string 20091003 1.43 choose and inform use :encoding(utf8) when in a utf8 environment 20090928 1.42 fixed bug in &choose with items longer than screen-width 20090307 1.41 icol,irow managed by puts; Install removed; Py3 translation 20070511 1.40 removed spurious debug command: &puts("returned") 20070309 1.39 no change 20061005 1.37 uses Term::ReadKey if available, rather than `stty` 20070309 1.38 choose with a long list asking for a clue offers ^X to quit 20050928 1.35 FileSelect.pm returns correct var-type if q for quit 20060816 1.36 neater pod SYNOPSIS formatting, audio_stuff uses mpg123 for mp3 20050915 1.34 FileSelect.pm -Directory option; bugfix when -Chdir=-SelDir=0 20050914 1.33 FileSelect.pm fix sort bug in line 90 20050911 1.32 FileSelect.pm fix "sort interpreted as function" warning 20050831 1.31 test.pl uses warnings; oct/chr/ord confusion fixed in Clui.pm 20050121 1.30 test.pl uses Test::Simple 20041208 1.29 ^C at the "give me a clue" prompt works like "q to quit" 20041107 1.28 EXPORT_OK routines documented and ALL tag defined 20041021 1.27 &choose handles multi-line question text 20041016 1.26 Install offers default locations as default to first-time users 20040809 1.25 'tput lines' tried before 'tput rows' for all OSs 20040801 1.24 &edit checks in initial RCS version correctly 20040720 1.23 @marked gets correctly reset at each invocation of &choose 20040714 1.22 remove timeout for returning ESC (it fails on Fedora xterm) 20040711 get_default and set_default handle arrays with $; but not used yet 20040709 &choose does multiple choice if called in array context 20040708 1.21 examples/test_script defaults to installed Clui.pm 20040708 FileSelect -FPat bug fixed, and another minor doc fix 20040520 1.20 minor doc fix for FileSelect, contact.html not email address 20031214 select used in &getch to return ESC promptly 20031103 1.19 bug fixed handling DOWN in &choose 20030912 debug warn statements removed from FileSelect.pm 20030701 1.18 FreeBSD bug corrected ($^O now gives freebsd) 20021008 add &inform; ×tamp export-ok'd 20020912 1.17 &choose default dbm handles collisions 20020911 1.17 &choose default dbm is now in ~/.clui_dir & obeys $CLUI_DIR 20020626 1.16 Install gets default dirs right, &tiview simpler if <3 lines 20020622 1.15 new Install script, and old MakeMaker-compatible Makefile.PL 20020601 1.14 fixed 'require Clui.raw' bug in test_script 20020519 1.13 add FileSelect.pm and "man Term::Clui" works (ie with ::) 20020130 1.12 &choose handles big lists with &narrow_the_search 20020121 1.11 added README, &ask takes default and bugs fixed 20020119 Term::Clui 1.10 old enter, choose, edit, confirm rolled into one Term-Clui-1.70/Clui.pm0000644000076400017510000015453512445475506012146 0ustar pjb# Term::Clui.pm ######################################################################### # This Perl module is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This module is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### package Term::Clui; $VERSION = '1.70'; # ask_filename() uses readline to display its own prompt my $stupid_bloody_warning = $VERSION; # circumvent -w warning require Exporter; @ISA = qw(Exporter); @EXPORT = qw(ask ask_password ask_filename confirm choose help_text edit sorry view inform); @EXPORT_OK = qw(beep tiview back_up get_default set_default timestamp); %EXPORT_TAGS = (ALL => [@EXPORT,@EXPORT_OK]); no strict; no warnings; my $have_Term_ReadKey = 1; my $have_Term_Size = 0; eval 'require "Term/ReadKey.pm"'; if ($@) { $have_Term_ReadKey = 0; $have_Term_Size = 1; eval 'require "Term/Size.pm"'; if ($@) { $have_Term_Size = 0; } } my $Eflite; my $Eflite_FH; # open here at top-level so one sub can silence the previous my $Espeak; my $Espeak_PID; # defined at top-level so one espeak can kill the previous my $SpeakUpSilentFile; # 1.62 if ($ENV{'CLUI_SPEAK'}) { # 1.62 emacspeak not very relevant as a criterion for my $d ('/sys/accessibility', '/proc') { if (-w "$d/speakup/silent") { $SpeakUpSilentFile = "$d/speakup/silent"; break; } } $Eflite = &which('eflite'); $Espeak = &which('espeak'); if ($Eflite && !$Espeak) { # 1.68 Espeak should be the default if (open($Eflite_FH,'|-',$Eflite)) { select((select($Eflite_FH), $| = 1)[$[]); print $Eflite_FH q{}; } else { warn "can't run $Eflite: $!\n"; } } elsif (! $Espeak) { warn("Term::Clui warning: CLUI_SPEAK set; " . "but can't find eflite or espeak\n"); } } # use open ':locale'; # the open pragma was introduced in 5.8.6 my $EncodingString = q{}; if (($ENV{LANG} =~ /utf-?8/i) || ($ENV{LC_TYPE} =~ /utf-?8/i)) { $EncodingString = ':encoding(utf8)'; } # ------------------------ vt100 stuff ------------------------- $A_NORMAL = 0; $A_BOLD = 1; $A_UNDERLINE = 2; $A_REVERSE = 4; $KEY_UP = 0403; $KEY_LEFT = 0404; $KEY_RIGHT = 0405; $KEY_DOWN = 0402; $KEY_ENTER = "\r"; $KEY_INSERT = 0525; $KEY_DELETE = 0524; $KEY_HOME = 0523; $KEY_END = 0522; $KEY_PPAGE = 0521; $KEY_NPAGE = 0520; $KEY_BTAB = 0541; my $AbsCursX = 0; my $AbsCursY = 0; my $TopRow = 0; my $CursorRow; my $LastEventWasPress = 0; # in order to ignore left-over button-ups my %SpecialKey = map { $_, 1 } ( # 1.51, used by ask to ignore these $KEY_UP, $KEY_LEFT, $KEY_RIGHT, $KEY_DOWN, $KEY_HOME, $KEY_END, $KEY_PPAGE, $KEY_NPAGE, $KEY_BTAB, $KEY_INSERT, $KEY_DELETE ); my $irow; my $icol; # maintained by &puts, &up, &down, &left and &right sub puts { my $s = join q{}, @_; $irow += ($s =~ tr/\n/\n/); if ($s =~ /\r\n?$/) { $icol = 0; } else { $icol += length($s); } print TTY $s; } # could terminfo sgr0, bold, rev, cub1, cuu1, cuf1, cud1 ... sub attrset { my $attr = $_[$[]; if (! $attr) { print TTY "\e[0m"; } else { if ($attr & $A_BOLD) { print TTY "\e[1m" }; if ($attr & $A_REVERSE) { print TTY "\e[7m" }; if ($attr & $A_UNDERLINE) { print TTY "\e[4m" }; } } sub beep { print TTY "\07"; } sub clear { print TTY "\e[H\e[J"; } sub clrtoeol { print TTY "\e[K"; } sub black { print TTY "\e[30m"; } sub red { print TTY "\e[31m"; } sub green { print TTY "\e[32m"; } sub blue { print TTY "\e[34m"; } sub violet { print TTY "\e[35m"; } sub getc_wrapper { my $timeout = 0 + $_[$[]; if ($have_Term_ReadKey) { return Term::ReadKey::ReadKey($timeout, *TTYIN); } else { #if ($timeout > 0.00001) { # doesn't seem to work on openbsd... # my $rin = q{}; # vec($rin,fileno(TTYIN),1) = 1; # my $nfound = select($rin, undef, undef, $timeout); # if (!$nfound) { return undef; } #} return getc(TTYIN); } } sub getch { my $c = getc_wrapper(0); if ($c eq "\e") { $c = getc_wrapper(0.10); if (! defined $c) { return("\e"); } if ($c eq 'A') { return($KEY_UP); } if ($c eq 'B') { return($KEY_DOWN); } if ($c eq 'C') { return($KEY_RIGHT); } if ($c eq 'D') { return($KEY_LEFT); } if ($c eq '2') { getc_wrapper(0); return($KEY_INSERT); } if ($c eq '3') { getc_wrapper(0); return($KEY_DELETE); } # 1.54 if ($c eq '5') { getc_wrapper(0); return($KEY_PPAGE); } if ($c eq '6') { getc_wrapper(0); return($KEY_NPAGE); } if ($c eq 'Z') { return($KEY_BTAB); } if ($c eq 'O') { # 1.68 Haiku wierdness, inherited from an old Suse $c = getc_wrapper(0); if ($c eq 'A') { return($KEY_UP); } # 1.68 if ($c eq 'B') { return($KEY_DOWN); } # 1.68 if ($c eq 'C') { return($KEY_RIGHT); } # 1.68 if ($c eq 'D') { return($KEY_LEFT); } # 1.68 if ($c eq 'F') { return($KEY_END); } # 1.68 if ($c eq 'H') { return($KEY_HOME); } # 1.68 return($c); } if ($c eq '[') { $c = getc_wrapper(0); if ($c eq 'A') { return($KEY_UP); } if ($c eq 'B') { return($KEY_DOWN); } if ($c eq 'C') { return($KEY_RIGHT); } if ($c eq 'D') { return($KEY_LEFT); } if ($c eq 'F') { return($KEY_END); } # 1.67 if ($c eq 'H') { return($KEY_HOME); } # 1.67 if ($c eq 'M') { # mouse report - we must be in BYTES ! # http://invisible-island.net/xterm/ctlseqs/ctlseqs.html my $event_type = ord(getc_wrapper(0))-32; my $x = ord(getc_wrapper(0))-32; my $y = ord(getc_wrapper(0))-32; # my $shift = $event_type & 0x04; # used by wm # my $meta = $event_type & 0x08; # used by wm # my $control = $event_type & 0x10; # used by xterm my $button_drag = ($event_type & 0x20) >> 5; my $button_pressed; my $low3bits = $event_type & 0x03; if ($low3bits == 0x03) { $button_pressed = 0; } else { # button 4 means wheel-up, button 5 means wheel-down if ($event_type & 0x40) { $button_pressed = $low3bits + 4; } else { $button_pressed = $low3bits + 1; } } return handle_mouse($x,$y,$button_pressed,$button_drag) || getch(); } if ($c =~ /\d/) { my $c1 = getc_wrapper(0); if ($c1 eq '~') { if ($c eq '2') { return($KEY_INSERT); } elsif ($c eq '3') { return($KEY_DELETE); } elsif ($c eq '5') { return($KEY_PPAGE); } elsif ($c eq '6') { return($KEY_NPAGE); } } else { # cursor-position report, response to \e[6n $AbsCursY = 0 + $c; while (1) { last if $c1 eq ';'; $AbsCursY = 10*$AbsCursY + $c1; # debug("c1=$c1 AbsCursY=$AbsCursY"); $c1 = getc(TTYIN); } $AbsCursX = 0; while (1) { $c1 = getc(TTYIN); last if $c1 eq 'R'; $AbsCursX = 10*$AbsCursX + $c1; } return getch(); } } if ($c eq 'Z') { return($KEY_BTAB); } return($c); } return($c); #} elsif ($c eq ord(0217)) { # 1.50 BUG what?? never gets here... # $c = getc_wrapper(0); # if ($c eq 'A') { return($KEY_UP); } # if ($c eq 'B') { return($KEY_DOWN); } # if ($c eq 'C') { return($KEY_RIGHT); } # if ($c eq 'D') { return($KEY_LEFT); } # return($c); #} elsif ($c eq ord(0233)) { # 1.50 BUG what?? never gets here... # $c = getc_wrapper(0); # if ($c eq 'A') { return($KEY_UP); } # if ($c eq 'B') { return($KEY_DOWN); } # if ($c eq 'C') { return($KEY_RIGHT); } # if ($c eq 'D') { return($KEY_LEFT); } # if ($c eq '5') { getc_wrapper(0); return($KEY_PPAGE); } # if ($c eq '6') { getc_wrapper(0); return($KEY_NPAGE); } # if ($c eq 'Z') { return($KEY_BTAB); } # return($c); } else { return($c); } } sub up { # if ($_[$[] < 0) { &down(0 - $_[$[]); return; } print TTY "\e[A" x $_[$[]; $irow -= $_[$[]; } sub down { # if ($_[$[] < 0) { &up(0 - $_[$[]); return; } print TTY "\n" x $_[$[]; $irow += $_[$[]; } sub right { # if ($_[$[] < 0) { &left(0 - $_[$[]); return; } print TTY "\e[C" x $_[$[]; $icol += $_[$[]; } sub left { # if ($_[$[] < 0) { &right(0 - $_[$[]); return; } print TTY "\e[D" x $_[$[]; $icol -= $_[$[]; } sub goto { my $newcol = shift; my $newrow = shift; if ($newcol == 0) { print TTY "\r" ; $icol = 0; } elsif ($newcol > $icol) { &right($newcol-$icol); } elsif ($newcol < $icol) { &left($icol-$newcol); } if ($newrow > $irow) { &down($newrow-$irow); } elsif ($newrow < $irow) { &up($irow-$newrow); } } # sub move { my ($ix,$iy) = @_; printf TTY "\e[%d;%dH",$iy+1,$ix+1; } my $InitscrAlreadyRun = 0; my $IsMouseMode = 0; my $WasMouseMode = 0; my $IsSpeakUpSilent = 0; # 1.62 my $WasSpeakUpSilent = 0; # 1.62 my $Stty = q{}; sub enter_mouse_mode { # 1.50 if ($ENV{'CLUI_MOUSE'} eq 'OFF') { return 0; } # 1.62 if ($IsMouseMode) { warn "enter_mouse_mode but already IsMouseMode\r\n"; return 1 ; } if ($EncodingString) { close TTYIN; open(TTYIN, "<:bytes", '/dev/tty') || (warn "Can't read /dev/tty: $!\n", return 0); } print TTY "\e[?1003h"; # sets SET_ANY_EVENT_MOUSE mode $IsMouseMode = 1; return 1; } sub leave_mouse_mode { # 1.50 # if ($ENV{'CLUI_MOUSE'} =~ /off/i) { return 0; } # 1.62 if (!$IsMouseMode) { warn "leave_mouse_mode but not IsMouseMode\r\n"; return 1 ; } if ($EncodingString) { close TTYIN; open(TTYIN, "<$EncodingString", '/dev/tty') || (warn "Can't read /dev/tty: $!\n", return 0); } print TTY "\e[?1003l"; # cancels SET_ANY_EVENT_MOUSE mode $IsMouseMode = 0; return 1; } sub enter_speakup_silent { # 1.62 # echo 7 > /sys/accessibility/speakup/silent if it exists if (!$SpeakUpSilentFile) { return 0; } if ($IsSpeakUpSilent) { warn "enter_speakup_silent but already IsSpeakUpSilent\r\n"; return 1 ; } if (open(S, '>', $SpeakUpSilentFile)) { print S "7\n"; close S; } $IsSpeakUpSilent = 1; return 1; } sub leave_speakup_silent { # 1.62 # echo 4 > /sys/accessibility/speakup/silent if it exists if (!$SpeakUpSilentFile) { return 0; } if (!$IsSpeakUpSilent) { warn "leave_speakup_silent but not IsSpeakUpSilent\r\n"; return 1 ; } if (open(S, '>', $SpeakUpSilentFile)) { print S "4\n"; close S; } $IsSpeakUpSilent = 0; return 1; } sub initscr { my %args = @_; my $mouse_mode = $args{'mouse_mode'}; # for mouse-handling if ($ENV{'CLUI_MOUSE'} eq 'OFF') { $mouse_mode = undef; } # 1.62 my $speakup_silent = $args{'speakup_silent'}; # to silence SpeakUp if ($InitscrAlreadyRun) { $InitscrAlreadyRun++; if (!$mouse_mode and $IsMouseMode) { leave_mouse_mode() or return 0; } elsif ($mouse_mode and !$IsMouseMode) { enter_mouse_mode() or return 0; } $WasMouseMode = $IsMouseMode; if (!$speakup_silent and $IsSpeakUpSilent) { # 1.62 leave_speakup_silent() or return 0; } elsif ($speakup_silent and !$IsSpeakUpSilent) { enter_speakup_silent() or return 0; } $WasSpeakUpSilent = $IsSpeakUpSilent; $icol = 0; $irow = 0; return; } open(TTY, ">$EncodingString", '/dev/tty') # 1.43 || (warn "Can't write /dev/tty: $!\n", return 0); if (!$have_Term_ReadKey) { $Stty = `stty -g`; chop $Stty; } my $encoding_string; if ($mouse_mode) { $IsMouseMode = 1; $encoding_string = ':bytes'; print TTY "\e[?1003h"; # sets SET_ANY_EVENT_MOUSE mode } else { $IsMouseMode = 0; $encoding_string = $EncodingString; } if ($speakup_silent and !$IsSpeakUpSilent) { enter_speakup_silent(); } open(TTYIN, "<$encoding_string", '/dev/tty') || (warn "Can't read /dev/tty: $!\n", return 0); if ($have_Term_ReadKey) { Term::ReadKey::ReadMode('ultra-raw', *TTYIN); } else { if ($^O =~ /^FreeBSD$/i) { system("stty -echo -icrnl raw /dev/tty"); } } select((select(TTY), $| = 1)[$[]); print TTY q{}; $rin = q{}; vec($rin, fileno(TTYIN), 1) = 1; $icol = 0; $irow = 0; $InitscrAlreadyRun = 1; } sub endwin { print TTY "\e[0m"; if ($InitscrAlreadyRun > 1) { if ($IsMouseMode and !$WasMouseMode) { leave_mouse_mode(); } elsif (!$IsMouseMode and $WasMouseMode) { enter_mouse_mode(); } if ($IsSpeakUpSilent and !$WasSpeakUpSilent) { # 1.62 leave_speakup_silent(); } elsif (!$IsSpeakUpSilent and $WasSpeakUpSilent) { enter_speakup_silent(); } $InitscrAlreadyRun--; return; } print TTY "\e[?1003l"; $IsMouseMode = 0; if ($IsSpeakUpSilent) { leave_speakup_silent(); } if ($have_Term_ReadKey) { Term::ReadKey::ReadMode('restore', *TTYIN); close TTY; close TTYIN; } else { close TTY; close TTYIN; if ($^O =~ /^FreeBSD$/i) { system("stty $Stty /dev/tty") if $Stty; } } $InitscrAlreadyRun = 0; } # ----------------------- size handling ---------------------- my ($maxcols, $maxrows); my $size_changed = 1; my @OtherLines; # 20131002 $otherlines, $notherlines no longer global sub check_size { if (! $size_changed) { return; } if ($have_Term_ReadKey) { ($maxcols, $maxrows) = Term::ReadKey::GetTerminalSize(*STDERR); } elsif ($have_Term_Size) { ($maxcols, $maxrows) = Term::Size::chars(*STDERR); } else { $maxcols = `tput cols`; $maxrows = (`tput lines` + 0) || (`tput rows` + 0); } $maxcols = $maxcols || 80; $maxcols--; $maxrows = $maxrows || 24; if (@OtherLines) { @OtherLines = &fmt(join("\n",@OtherLines)); } $size_changed = 0; } $SIG{'WINCH'} = sub { $size_changed = 1; }; # ------------------------ ask stuff ------------------------- # Options such as integer, real, positive, >x, >=x, 1); endwin(); $term = new Term::ReadLine 'ProgramName'; my $filename = $term->readline($question.' '); # 1.70 print STDERR "\e[J"; $filename =~ s/ $//; # 1.66 return $filename; } sub ask_password { # no echo - use for passwords local ($silent) = 'yes'; &ask($_[$[]); } sub ask { my ($question, $default) = @_; return q{} unless $question; &initscr(speakup_silent=>1); my $nol = &display_question($question); my $i = 0; my $n = 0; my @s = (); # cursor position, length, string if (defined $default) { # 1.69 defined, to include 0 &speak("$question, default is $default"); $default =~ s/\t/ /g; @s = split(q{}, $default); $n = scalar @s; $i = $[; foreach $j ($[ .. $#s) { &puts($s[$j]); } &left($n); } else { &speak($question); } while (1) { my $c = &getch(); if ($c eq "\r") { &erase_lines(1); last; } if ($size_changed) { &erase_lines(0); $nol = &display_question($question); } if ($c == $KEY_LEFT) { if ($i > 0) { $i--; &left(1); } # 1.44 } elsif ($c == $KEY_RIGHT) { if ($i < $n) { &puts($silent ? "x" : $s[$i]); $i++; } } elsif ($c == $KEY_DELETE) { # 1.54 if ($i < $n) { $n--; splice(@s, $i, 1); foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); } # 1.67 &clrtoeol(); &left($n-$i); } } elsif (($c eq "\cH") || ($c eq "\c?")) { if ($i > 0) { $n--; $i--; if (! $silent) { &speak($s[$i]); } # 1.63 splice(@s, $i, 1); &left(1); foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); } # 1.67 &clrtoeol(); &left($n-$i); } } elsif ($c eq "\cC") { # 1.56 &erase_lines(1); &endwin(); warn "^C\n"; kill('INT', $$); return undef; } elsif ($c eq "\cX" || $c eq "\cD") { # clear ... &left($i); $i = 0; $n = 0; &clrtoeol(); @s = (); } elsif ($c eq "\cA" || $c == $KEY_HOME) { &left($i); $i = 0; } elsif ($c eq "\cE" || $c == $KEY_END) { &right($n-$i); $i = $n; } elsif ($c eq "\cL") { &speak(join("", @s)); # redraw ... } elsif ($SpecialKey{$c}) { &beep(); } elsif (ord($c) >= 32) { # 1.51 splice(@s, $i, 0, $c); &puts($silent ? "x" : $c); if (! $silent) { &speak($c); } $n++; $i++; foreach $j ($i..$#s) { &puts($silent ? "x" : $s[$j]); } # 1.67 &clrtoeol(); &left($n-$i); } else { &beep(); } } &speak(join("", @s), 'wait'); &endwin(); $silent = q{}; return join("", @s); } # ----------------------- choose stuff ------------------------- sub debug { if (! open (DEBUG, '>>/tmp/clui.log')) { warn "can't open /tmp/clui.log: $!\n"; return; } print DEBUG "$_[$[]\n"; close DEBUG; } my (%irow, %icol, $nrows, $clue_has_been_given, $choice, $this_cell); my @marked; my $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7]; srand(time() ^ ($$+($$<15))); sub choose { my $question = shift; local @list = @_; # @list must be local # As from 1.22, allows multiple choice if called in array context return unless @list; grep (($_ =~ s/[\r\n]+$//) && 0, @list); # chop final newlines my @biglist = @list; my $icell; @marked = (); $question =~ s/^[\n\r]+//; # strip initial newline(s) $question =~ s/[\n\r]+$//; # strip final newline(s) my ($firstline,$otherlines) = split(/\r?\n/, $question, 2); my $firstlinelength = length $firstline; $choice = &get_default($firstline); # If wantarray ? Is remembering multiple choices safe ? &initscr(mouse_mode=>1, speakup_silent=>1); &size_and_layout(0); @OtherLines = &fmt($otherlines); my $speaktext = join(' ',$list[$this_cell],'. ',@OtherLines); if (wantarray) { $#marked = $#list; if ($firstlinelength < $maxcols-30) { &puts("$firstline (multiple choice with spacebar)\n\r"); } elsif ($firstlinelength < $maxcols-16) { &puts("$firstline (multiple choice)\n\r"); } elsif ($firstlinelength < $maxcols-9) { &puts("$firstline (multiple)\n\r"); } else { &puts("$firstline\n\r"); } if ($nrows >= $maxrows) { &speak("$firstline, ", 'wait'); } else { &speak("$firstline, multiple choice, $speaktext"); } } else { &puts("$firstline\n\r"); if ($nrows >= $maxrows) { &speak("$firstline, ", 'wait'); } else { &speak("$firstline, choose, $speaktext"); } } if ($nrows >= $maxrows) { @list = &narrow_the_search(@list); if (! @list) { &up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0; return wantarray ? () : undef; } my $speaktext = join(' ',$list[$this_cell],'. ',@OtherLines); &speak("choose, $speaktext"); } &wr_screen(); # the cursor is now on this_cell, not on the question print TTY "\e[6n"; # terminfo u7, will set $AbsCursX,$AbsCursY $CursorRow = $irow[$this_cell]; # global, needed by handle_mouse while (1) { $c = &getch(); if ($size_changed) { &size_and_layout($nrows); if ($nrows >= $maxrows) { @list = &narrow_the_search(@list); if (! @list) { &up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0; return wantarray ? () : undef; } } &wr_screen(); &speak("choose, $list[$this_cell]"); } if ($c eq "q" || $c eq "\cD" || $c eq "\cX") { &erase_lines(1); if ($clue_has_been_given) { my $re_clue = &confirm("Do you want to change your clue ?"); &up(1); &clrtoeol(); # erase the confirm if ($re_clue) { $irow = 1; @list = &narrow_the_search(@biglist); &wr_screen(); &speak("choose, $list[$this_cell]"); next; } else { &up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0; return wantarray ? () : undef; } } &goto(0,0); &clrtoeol(); &endwin(); $clue_has_been_given = 0; return wantarray ? () : undef; } elsif (($c eq "\t") && ($this_cell < $#list)) { $this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ((($c eq "l") || ($c == $KEY_RIGHT)) && ($this_cell < $#list) && ($irow[$this_cell] == $irow[$this_cell+1])) { $this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ((($c eq "\cH") || ($c == $KEY_BTAB)) && ($this_cell > $[)) { $this_cell--; &wr_cell($this_cell+1); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ((($c eq "h") || ($c == $KEY_LEFT)) && ($this_cell > $[) && ($irow[$this_cell] == $irow[$this_cell-1])) { $this_cell--; &wr_cell($this_cell+1); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ((($c eq "j") || ($c == $KEY_DOWN)) && ($irow < $nrows)) { my $mid_col = $icol[$this_cell] + 0.5 * length($list[$this_cell]); my $left_of_target = 1000; for ($inew=$this_cell+1; $inew < $#list; $inew++) { last if $icol[$inew] < $mid_col; # skip rest of row } my $new_mid_col = 0; for (; $inew < $#list; $inew++) { $new_mid_col = $icol[$inew] + 0.5*length($list[$inew]); last if $new_mid_col >= $mid_col; # we've reached it last if $icol[$inew+1] <= $icol[$inew]; # we're at EOL $left_of_target = $mid_col - $new_mid_col; } if (($new_mid_col - $mid_col) > $left_of_target) { $inew--; } $iold = $this_cell; $this_cell = $inew; &wr_cell($iold); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ((($c eq "k") || ($c == $KEY_UP)) && ($irow > 1)) { my $mid_col = $icol[$this_cell] + 0.5*length($list[$this_cell]); my $right_of_target = 1000; for ($inew=$this_cell-1; $inew > 0; $inew--) { last if $irow[$inew] < $irow[$this_cell]; # skip rest of row } my $new_mid_col = 0; for (; $inew > 0; $inew--) { last unless $icol[$inew]; $new_mid_col = $icol[$inew] + 0.5*length($list[$inew]); last if $new_mid_col < $mid_col; # we're past it $right_of_target = $new_mid_col - $mid_col; } if (($mid_col - $new_mid_col) > $right_of_target) { $inew++; } $iold = $this_cell; $this_cell = $inew; &wr_cell($iold); &wr_cell($this_cell); &speak($list[$this_cell]); } elsif ($c eq "\cL") { if ($size_changed) { &size_and_layout($nrows); if ($nrows >= $maxrows) { @list = &narrow_the_search(@list); if (! @list) { &up(1); &clrtoeol(); &endwin(); $clue_has_been_given = 0; return wantarray ? () : undef; } } } &wr_screen(); } elsif ($c eq "\cC") { # 1.56 &erase_lines(1); &endwin(); warn "^C\n"; kill('INT', $$); return undef; } elsif ($c eq "\r") { &erase_lines(1); &goto($firstlinelength+1, 0); my @chosen; if (wantarray) { my $i; for ($i=$[; $i<=$#list; $i++) { if ($marked[$i] || $i==$this_cell) { push @chosen, $list[$i]; } } &clrtoeol(); my $remaining = $maxcols-$firstlinelength; my $last = pop @chosen; my $dotsprinted; foreach (@chosen) { if (($remaining - length $_) < 4) { $dotsprinted=1; &puts("..."); $remaining -= 3; last; } else { &puts("$_, "); $remaining -= (2 + length $_); } } if (!$dotsprinted) { if (($remaining - length $last)>0) { &puts($last); } elsif ($remaining > 2) { &puts('...'); } } &puts("\n\r"); push @chosen, $last; } else { &puts($list[$this_cell]."\n\r"); } &endwin(); &set_default($firstline, $list[$this_cell]); # join($,,@chosen) ? $clue_has_been_given = 0; if (wantarray) { &speak(join(' and ',@chosen), 'wait'); return @chosen; } else { &speak($list[$this_cell], 'wait'); return $list[$this_cell]; } } elsif ($c eq " ") { if (wantarray) { $marked[$this_cell] = !$marked[$this_cell]; #if ($this_cell < $#list) { # $this_cell++; &wr_cell($this_cell-1); # 1.50 &wr_cell($this_cell); &speak('marked'); #} #} elsif ($this_cell < $#list) { # $this_cell++; &wr_cell($this_cell-1); &wr_cell($this_cell); } } elsif ($c eq "?") { warn "help\r\n"; } } &endwin(); warn "choose: shouldn't reach here ...\n"; } sub layout { my @list = @_; $this_cell = 0; my $irow = 1; my $icol = 0; my $i; for ($i=$[; $i<=$#list; $i++) { $l[$i] = length($list[$i]) + 2; if ($l[$i] > $maxcols-1) { $l[$i] = $maxcols-1; } # 1.42 if (($icol + $l[$i]) >= $maxcols ) { $irow++; $icol = 0; } if ($irow > $maxrows) { return $irow; } # save time $irow[$i] = $irow; $icol[$i] = $icol; $icol += $l[$i]; if ($list[$i] eq $choice) { $this_cell = $i; } } return $irow; } sub wr_screen { for (my $i=$[; $i<=$#list; $i++) { &wr_cell($i) unless $i==$this_cell; } my $notherlines = scalar @OtherLines; if ($notherlines && ($nrows+$notherlines) < $maxrows) { &puts("\r\n", join("\r\n", @OtherLines), "\r"); } &wr_cell($this_cell); } sub wr_cell { my $i = shift; my $no_tabs = $list[$i]; $no_tabs =~ s/\t/ /g; &goto($icol[$i], $irow[$i]); if ($marked[$i]) { &attrset($A_BOLD | $A_UNDERLINE); } if ($i == $this_cell) { &attrset($A_REVERSE); } &puts(substr " $no_tabs ", $[, $maxcols); # 1.42, 1.54 if ($marked[$i] || $i == $this_cell) { &attrset($A_NORMAL); } } sub size_and_layout { my $erase_rows = shift; &check_size(); if ($erase_rows) { if ($erase_rows > $maxrows) { $erase_rows = $maxrows; } # XXX? &erase_lines(1); } $nrows = &layout(@list); } sub narrow_the_search { my @biglist = @_; # replaces the old ... require 'complete.pl'; # return &Complete("$firstline (TAB to complete, ^D to list) ", @list); my $nchoices = scalar @_; my $n; my $i; my @s; my $s; my @list = @biglist; $clue_has_been_given = 1; if ($IsMouseMode) { leave_mouse_mode(); } &ask_for_clue($nchoices, $i, $s); while (1) { $c = &getch(); if ($size_changed) { &size_and_layout(0); if ($nrows < $maxrows) { &erase_lines(1); enter_mouse_mode(); return @list; } } if ($c == $KEY_LEFT && $i > 0) { $i--; &left(1); next; } elsif ($c == $KEY_RIGHT) { if ($i < $n) { &puts($s[$i]); $i++; next; } } elsif (($c eq "\cH") || ($c eq "\c?")) { if ($i > 0) { $n--; $i--; &speak($s[$i], 'wait'); # 1.63 splice(@s, $i, 1); &left(1); foreach $j ($i..$n) { &puts($s[$j]); } &clrtoeol(); &left($n-$i); } } elsif ($c eq "\cC") { # 1.56 &erase_lines(1); &endwin(); warn "^C\n"; kill('INT', $$); return undef; } elsif ($c eq "\cX" || $c eq "\cD") { # clear ... if (! @s) { # 20070305 ? $clue_has_been_given = 0; &erase_lines(1); enter_mouse_mode(); return (); } &left($i); $i = 0; $n = 0; @s = (); &clrtoeol(); } elsif ($c eq "\cA") { &left($i); $i = 0; next; } elsif ($c eq "\cE") { &right($n-$i); $i = $n; next; } elsif ($c eq "\cL") { } elsif ($SpecialKey{$c}) { &beep(); } elsif (ord($c) >= 32) { # 1.51 splice(@s, $i, 0, $c); $n++; $i++; &puts($c); foreach $j ($i..$n) { &puts($s[$j]); } &clrtoeol(); &left($n-$i); &speak($c, 'wait'); # 1.63 } else { &beep(); } # grep, and if $nchoices=1 return $s = join("", @s); @list = grep($[ <= index($_,$s), @biglist); $nchoices = scalar @list; $nrows = &layout(@list); if ($nchoices==1 || ($nchoices && ($nrows<$maxrows))) { &puts("\r"); &clrtoeol(); &up(1); &clrtoeol(); enter_mouse_mode(); return @list; } &ask_for_clue($nchoices, $i, $s); } warn "narrow_the_search: shouldn't reach here ...\n"; } sub ask_for_clue { my ($nchoices, $i, $s) = @_; if ($nchoices) { if ($s) { my $headstr = "the choices won't fit; there are still"; &goto(0,1); &puts("$headstr $nchoices of them"); &clrtoeol(); &goto(0,2); &puts("lengthen the clue : "); &right($i); &speak("still $nchoices choices, lengthen the clue"); } else { my $headstr = "the choices won't fit; there are"; &goto(0,1); &puts("$headstr $nchoices of them"); &clrtoeol(); &goto(0,2); &puts(" give me a clue : (or ctrl-X to quit)"); &left(31); # 1.62 &speak("$nchoices choices, give me a clue, or control-X to quit"); } } else { &goto(0,1); &puts("No choices fit this clue !"); &clrtoeol(); &goto(0,2); &puts(" shorten the clue : "); &right($i); &speak("no choices fit, shorten the clue"); } } sub get_default { my ($question) = @_; if ($ENV{CLUI_DIR} =~ /off/i) { return undef; } if (! $question) { return undef; } my @choices; my $n_tries = 5; while ($n_tries--) { if (dbmopen (%CHOICES, &dbm_file(), 0600)) { last; } else { if ($! eq 'Resource temporarily unavailable') { my $wait = rand 0.45; select undef, undef, undef, $wait; } else { return undef; } } } @choices = split ($; ,$CHOICES{$question}); dbmclose %CHOICES; if (wantarray) { return @choices; } else { return $choices[$[]; } } sub set_default { my $question = shift; my $s = join($; , @_); if ($ENV{CLUI_DIR} =~ /off/i) { return undef; } if (! $question) { return undef; } my $n_tries = 5; while ($n_tries--) { if (dbmopen(%CHOICES, &dbm_file(), 0600)) { last; } else { if ($! eq 'Resource temporarily unavailable') { my $wait = rand 0.50; select undef, undef, undef, $wait; } else { return undef; } } } $CHOICES{$question} = $s; dbmclose %CHOICES; return $s; } sub dbm_file { if ($ENV{CLUI_DIR} =~ /off/i) { return undef; } my $db_dir; if ($ENV{CLUI_DIR}) { $db_dir = $ENV{CLUI_DIR}; $db_dir =~ s#^~/#$HOME/#; } else { $db_dir = "$HOME/.clui_dir"; } mkdir ($db_dir,0750); return "$db_dir/choices"; } sub handle_mouse { my ($x, $y, $button_pressed, $button_drag) = @_; # 1.50 $TopRow = $AbsCursY - $CursorRow; if ($LastEventWasPress) { $LastEventWasPress = 0; return(''); } return('') unless $y >= $TopRow; my $mouse_row = $y - $TopRow; my $mouse_col = $x - 1; # debug("x=$x y=$y TopRow=$TopRow mouse_row=$mouse_row"); # debug("button_pressed=$button_pressed button_drag=$button_drag"); my $found = 0; my $i = $[; while ($i < @irow) { if ($irow[$i] == $mouse_row) { # debug("list[$i]=$list[$i] is the right row"); if ($icol[$i] < $mouse_col and ($icol[$i]+length($list[$i]) >= $mouse_col)) { $found = 1; last; } last if $irow[$i] > $mouse_row; } $i += 1; } return unless $found; # if xterm doesn't receive a button-up event it thinks it's dragging my $return_char = q{}; if ($button_pressed == 1 and !$button_drag) { $LastEventWasPress = 1; $return_char = $KEY_ENTER; } elsif ($button_pressed == 3 and !$button_drag) { $LastEventWasPress = 1; $return_char = q{ }; } if ($i != $this_cell) { my $t = $this_cell; $this_cell = $i; &wr_cell($t); &wr_cell($this_cell); } return $return_char; } sub help_text { # 1.54 my $text; if ($_[$[] eq 'ask') { return "\nLeft and Right arrowkeys, Backspace, Delete; control-A = " . " beginning; control-E = end; control-X = clear; then Return."; } if ($ENV{'CLUI_MOUSE'} eq 'OFF') { $text = "\nmove around with Arrowkeys (or hjkl);"; } else { $text = "\nmove around with Mouse or Arrowkeys (or hjkl);"; } if ($_[$[] =~ /^mult/) { $text .= " multiselect with Rightclick or Spacebar;"; } $text .= " then either q or ctrl-X for quit,"; if ($ENV{'CLUI_MOUSE'} eq 'OFF') { $text .= " or Return to choose."; } else { $text .= " or choose with Leftclick or Return."; } } # ----------------------- confirm stuff ------------------------- sub confirm { my $question = shift; # asks user Yes|No, returns 1|0 return(0) unless $question; return(0) unless -t STDERR; &initscr(speakup_silent=>1); my $nol = &display_question($question); &puts(" (y/n) "); &speak($question . ', y or n'); while (1) { $response=&getch(); if ($response eq "\cC") { # 1.56 &erase_lines(1); &endwin(); warn "^C\n"; kill('INT', $$); return undef; } last if ($response=~/[yYnN]/); &beep(); } &left(6); &clrtoeol(); if ($response=~/^[yY]/) { &puts("Yes"); &speak('yess', 'wait'); } else { &puts("No"); &speak('know', 'wait'); } &erase_lines(1); &endwin(); if ($response =~ /^[yY]/) { return 1; } else { return 0 ; } } # ----------------------- edit stuff ------------------------- sub edit { my ($title, $text) = @_; my $argc = $#_ - $[ +1; my ($dirname, $basename, $rcsdir, $rcsfile, $rcs_ok); if ($argc == 0) { # start editor session with no preloaded file system $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db } elsif ($argc == 2) { # must create tmp file with title embedded in name my $tmpdir = '/tmp'; my $safename = $title; $safename =~ s/[\W_]+/_/g; my $file = "$tmpdir/$safename.$$"; if (!open(F,">$file")) {&sorry("can't open $file: $!\n");return q{};} print F $text; close F; $editor = $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db system "$editor $file"; if (!open(F,"< $file")) {&sorry("can't open $file: $!\n");return 0;} undef $/; $text = ; $/ = "\n"; close F; unlink $file; return $text; } elsif ($argc == 1) { # its a file, we will try RCS ... my $file = $title; # weed out no-go situations if (-d $file) {&sorry("$file is already a directory\n"); return 0;} if (-B _ && -s _) {&sorry("$file is not a text file\n"); return 0;} if (-T _ && !-w _) { &view($file); return 1; } # it's a writeable text file, so work out the locations if ($file =~ /\//) { ($dirname, $basename) = $file =~ /^(.*)\/([^\/]+)$/; $rcsdir = "$dirname/RCS"; $rcsfile = "$rcsdir/$basename,v"; } else { $basename = $file; $rcsdir = "RCS"; $rcsfile = "$rcsdir/$basename,v"; } $rcslog = "$rcsdir/log"; # we no longer create the RCS directory if it doesn't exist, # so `mkdir RCS' to enable rcs in a directory ... $rcs_ok = 1; if (!-d $rcsdir) { $rcs_ok = 0; } if (-d _ && ! -w _) { $rcs_ok = 0; warn "can't write in $rcsdir\n"; } # if the file doesn't exist, but the RCS does, then check it out if ($rcs_ok && -f $rcsfile && !-f $file) { system "co -l $file $rcsfile"; } my $starttime = time; $editor = $ENV{EDITOR} || "vi"; # should also look in ~/db/choices.db system "$editor $file"; my $elapsedtime = time - $starttime; # could be output or logged, for worktime accounting if ($rcs_ok && -T $file) { # check it in if (!-f $rcsfile) { my $msg = &ask("$file is new. Please describe it:"); my $quotedmsg = $msg; $quotedmsg =~ s/'/'"'"'/g; if ($msg) { system "ci -q -l -t-'$quotedmsg' -i $file $rcsfile"; &logit($basename, $msg); } } else { my $msg = &ask("What changes have you made to $file ?"); my $quotedmsg = $msg; $quotedmsg =~ s/'/'"'"'/g; if ($msg) { system "ci -q -l -m'$quotedmsg' $file $rcsfile"; &logit($basename, $msg); } } } } } sub logit { my ($file, $msg) = @_; if (! open(LOG, ">> $rcslog")) { warn "can't open $rcslog: $!\n"; } else { $pid = fork; # log in background for better response time if (! $pid) { ($user) = getpwuid($>); print LOG ×tamp, " $file $user $msg\n"; close LOG; if ($pid == 0) { exit 0; } # the child's end, if a fork occurred } } } sub timestamp { # returns current date and time in "199403011 113520" format my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; $wday += 0; $yday += 0; $isdst += 0; # avoid bloody -w warning return sprintf("%4.4d%2.2d%2.2d %2.2d%2.2d%2.2d", $year+1900, $mon+1, $mday, $hour, $min, $sec); } # ----------------------- sorry stuff ------------------------- sub sorry { # warns user of an error condition print STDERR "Sorry, $_[$[]\n"; &speak("Sorry, $_[$[]", 'wait'); } sub inform { my $text = $_[$[]; $text =~ s/([^\n])$/$1\n/s; if (open(TTY, ">$EncodingString", '/dev/tty')) { # 1.43 print TTY $text; close TTY; } else { warn $text; } &speak($text, 'wait'); } # ----------------------- view stuff ------------------------- foreach $f ("/usr/bin/less", "/usr/bin/more") { if (-x $f) { $default_pager = $f; } } sub view { my ($title, $text) = @_; # or ($filename) = my $pager = $ENV{PAGER} || $default_pager; if (! $text and ($title =~ /\.doc$/i) and -r $title) { # 1.65 my $wvText = which('wvText'); if ($wvText) { my $tmpf = "/tmp/wv$$"; system "$wvText '$title' $tmpf"; system "$pager $tmpf"; unlink $tmpf; return 1; } my $antiword = which('antiword'); if ($antiword) { system "$antiword -i 1 '$title' | $pager"; return 1; } my $catdoc = which('catdoc'); if ($catdoc) { system "$catdoc '$title' | $pager"; return 1; } sorry("it's a .doc file; you need to install wv, antiword or catdoc"); return 0; } elsif (! $text && -T $title && open(F,"< $title")) { $nlines = 0; while () { last if ($nlines++ > $maxrows); } close F; if ($nlines > (0.6*$maxrows)) { system "$pager \'$title\'"; } else { open(F,"< $title"); undef $/; $text=; $/="\n"; close F; &tiview($title, $text); } } else { local (@lines) = split(/\r?\n/, $text, $maxrows); if (($#lines - $[) < 21) { &tiview($title, $text); } else { local ($safetitle); ($safetitle = $title) =~ s/[^a-zA-Z0-9]+/_/g; local ($tmp) = "/tmp/$safetitle.$$"; if (!open(TMP, ">$tmp")) {warn "can't open $tmp: $!\n"; return;} print TMP $text; close TMP; system "$pager \'$tmp\'"; unlink $tmp; return 1; } } } sub tiview { my ($title, $text) = @_; return unless $text; local ($[) = 0; $title =~ s/\t/ /g; my $titlelength = length $title; &check_size(); my @rows = &fmt($text, nofill=>1); &initscr(); if (3 > scalar @rows) { &puts("$title\r\n".join("\r\n",@rows), "\r\n"); &speak("$title, ".join(" ",@rows), 'wait'); &endwin(); return 1; } if ($titlelength > ($maxcols-35)) { &puts("$title\r\n"); } else { &puts("$title ( to continue, q to clear)\r\n"); } &puts("\r", join("\e[K\r\n",@rows), "\r"); &speak("$title, enter to continue, ".join(" ",@rows)); $icol = 0; $irow = scalar @rows; &goto($titlelength+1, 0); while (1) { $c = &getch(); if ($c eq 'q' || $c eq "\cX" || $c eq "\cW" || $c eq "\cZ" || $c eq "\cC" || $c eq "\c\\") { &erase_lines(0); &endwin(); return 1; } elsif ($c eq "\r") { # retains text on screen &clrtoeol(); &goto(0, @rows+1); &endwin(); return 1; } elsif ($c eq "\cL") { &puts("\r"); &endwin(); &tiview($title,$text); return 1; } } warn "tiview: shouldn't reach here\n"; } # -------------------------- infrastructure ------------------------- sub which { my $f; foreach $d (split(":",$ENV{'PATH'})) {$f="$d/$_[$[]"; return $f if -x $f;} } %SpeakMode = (); sub END { if ($Eflite_FH) { print $Eflite_FH "s\nq { }\n"; close $Eflite_FH; } elsif ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait; } } sub speak { my ($text, $wait) = @_; $text="$text"; return unless length($text); # should clean up for exit: kill or wait # could replace the punctuation chars with descriptive words... if ($SpeakMode{'dot'}) { $text =~ s/\s*\.\s*/ dot /g; $text =~ s/\s*\.(\w)/ dot $1/g; } if ($Eflite_FH) { if (length($text) == 1) { if ($text eq '.') { print $Eflite_FH "s\nq { dot }\nd\n"; } else { print $Eflite_FH "s\nl {$text}\n"; } if ($wait) { select(undef,undef,undef,0.5); } } else { print $Eflite_FH "s\nq {$text}\nd\n"; # useless emacspeak op: tts_sy nc_state all 0 0 1 225\nq {[:np ]} if ($wait) { select(undef,undef,undef,0.3+0.07*length($text)); } } } elsif ($Espeak) { # 1.68 should be using Speech::eSpeak ! if ($Espeak_PID) { kill SIGHUP, $Espeak_PID; wait; $Espeak_PID = 0; } $Espeak_PID = fork(); if ($Espeak_PID) { if ($wait) { if (length($text) == 1) { select(undef,undef,undef,0.5); } else { select(undef,undef,undef,0.3+0.07*length($text)); } } return 1; } else { my $espeak_FH; my $espeak_PID; if ($espeak_PID = open($espeak_FH,'|-',$Espeak)) { select((select($espeak_FH), $| = 1)[$[]); print $espeak_FH q{}; } else { warn "can't run $Espeak: $!\n"; return; } # binmode($espeak_FH, ':unix'); sub huphandler { kill 'KILL', $espeak_PID; } $SIG{HUP} = \&huphandler; if ($text eq '.') { print $espeak_FH "dot\n"; } else { print $espeak_FH "$text\n"; } # close $espeak_FH; # Must Not Close! close Hangs, unkillable ! wait; exit 0; } } } sub display_question { my $question = shift; my %options = @_; # used by &ask and &confirm, but not by &choose ... &check_size(); my ($firstline, $otherlines); # 20131002 @otherlines => $otherlines if ($options{nofirstline}) { @OtherLines = &fmt($question); } else { ($firstline,$otherlines) = split(/\r?\n/, $question, 2); @OtherLines = &fmt($otherlines); if ($firstline) { &puts("$firstline "); } } if (@OtherLines) { &puts("\r\n", join("\r\n", @OtherLines), "\r"); &goto(1 + length $firstline, 0); } return scalar @OtherLines; } sub erase_lines { # leaves cursor at beginning of line $_[$[] &goto(0, $_[$[]); print TTY "\e[J"; } sub fmt { my $text = shift; my %options = @_; # Used by tiview, ask and confirm; formats the text within $maxcols cols my (@i_words, $o_line, @o_lines, $o_length, $last_line_empty, $w_length); my (@i_lines, $initial_space); @i_lines = split(/\r?\n/, $text); foreach $i_line (@i_lines) { if ($i_line =~ /^\s*$/) { # blank line ? if ($o_line) { push @o_lines, $o_line; $o_line=q{}; $o_length=0; } if (! $last_line_empty) { push @o_lines,""; $last_line_empty=1; } next; } $last_line_empty = 0; if ($options{nofill}) { push @o_lines, substr($i_line, $[, $maxcols-1); next; } if ($i_line =~ s/^(\s+)//) { # line begins with space ? $initial_space = $1; $initial_space =~ s/\t/ /g; if ($o_line) { push @o_lines, $o_line; } $o_line = $initial_space; $o_length = length $initial_space; } else { $initial_space = q{}; } @i_words = split(' ', $i_line); foreach $i_word (@i_words) { $w_length = length $i_word; if (($o_length + $w_length) >= $maxcols) { push @o_lines, $o_line; $o_line = $initial_space; $o_length = length $initial_space; } if ($w_length >= $maxcols) { # chop it ! push @o_lines, substr($i_word,$[,$maxcols-1); next; } if ($o_line) { $o_line .= ' '; $o_length += 1; } $o_line .= $i_word; $o_length += $w_length; } } if ($o_line) { push @o_lines, $o_line; } if ((scalar @o_lines) < $maxrows-2) { return(@o_lines); } else { return splice (@o_lines, $[, $maxrows-2); } } sub back_up { open(TTY, '>', '/dev/tty') # 1.43 || (warn "Can't write /dev/tty: $!\n", return 0); print TTY "\r\e[K\e[A\e[K"; close TTY; } 1; __END__ =pod =head1 NAME Term::Clui.pm - Perl module offering a Command-Line User Interface =head1 SYNOPSIS use Term::Clui; $chosen = choose("A Title", @a_list); # single choice @chosen = choose("A Title", @a_list); # multiple choice # multi-line question-texts are possible... $x = choose("Which ?\n(Mouse, or Arrow-keys and Return)", @w); $x = choose("Which ?\n".help_text(), @w); if (confirm($text)) { do_something(); }; $answer = ask($question); $answer = ask($question,$suggestion); $password = ask_password("Enter password:"); $filename = ask_filename("Which file ?"); # with Tab-completion $newtext = edit($title, $oldtext); edit($filename); view($title, $text) # if $title is not a filename view($textfile) # if $textfile _is_ a filename edit(choose("Edit which file ?", grep(-T, readdir D))); =head1 DESCRIPTION Term::Clui offers a high-level user interface to give the user of command-line applications a consistent "look and feel". Its metaphor for the computer is as a human-like conversation-partner, and as each question/response is completed it is summarised onto one line, and remains on screen, so that the history of the session gradually accumulates on the screen and is available for review, or for cut/paste. This user interface can therefore be intermixed with standard applications which write to STDOUT or STDERR, such as I, I, I etc. For the user, I uses either (since 1.50) the mouse; or arrow keys (or hjkl) and Return; also B to quit, and SpaceBar or Button3 to highlight multiple choices. I expects y, Y, n or N. In general, ctrl-L redraws the (currently active bit of the) screen. I and I use the default EDITOR and PAGER if possible. It's fast, simple, and has few external dependencies. It doesn't use I (which is a whole-of-screen interface); it uses a small subset of vt100 sequences (up down left right normal and reverse) which are very portable, and also (since 1.50) the I and I (terminfo) sequences, which are supported by all I, I, I, I, I, I and I terminals. There is an associated file selector, Term::Clui::FileSelect Since version 1.60, a speaking interface is provided for the visually-impaired user; it employs I or I. Speech is turned on if the I environment variable is set to any non-empty string. Since version 1.62, if I is running, it is silenced while Term::Clui runs, and then restored. Because Term::Clui's metaphor for the computer is a human-like conversation-partner, this works very naturally. The application needs no modification. There is an equivalent Python3 module, with (as far as possible) the same calling interface, at http://cpansearch.perl.org/src/PJB/Term-Clui-1.70/py/TermClui.py This is Term::Clui.pm version 1.70 =head1 WINDOW-SIZE Term::Clui attempts to handle the WINCH signal. If the window size is changed, then as soon as the user enters the next keystroke (such as ctrl-L) the current question/response will be redisplayed to fit the new size. The first line of the question, the one which will remain on-screen, is not re-formatted, but is left to be dealt with by the width of the window. Subsequent lines are split into blank-separated words which are filled into the available width; lines beginning with white-space are treated as the beginning of a new indented paragraph, individual words which will not fit onto one line are truncated, and successive blank lines are collapsed into one. If the question will not fit within the available rows, it is truncated. If the available choice items in a I overflow the screen, the user is asked to enter "clue" letters, and as soon as the items matching them will fit onto the screen they are displayed as a choice. =head1 SUBROUTINES =over 3 =item I( $question ); OR I( $question, $default ); Asks the user the question and returns a string answer, with no newline character at the end. If the optional second argument is present, it is offered to the user as a default. If the I<$question> is multi-line, the entry-field is at the top to the right of the first line, and the subsequent lines are formatted within the screen width and displayed beneath, as with I. For the user, left and right arrow keys move backward and forward through the string, delete and backspace erase the previous character, ctrl-A moves to the beginning, ctrl-E to the end, and ctrl-D or ctrl-X clear the current string. =item I( $question ); Does the same with no echo, as used for password entry. =item I( $question ); Uses I to provide filename-completion with the I key, but also displays multi-line questions in the same way as I and I do. This function was introduced in version 1.65. =item I( $question, @list ); Displays the question, and formats the list items onto the lines beneath it. If I is called in a scalar context, the user can choose an item using arrow keys (or hjkl) and Return, or cancel the choice with a "q". I then returns the chosen item, or I if the choice was cancelled. If I is called in an array context, the user can also mark an item with the SpaceBar. I then returns the list of marked items, (including the item highlit when Return was pressed), or an empty array if the choice was cancelled. A DBM database is maintained of the question and its chosen response. The next time the user is offered a choice with the same question, if that response is still in the list it is highlighted as the default; otherwise the first item is highlighted. Different parts of the code, or different applications using I can therefore exchange defaults simply by using the same question words, such as "Which printer ?". Multiple choices are not remembered, as the danger exists that the user might fail to notice some of the highlit items (for example, all the items might not fit onto one screen). The database I<~/.clui_dir/choices> or I<$ENV{CLUI_DIR}/choices> is available to be read or written if lower-level manipulation is needed, and the I routines I($question) and I($question, $choice) should be used for this purpose, as they handle DBM's problem with concurrent accesses. The whole default database mechanism can be disabled by I if you really want to :-( If the items won't fit on the screen, the user is asked to enter a substring as a clue. As soon as the matching items will fit, they are displayed to be chosen as normal. If the user pressed "q" at this choice, they are asked if they wish to change their substring clue; if they reply "n" to this, choose quits and returns I. If the $question is multi-line, The first line is put at the top as usual with the choices arranged beneath it; the subsequent lines are formatted within the screen width and displayed at the bottom. After the choice is made all but the first line is erased, and the first line remains on-screen with the choice appended after it. You should therefore try to arrange multi-line questions so that the first line is the question in short form, and subsequent lines are explanation and elaboration. =item I( $question ); Asks the question, takes "y", "n", "Y" or "N" as a response. If the $question is multi-line, after the response, all but the first line is erased, and the first line remains on-screen with I or I appended after it; you should therefore try to arrange multi-line questions so that the first line is the question in short form, and subsequent lines are explanation and elaboration. Returns true or false. =item I( $title, $text ); OR I( $filename ); Uses the environment variable EDITOR ( or I :-) Uses RCS if directory RCS/ exists =item I( $message ); Similar to I =item I( $message ); Similar to I except that it doesn't add the newline at the end if there already is one, and it uses I rather than I if it can. =item I( $title, $text ); OR I( $filename ); If the I<$text> is longer than a screenful, uses the environment variable PAGER ( or I ) to display it. If it is one or two lines it just omits the title and displays it. Otherwise it uses a simple built-in routine which expects either "q" or I from the user; if the user presses I the displayed text remains on the screen and the dialogue continues after it, if the user presses "q" the text is erased. If there is only one argument and it's a filename, then the user's PAGER displays it, except (since 1.65) if it's a I<.doc> file, when either I, I or I is used to extract its contents first. =item I( $mode ); This returns a short help message for the user. If I is "ask" then the text describes the keys the user has available when responding to an I<&ask> question; If I is "multi" then the text describes the keys and mouse actions the user has available when responding to a multiple-choice I<&choose> question; otherwise, the text describes the keys and mouse actions the user has available when responding to a single-choice I<&choose>. =back =head1 EXPORT_OK SUBROUTINES The following routines are not exported by default, but are exported under the I tag, so if you need them you should: import Term::Clui qw(:ALL); =over 3 =item I() Beeps. =item I() Returns a sortable timestamp string in "YYYYMMDD hhmmss" form. =item I( $question ) Consults the database I<~/.clui_dir/choices> or I<$ENV{CLUI_DIR}/choices> and returns the choice that the user made the last time this question was asked. This is better than opening the database directly as it handles DBM's problem with concurrent accesses. =item I( $question, $new_default ) Opens the database I<~/.clui_dir/choices> or I<$ENV{CLUI_DIR}/choices> and sets the default response which will be offered to the user made the next time this question is asked. This is better than opening the database directly as it handles DBM's problem with concurrent accesses. =back =head1 DEPENDENCIES It requires Exporter, which is core Perl. It uses Term::ReadKey if it's available; and uses Term::Size if it's available; if not, it tries I before guessing 80x24. =head1 ENVIRONMENT The environment variable I can be used (by programmer or user) to override I<~/.clui_dir> as the directory in which I keeps its database of previous choices. The whole default database mechanism can be disabled by I if you really want to :-( If either the LANG or the LC_TYPE environment variables contain the string I or I (case insensitive), then I and I open I with a I encoding. If the environment variable I is set or if I is set to I, and if I is installed, then I will use I to speak its questions and choices out loud. If the environment variable I is set to I then I will not interpret mouse-clicks as making a choice. The advantage of this is that the mouse can then be used to highlight and paste text from this window as usual. I also consults the environment variables HOME, LOGDIR, EDITOR and PAGER, if they are set. =head1 EXAMPLES These scripts using Term::Clui and Term::Clui::FileSelect are to be found in the I subdirectory of the build directory. =over 3 =item I I use this script a lot at work, for routine system administration of linux boxes, particularly Fedora and Debian. It includes crontab, chkconfig, update-rc.d, visudo, vipw, starting and stopping daemons, reconfiguring squid samba or apache, editing sysconfig or running any of the system-config-* utilities, and much else. =item I This script offers an arrow-key-and-return interface integrating aplaymidi, cdrecord, cdda2wav, icedax, lame, mkisofs, muscript, normalize, normalize-audio, mpg123, sndfile-play, timidity, wodim and so on, allowing audio files to be ripped, burned, played, or converted between Muscript, MIDI, WAV and MP3 formats. =item I This script offers the naive user arrow-key-and-return access to a text-based browser, a mail client, a news client, ssh and ftp and various other stuff. =item I This is the test script, as used during development. =item I This is a script which wraps Term::Clui::choose for use at the shell-script level. It can either choose between command-line arguments, or, with the B<-f> (filter) option, between lines of STDIN, like grep. A B<-m> (multiple) option allows multiple-choice. This can be a very useful script, and you may want to copy it into I or elsewhere in your PATH. =back =head1 AUTHOR Peter J Billam www.pjb.com.au/comp/contact.html =head1 CREDITS Based on some old perl 4 libraries, I, I, I, I, I, I and I, which were in turn based on some even older curses-based programs in I. =head1 SEE ALSO Term::Clui::FileSelect Term::ReadKey Term::Size http://www.pjb.com.au/ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html http://search.cpan.org/~pjb festival(1) eflite(1) espeak(1) espeakup(1) edbrowse(1) emacspeak(1) perl(1) There is an equivalent Python3 module, with (as far as possible) the same calling interface, at http://cpansearch.perl.org/src/PJB/Term-Clui-1.70/py/TermClui.py =cut Term-Clui-1.70/Clui/FileSelect.pm0000644000076400017510000002316312360140160014132 0ustar pjb# Term/Clui/FileSelect.pm ######################################################################### # This Perl module is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This module is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### package Term::Clui::FileSelect; $VERSION = '1.70'; import Term::Clui(':DEFAULT','back_up'); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(select_file); @EXPORT_OK = qw(); no strict; no warnings; my $home = $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[$[+7]; $home =~ s#([^/])$#$1/#; sub select_file { my %option = @_; if (!defined $option{'-Path'}) { $option{'-Path'}=$option{'-initialdir'}; } if (!defined $option{'-FPat'}) { $option{'-FPat'}=$option{'-filter'}; } if (!defined $option{'-ShowAll'}) { $option{'-ShowAll'} = $option{'-dotfiles'}; } if ($option{'-Directory'}) { $option{'-Chdir'}=1; $option{'-SelDir'}=1; } my $multichoice = 0; if (wantarray && !$option{'-Chdir'} && !$option{'-Create'}) { $option{'-DisableShowAll'} = 1; $multichoice = 1; } elsif (!defined $option{'-Chdir'}) { $option{'-Chdir'} = 1; } if ($option{'-Path'} && -d $option{'-Path'}) { $dir=$option{'-Path'}; if ($dir =~ m#[^/]$#) { $dir .= '/'; } } else { $dir = $home; } if ($option{'-TopDir'}) { if (!-d $option{'-TopDir'}) { delete $option{'-TopDir'}; } elsif ($option{'-TopDir'} =~ m#[^/]$#) { $option{'-TopDir'} .= '/'; } if (index $dir, $option{'-TopDir'}) { $dir = $option{'-TopDir'}; } } my ($new, $file, @allfiles, @files, @dirs, @pre, @post, %seen, $isnew); my @dotfiles; while () { if (! opendir (D, $dir)) { warn "can't opendir $dir: $!\n"; return 0; } if ($option{'-SelDir'}) { @pre = ('./'); } else { @pre = (); } @post = (); @allfiles = sort grep(!/^\.\.?$/, readdir D); closedir D; @dotfiles = grep(/^\./, @allfiles); if ($option{'-ShowAll'}) { if (@dotfiles && !$option{'-DisableShowAll'}) { @post='Hide DotFiles'; } } else { @allfiles = grep(!/^\./, @allfiles); if (@dotfiles && !$option{'-DisableShowAll'}) { @post='Show DotFiles'; } } # split @allfiles into @files and @dirs for option processing ... @dirs = grep(-d "$dir/$_" && -r "$dir/$_", @allfiles); if ($option{'-Directory'}) { @files = (); } elsif ($option{'-FPat'}) { @files = grep(!-d $_, glob("$dir/$option{'-FPat'}")); my $length = $[ + 1 + length $dir; foreach (@files) { $_ = substr $_, $length; } } else { @files = grep(!-d "$dir/$_", @allfiles); } if ($option{'-Chdir'}) { foreach (@dirs) { s#$#/#; } if ($option{'-TopDir'}) { my $up = $dir; $up =~ s#[^/]+/?$##; # find parent directory if (-1 < index $up, $option{'-TopDir'}) { unshift @pre, '../'; } # must check for symlinks to outside the TopDir ... } else { unshift @pre, '../'; } } elsif (!$option{'-SelDir'}) { @dirs = (); } if ($option{'-Create'}) { unshift @post, 'Create New File'; } if ($option{'-TextFile'}) { @files = grep(-T "$dir/$_", @files); } if ($option{'-Owned'}) { @files = grep(-o "$dir/$_", @files); } if ($option{'-Executable'}) { @files = grep(-x "$dir/$_", @files); } if ($option{'-Writeable'}) { @files = grep(-w "$dir/$_", @files); } if ($option{'-Readable'}) { @files = grep(-r "$dir/$_", @files); } @allfiles = (@pre, (sort @dirs,@files), @post); # reconstitute @allfiles my $title; if ($option{'-Title'}) { $title = "$option{'-Title'} in $dir" } else { $title = "in directory $dir ?"; } if ($option{'-File'}) { &set_default($title, $option{'-File'}) } $Term::Clui::SpeakMode{'dot'} = 1; if ($multichoice) { my @new = &choose ($title, @allfiles); $Term::Clui::SpeakMode{'dot'} = 0; return () unless @new; foreach (@new) { $_="$dir$_"; } return @new; } $new = &choose ($title, @allfiles); $Term::Clui::SpeakMode{'dot'} = 0; if ($option{'-ShowAll'} && $new eq 'Hide DotFiles') { delete $option{'-ShowAll'}; redo; } elsif (!$option{'-ShowAll'} && $new eq 'Show DotFiles') { $option{'-ShowAll'} = 1; redo; } if ($new eq "Create New File") { $new = &ask ("new file name ?"); # validating this is a chore ... if (! $new) { next; } if ($new =~ m#^/#) { $file = $new; } else { $file = "$dir$new"; } $file =~ s#/+#/#g; # simplify //// down to / while ($file =~ m#./\.\./#) { $file =~ s#[^/]*/\.\./##; } # zap /../ $file =~ s#/[^/]*/\.\.$##; # and /.. at end if ($option{'-TopDir'}) { # check against escape from TopDir if (index $file, $option{'-TopDir'}) { $dir = $option{'-TopDir'}; next; } } if (-d $file) { # pre-existing directory ? if ($option{'-SelDir'}) { return $file; } else { $dir=$file; if ($dir =~ m#[^/]$#) { $dir.='/'; } next; } } $file =~ m#^(.*/)([^/]+)$#; if (-e $file) { $dir = $1; $option{'-File'} = $2; next; } # exists ? # must check for creatability (e.g. dir exists and is writeable) if (-d $1 && -w $1) { return $file; } if (!-d $1) { &sorry ("directory $1 does not exist."); next; } &sorry ("directory $1 is not writeable."); next; } return undef unless $new; if ($new eq './' && $option{'-SelDir'}) { return $dir; } if ($new =~ m#^/#) { $file = $new; # abs filename } else { $file = "$dir$new"; # rel filename (slash always at end) } if ($new eq '../') { $dir =~ s#[^/]+/?$##; &back_up(); next; } elsif ($new eq './') { if ($option{'-SelDir'}) { return $dir; } $file = $dir; } elsif ($file =~ m#/$#) { $dir = $file; &back_up(); next; } elsif (-f $file) { return $file; } } } 1; __END__ =pod =head1 NAME Term::Clui::FileSelect - Perl module to ask the user to select a file. =head1 SYNOPSIS use Term::Clui; use Term::Clui::FileSelect; $file = &select_file(-Readable=>1, -TopDir=>"/home", -FPat=>"*.html"); @files = &select_file(-Chdir=>0, -Path=>$ENV{PWD}, -FPat=>"*.mp3"); chdir &select_file(-Directory=>1, -Path=>$ENV{PWD}); =head1 DESCRIPTION This module asks the user to select a file from the filesystem. It uses the Command-line user-interface Term::Clui to dialogue with the user. It offers I and I buttons. To ease the re-learning burden for the programmer, the options are modelled on those of Tk::FileDialog and of Tk::SimpleFileSelect, but various new options are introduced, namely I<-TopDir>, I<-TextFile>, I<-Readable>, I<-Writeable>, I<-Executable>, I<-Owned> and I<-Directory> Multiple choice is possible in a limited circumstance; when I is invoked in a list context, with -Chdir=>0 and without -Create. It is currently not possible to select multiple files lying in different directories. =head1 SUBROUTINES =over 3 =item I( %options ); =back =head1 OPTIONS =over 3 =item I<-Chdir> Enable the user to change directories. The default is 1. If it is set to 0, and I is invoked in a list context, and I<-Create> is not set, then the user can select multiple files. =item I<-Create> Enable the user to specify a file that does not exist. The default is 0. =item I<-ShowAll> or I<-dotfiles> Determines whether hidden files (.*) are displayed. The default is 0. =item I<-DisableShowAll> Disables the ability of the user to change the status of the ShowAll flag. The default is 0 (i.e. the user is by default allowed to change the status). =item I<-SelDir> If True, enables selection of a directory rather than a file. The default is 0. To I selection of a directory, use the I<-Directory> option. =item I<-FPat> or I<-filter> Sets the default file selection pattern, in glob format, e.g. I<*.html>. Only files matching this pattern will be displayed. If you want multiple patterns, you can use formats like I<*.[ch]> or I<{*.cgi,*.pl}> - see I for more details. The default is "*". =item I<-File> The file selected, or the default file. The default default is whatever the user selected last time in this directory. =item I<-Path> or I<-initialdir> The path of the selected file, or the initial path. The default is $ENV{HOME}. =item I<-Title> The Title of the dialog box. If I<-Title> is specified, then Clui::FileSelect dynamically appends "in I" to it. If I<-Title> is not specified, Clui::FileSelect displays "in directory I". =item I<-TopDir> Restricts the user to remain within a directory or its subdirectories. The default is "/". This option, and the following, are not offered by Tk::FileDialog. =item I<-TextFile> Only text files will be displayed. The default is 0. =item I<-Readable> Only readable files will be displayed. The default is 0. =item I<-Writeable> Only writeable files will be displayed. The default is 0. =item I<-Executable> Only executable files will be displayed. The default is 0. =item I<-Owned> Only files owned by the current user will be displayed. This is useful if the user is being asked to choose a file for a I or I operation, for example. The default is 0. =item I<-Directory> Only directories will be displayed. The default is 0. =back =head1 BUGS Three problem filenames will, if present in your file-system, cause confusion. They are I, I and I =head1 AUTHOR Peter J Billam www.pjb.com.au/comp/contact.html =head1 CREDITS Based on an old Perl4 library, I, with the options modelled after I and I. =head1 SEE ALSO http://www.pjb.com.au/ , http://search.cpan.org/~pjb , File::Glob , Term::Clui , Tk::FileDialog , Tk::SimpleFileSelect , perl(1) . =cut Term-Clui-1.70/Makefile.PL0000644000076400017510000000143211153573622012642 0ustar pjbuse ExtUtils::MakeMaker; my $have_Term_ReadKey = 1; eval 'require "Term/ReadKey.pm"'; if ($@) { $have_Term_ReadKey = 0; } my $have_Term_Size = 1; eval 'require "Term/Size.pm"'; if ($@) { $have_Term_Size = 0; } if (!$have_Term_ReadKey) { print <<'EOT'; } The CPAN module Term::ReadKey is not installed; it's optional, but it should improve portability. EOT if (!$have_Term_Size && !$have_Term_ReadKey) { print <<'EOT'; } The CPAN module Term::Size is not installed either; again, it's optional, but it should improve portability. EOT WriteMakefile( NAME => 'Term::Clui', VERSION_FROM => 'Clui.pm', AUTHOR => 'PJB, Peter Billam, www.pjb.com.au/comp/contact.html', ABSTRACT => 'Command-Line User Interface on /dev/tty', dist => {COMPRESS=>'gzip -9f', SUFFIX => 'gz'}, ); Term-Clui-1.70/test.pl0000644000076400017510000000166710174123561012211 0ustar pjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### use Test::Simple tests => 3; eval "require 'Term/Clui.pm'"; ok (! $@, 'Term::Clui compiles'); eval "require 'Term/Clui/FileSelect.pm'"; ok (! $@, 'Term::Clui::FileSelect compiles'); ok ($Term::Clui::VERSION eq $Term::Clui::FileSelect::VERSION, 'version numbers agree'); print <<'EOT'; # It's not easy to test a user-interface automatically; # to test it by hand, try "perl examples/test_script" ... EOT Term-Clui-1.70/META.yml0000644000076400017510000000056412360140042012131 0ustar pjb# http://module-build.sourceforge.net/META-spec-current.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Term-Clui version: 1.70 version_from: Clui.pm installdirs: site requires: Term::ReadKey: 0 Term::ReadLine::Gnu: 0 recommends: Term::Size: 0 license: perl distribution_type: module generated_by: /usr/bin/vim Term-Clui-1.70/examples/login_shell0000755000076400017510000001330011726507144014732 0ustar pjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### use Term::Clui; use Term::Clui::FileSelect; my $home = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7]; my $user = $ENV{'USER'} || $ENV{'LOGNAME'} || (getpwuid($<))[0]; my @path = split ':', $ENV{PATH}; my $browser = ''; my $mailer = ''; use Cwd; my $dir = cwd(); while (1) { my @tasks = ('Browser','Config','ChDir','Edit','FTP', 'IRC','Mail'); if (-r './Makefile') { push (@tasks, 'Make'); } push (@tasks, 'Manual', 'News'); if (-d "$home/.ssh") { push (@tasks, 'SSH'); } push (@tasks, 'View'); my $shortdir = $dir; if ((index $shortdir,$home)==0) {substr($shortdir,0,(length $home))= '~';} my $task = &choose ("$user $shortdir", @tasks); if (! $task) { exit 0; } else { $task =~ s/ /_/g; eval "&$task"; } } sub Config { my @files = grep (-w "$home/$_", '.cshrc', '.efaxrc', '.emacspeak', '.edbrowse', '.exrc', '.fvwmrc', '.html2psrc', '.jnewsrc', '.login', '.lynxrc', 'lynx_bookmarks.html', '.mailrc', '.mplayer/config', '.netrc', '.newsrc', '.perltidyrc', '.pinerc', '.popslurp', '.profile', '.rhosts', '.sig', '.slrnrc', '.ssh/config', '.tiprc', '.xauth', '.Xauthority', '.xinitrc', ); my $file; $file = &choose("Edit which file ?", @files); return unless $file; &edit("$home/$file"); } sub Browser { if (! $browser) { my ($bin, $prog); DIR: foreach $bin (@path) { foreach $prog ('lynx', 'w3m', 'links') { if (-e "$bin/$prog") { $browser = "$bin/$prog"; last DIR; } } } } if (! $browser) { &sorry("can't find a browser: tried lynx, w3m and links") ; return; } system $browser; } sub ChDir { my $newdir = &ask('to which directory ?'); return unless $newdir; $newdir =~ s/^~\//$home\//; if (! -d $newdir) { &sorry("$newdir isn't a directory"); return; } if (! chdir $newdir) { &sorry("can't chdir to $newdir: $!"); return; } $dir = cwd(); } sub Edit { if (!opendir(D,'.')) { &sorry("can't open current directory: $!"); return; } my @textfiles = sort grep (-T && !/^\./, readdir D); closedir D; my $file = 'Create new file'; if (@textfiles) { $file = &choose('Edit which file ?',@textfiles,'Create new file'); return unless $file; } if ($file eq 'Create new file') { $file = &ask('New file name ?'); return unless $file; system "touch $file"; } &edit($file); } sub FTP { if (!open(F,"$home/.netrc")) { &sorry("can't open $home/.netrc: $!"); return; } my (%login, %password); while () { if (/^machine\s+(\S+)\s+login\s+(\S+)\s+password\s+(\S+)\s*$/) { $login{$1} = $2; $password{$1} = $3; } } close F; my $task = &choose('FTP to :',keys %login,'Somewhere else','Edit ~/.netrc'); if (! $task) { return 1; } elsif ($task eq 'Somewhere else') { my $host = &ask('FTP to where ?'); if ($host) { system "ftp $host"; } } elsif ($task eq 'Edit ~/.netrc') { &edit("$home/.netrc"); } else { system "ftp $task"; } } sub IRC { if (! $ircclient) { my ($bin, $prog); DIR: foreach $bin (@path) { foreach $prog ('sirc','tinyirc') { if (-e "$bin/$prog") { $ircclient = "$bin/$prog"; last DIR; } } } } if (! $ircclient) { &sorry("can't find a ircclient: tried sirc and tinyirc") ; return; } system $ircclient; } sub Mail { if (! $mailer) { my ($bin, $prog); DIR: foreach $bin (@path) { foreach $prog ('alpine','pine', 'elm') { if (-e "$bin/$prog") { $mailer = "$bin/$prog"; last DIR; } } } } if (! $mailer) { &sorry("can't find a mailer: tried alpine, pine and elm") ; return; } system $mailer; } sub Make { if (!open(F,'./Makefile')) { &sorry("can't open Makefile: $!"); return; } my (%vars, @targets, $target); while () { if (/^\s*(\S+)\s*=\s*(\S+)/) { $vars{$1} = $2; } if (/^\s*(\S+)\s*:/) { $target = $1; while ($target =~ /\$[({](\w+)[)}]/ && $vars{$1}) { $target =~ s/\$[({](\w+)[)}]/$vars{$1}/; } push (@targets, $target); } } close F; $target = &choose("$dir : Make what ?", @targets); return unless $target; system "make $target"; } sub Manual { my $topic = &ask('Topic ?'); return unless $topic; if (system "man '$topic'") { my $txt = `man -k '$topic'`; &view("Keyword search on $topic", $txt); } } sub News { system 'slrn'; # /usr/bin/trn ? } sub SSH { # make sure ~/.ssh/config contains: HashKnownHosts no if (! open(F,"$home/.ssh/known_hosts")) { &sorry("can't open $home/.ssh/known_hosts: $!"); return; } my (%hosts); while () { if (/^([.\w]+)/) { $hosts{$1}++; } } close F; my @hosts = sort keys %hosts; my $host = &choose('SSH to :', @hosts, 'Somewhere else'); if (! $host) { return 1; } elsif ($host eq 'Somewhere else') { $host = &ask('ssh to which host ?'); if ($host) { system "ssh $host"; } } else { system "ssh $host"; } } sub View { my $file = select_file(-Readable=>1); &view($file); } =pod =head1 NAME login_shell - wrapper for text-based browser, mail, news, ssh, ftp etc. =head1 SYNOPSIS $ login_shell =head1 DESCRIPTION This script offers the naive user arrow-key-and-return access to a text-based browser, a mail client, a news client, ssh, ftp, man and various other stuff. =head1 AUTHOR Peter J Billam www.pjb.com.au/comp/contact.html =head1 CREDITS Based on Term::Clui =head1 SEE ALSO http://www.pjb.com.au/ , http://search.cpan.org/~pjb , Term::Clui, Term::Clui::FileSelect, lynx(1), slrn(1), pine(1), ssh(1), ftp(1), make(1), man(1) =cut Term-Clui-1.70/examples/test_script0000644000076400017510000002077011734137554015007 0ustar pjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### use utf8; use open ':locale'; # when was the open pragma introduced ? #my $EncodingString = q{}; #if (($ENV{LANG} =~ /utf-?8/i) || ($ENV{LC_TYPE} =~ /utf-?8/i)) { # $EncodingString = ':encoding(utf8)'; # binmode STDERR, $EncodingString; # binmode STDOUT, $EncodingString; #} if (($ENV{LANG} =~ /utf-?8/i) || ($ENV{LC_TYPE} =~ /utf-?8/i)) { $Brillouin = "Léon Brillouin"; $Delbrueck = "Max Delbrück"; $Descartes = "René Descartes"; $Goedel = "Kurt Gödel"; $Levy = "Paul Lévy"; $Poincare = "Henri Poincaré"; $Schroedinger = "Erwin Schrödinger"; } else { $Brillouin = "L\x{e9}on Brillouin"; $Delbrueck = "Max Delbr\x{fc}ck"; $Descartes = "Ren\x{e9} Descartes"; $Goedel = "Kurt G\x{f6}del"; $Levy = "Paul L\x{e9}vy"; $Poincare = "Henri Poincar\x{e9}"; $Schroedinger = "Erwin Schr\x{f6}dinger"; } eval "require 'Term/Clui.pm'"; if (!$@) { warn "using Term::Clui\n"; } else { eval "require '../Clui.pm'"; if (!$@) { warn "using ../Clui.pm\n"; } else { eval "require 'Clui.pm'"; if (!$@) { warn "using ./Clui.pm\n"; } else { die "can't find Clui.pm in this dir, parent dir, or INC path\n"; } } } import Term::Clui; eval "require './Term/Clui/FileSelect.pm'"; if ($@) { eval "require '../Clui/FileSelect.pm'"; } if ($@) { eval "require 'Clui/FileSelect.pm'"; } if ($@) { die "can't find FileSelect.pm in this dir, parent dir, or INC path\n"; } import Term::Clui::FileSelect; my $colour = ""; my $paint = ""; my $name = ""; while (1) { my $task = &choose('Test which Clui.pm subroutine ?', 'ask','choose','confirm','edit','view','select_file', ); exit unless $task; eval "&test_$task()"; if ($@) { print STDERR "$@\n"; } } sub test_choose { my @colours = ('Red','Orange','Black','Grey','Blue'); my @paints = ( 'Bizzare extremely long name that certainly will never occur on any real artist pallette', 'Alizarin Crimson', 'Burnt Sienna', 'Cadmium Yellow', 'Cobalt Blue', 'Flake White', 'Indian Red', 'Indian Yellow', 'Ivory Black', 'Lemon Yellow', 'Naples Yellow', 'Prussian Blue', 'Raw Sienna', 'Raw Umber', 'Red Ochre', 'Rose Madder', 'Ultramarine Blue', 'Vandyke Brown', 'Viridian Green', 'Yellow Ochre', ); my @scientists = ( 'Luis Alvarez', 'Alain Aspect', 'Michael Barnsley', 'Johann Bernouilli', 'Nicolas Bernouilli', 'Friedrich Wilhelm Bessel', 'John Bell', 'Antoine Becquerel', 'Hans Bethe', 'David Bohm', 'Niels Bohr', 'Ludwig Boltzmann', 'Hermann Bondi', 'George Boole', 'Max Born', 'Satyendra Bose', 'Robert Boyle', $Brillouin, 'Eugenio Calabi', 'Georg Cantor', 'James Chadwick', 'Gregory Chaitin', 'Subrahmanyan Chandrasekar', 'Geoffrey Chew', 'Alonzo Church', 'John Horton Conway', 'Francis Crick', 'Marie Curie', 'Charles Darwin', 'Humphrey Davy', 'Richard Dawkins', 'Louis de Broglie', $Delbrueck, $Descartes, 'Willem de Sitter', 'Bruce DeWitt', 'Paul Dirac', 'Freeman Dyson', 'Arthur Stanley Eddington', 'Albert Einstein', 'Leonhard Euler', 'Hugh Everett', 'Michael Faraday', 'Pierre Fatou', 'Mitchell Feigenbaum', 'Pierre de Fermat', 'Enrico Fermi', 'Richard Feynman', 'Joseph Fraunhofer', 'Galileo Galilei', 'Evariste Galois', 'George Gamov', 'Carl Friedrich Gauss', 'Murray Gell-Mann', $Goedel, 'Alan Guth', 'Stephen Hawking', 'Felix Hausdorff', 'Werner Heisenberg', 'Charles Hermite', 'Peter Higgs', 'David Hilbert', 'Fred Hoyle', 'Edwin Hubble', 'Christian Huygens', 'David Hilbert', 'Edwin Hubble', 'Pascual Jordan', 'Gaston Julia', 'Marc Kac', 'Theodor Kaluza', 'Stuart Kauffman', 'William Lord Kelvin', 'Gustav Robert Kirchhoff', 'Oskar Klein', 'Helge von Kock', 'Willis Lamb', 'Lev Davidovich Landau', 'Paul Langevin', 'Pierre Simon de Laplace', 'Gottfried Wilhelm Leibnitz', $Levy, 'Hendrik Lorentz', 'James Clark Maxwell', 'Marston Morse', 'Benoit Mandelbrot', 'Gregor Mendel', 'Dmitri Mendeleev', 'Robert Millikan', 'Hermann Minkowski', 'John von Neumann', 'Isaac Newton', 'Emmy Noether', 'Hans Christian Oersted', 'Lars Onsager', 'Robert Oppenheimer', 'Abraham Pais', 'Heinz Pagels', 'Vilfredo Pareto', 'Louis Pasteur', 'Wolfgang Pauli', 'Linus Pauling', 'Guiseppe Peano', 'Rudolf Peierls', 'Roger Penrose', 'Arno Penzias', 'Jean Perrin', 'Max Planck', 'Boris Podolsky', $Poincare, 'Isidor Rabi', 'Srinivasa Ramanujan', 'Lord Rayleigh', 'Lewis Fry Richardson', 'B. Riemann', 'Nathan Rosen', 'Ernest Rutherford', 'Abdus Salam', $Schroedinger, 'Karl Schwarzschild', 'Julian Schwinger', 'Claude Shannon', 'Waclaw Sierpinski', 'Leo Szilard', 'Kip Thorne', 'Alan Turning', 'Sin-itro Tomonaga', 'Stanislaw Ulam', 'James Watson', 'Karl Weierstrauss', 'Hermann Weyl', 'Steven Weinberg', 'John Wheeler', 'Charles Weiner', 'Norbert Wiener', 'Eugene Wigner', 'Robert Wilson', 'Edward Witten', 'Shing-Tung Yau', 'Chen-Ning Yang', 'Hideki Yukawa', 'George Kingsley Zipf', ); my $multi = &choose('Mode ?', 'Single-choice', 'Multi-choice'); return unless $multi; if ($multi eq 'Single-choice') { $paint = &choose("Your favourite paint ?\n".help_text(), @paints); my $scientist = &choose("Your favourite scientist ?", @scientists); $colour = &choose(<<'EOT', @colours); Your favourite colour ? This tests how the 'choose' subroutine handles multi-line questions. After you choose, all but the first line should disappear, leaving the question and answer on the screen as a record of the dialogue. The other lines should only get displayed if there is room. EOT &inform("paint=$paint, scientist=$scientist, colour=$colour\n"); } else { my @fav_paints = &choose("Your favourite paints ?\n".help_text('multi'),@paints); my @fav_scientists = &choose("Your favourite scientists ?",@scientists); warn "paints = ".join(', ',@fav_paints) . "\nscientists = ".join(', ',@fav_scientists)."\n"; } return; } sub test_confirm { &confirm(<'Fred', Orange=>'Solange', Black=>'Jack', Grey=>'May', Blue=>'Sue', ); $name = &ask("Choose a name which rhymes with $colour :", $names{$colour}); warn "string=$string, name=$name\n"; my $passwd = ask_password("Enter some password:"); warn "that password was ".length($passwd)." chars long\n"; my $f = ask_filename("filename ?\n\ntry out the tab-filename-completion"); warn "that filename was $f\n"; } sub test_edit { $text = &edit('Your limerick', <0, %opts); print STDERR "You selected @files\n"; } else { print STDERR "You selected " .&select_file(%opts), "\n"; } } Term-Clui-1.70/examples/linux_admin0000750000076400017510000003630611350276446014751 0ustar pjb#! /usr/bin/perl # ######################################################################### # This Perl script is Copyright (c) 2003, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### use Term::Clui; use Term::Clui::FileSelect; $debug = 0; $hostname = `hostname`; $hostname =~ s/[\r\n]*//; @PATH = split (":", $ENV{PATH}); my $daemon_d; my @system_configs; my $crond = &first_existing('/var/spool/cron/crontabs','/var/spool/cron'); my $squidlogd = &first_existing('/usr/local/squid/logs','/var/squid/logs'); my $squidconfd = &first_existing('/usr/local/squid/etc','/etc/squid'); my $squid = &first_existing('/usr/local/squid/sbin/squid','/usr/sbin/squid'); my $sambalogd = &first_existing('/usr/local/samba/var','/var/log/samba'); my $sambaconfd = &first_existing('/usr/local/samba/lib','/etc/samba'); my $tracd = &first_existing('/var/www/trac'); my $svnd = &first_existing('/usr/local/svn'); my $lshw = &first_existing('/usr/local/bin/lshw','/usr/bin/lshw'); my $apacheconfd = &first_existing( '/usr/local/apache/conf', '/usr/local/apache2/conf','/etc/apache2','/etc/apache'); my $dirvishconf = &first_existing('/etc/dirvish.conf', '/usr/local/dirvish/etc/master.conf','/etc/dirvish/master.conf'); my $lsmod = &which('lsmod'); my $modinfo = &which('modinfo'); @tasks = &tasks(); if (! @tasks) { die "Sorry, no administration tasks are available\n"; } while () { $task = &choose("Administrating $hostname", @tasks); if (! $task) { exit; } elsif ($task eq "Become superuser") { exec "su - -c $0"; } elsif ($task eq "adduser") { &adduser(); } elsif ($task eq "aptitude") { system "aptitude"; } elsif ($task eq "base-config") { system "base-config"; } elsif ($task eq "chpass") { system "chpass"; } elsif ($task eq "chkconfig") { &chkconfig(); } elsif ($task eq "lshw") { system "lshw | less"; } elsif ($task eq "mii-tool") { system "mii-tool"; } elsif ($task eq "system-config") { &system_config(); } elsif ($task eq "trac-admin") { &trac_admin(); } elsif ($task eq "update-rc.d") { &update_rcd(); } elsif ($task eq "vipw") { system "vipw"; system "vipw -s"; } elsif ($task eq "visudo") { system "visudo"; } elsif ($task eq "Apache") { &apache(); } elsif ($task eq "Crontab") { &crontab(); } elsif ($task eq "Daemons") { &daemons(); } elsif ($task eq "Dirvish") { &dirvish(); } elsif ($task eq "Modules") { &modules(); } elsif ($task eq "Network ports") { &ports(); } elsif ($task eq "Samba") { &samba(); } elsif ($task eq "Squid") { &squid(); } elsif (-f $task) { &edit ($task); } elsif (-d $task) { $file = &select_file(-TextFile=>1, -TopDir=>$task); if ($file) { &edit ($file) }; } } sub tasks { my @tasks; if (! $>) { # root stuff foreach $f ( qw(adduser aptitude base-config chkconfig chpass lshw mii-tool sax sax2 trac-admin update-rc.d vipw visudo yast yast2)) { if (&which($f)) { push @tasks, $f; } } if (opendir D, '/usr/bin') { @system_configs = sort grep /^system-config-/,readdir D; closedir D; if (@system_configs) { push @tasks, 'system-config'; } foreach (@system_configs) { s/^system-config-//; } } } else { push @tasks, 'Become superuser'; } foreach ( '/etc/inittab', '/etc/sysconfig', '/etc/xinetd.d', '/etc/resolv.conf', '/etc/iptables.up.rules', '/etc', ) { if (-d $_ || -f $_) { push @tasks, $_; } } if (-d $apacheconfd) { push @tasks, 'Apache'; } if (-d $crond) { push @tasks, 'Crontab'; } if (! $>) { foreach ('/etc/rc.d/init.d','/etc/init.d') { if (-d $_) {$daemon_d = $_; push @tasks, 'Daemons'; last} } } if (-e $dirvishconf) { push @tasks, 'Dirvish'; } if ($lsmod && $modinfo) { push @tasks, 'Modules'; } push @tasks, 'Network ports'; if (-d $squidlogd) { push @tasks, 'Squid'; } if (-d $sambaconfd) { push @tasks, 'Samba'; } return @tasks; } sub squid { my @tasks = ( 'tail -f access.log', 'tail -f access.log | grep', 'tail -f cache.log'); if ($squid && !$>) { push @tasks, 'Reconfigure'; } my $task = &choose('Squid ?', @tasks); return unless $task; if ($task =~ /(\w+\.log)$/) { system "tail -f $squidlogd/$1"; } elsif ($task =~ /grep$/) { my $s = &ask ('look for what regexp ?'); next unless $s; system "tail -f $squidlogd/access.log | grep '$s'"; } elsif ($task eq 'Reconfigure') { if (! chdir $squidconfd) { &sorry("can't chdir $squidconfd: $!"); return; } &edit ('squid.conf'); if (&confirm ('OK to "squid -k reconfigure" ?')) { system "$squid -k reconfigure"; } } } sub samba { my $sambabind = "/usr/bin"; if (-d "/usr/local/samba/bin") { $sambabind = "/usr/local/samba/bin"; } my @tasks = ('log.smbd','log.winbindd'); if (!$>) { push @tasks, 'smb.conf'; } if (-w "$sambaconfd/username.map") { push @tasks, 'username.map'; } my $task = &choose('Samba ?', @tasks); return unless $task; if ($task =~ /log/) { system "tail -f $sambalogd/$task"; } elsif ($task =~ /grep$/) { my $s = &ask ('look for what regexp ?'); next unless $s; system "tail -f $sambalogd/log | grep '$s'"; } elsif ($task eq 'smb.conf' || $task eq 'username.map') { if (! chdir $sambaconfd) { &sorry("can't chdir sambaconfd: $!"); return; } while (1) { &edit ($task); my $retval = system "$sambabind/testparm"; if ($? == -1) { &sorry("can't run testparm: $!\n"); return; } elsif ($? & 127) { &sorry (sprintf "testparm died with signal %d, %s coredump\n", ($? & 127), ($? & 128)?'with':'without'); return; } else { # $retval >> 8; if (! $retval) { if (&confirm ('OK to Reload Config ?')) { system "$sambabind/smbcontrol smbd reload-config"; system "$sambabind/smbcontrol nmbd reload-config"; } last; } else { warn "That didn't work, you'll need to re-edit smb.conf ...\n"; } } } } } sub apache { my $d = $apacheconfd; my $file; my $apachectl; my @tasks = (); my $enabled = &first_existing("$d/sites-enabled","$d/vhosts.d","$d/conf.d"); if ($enabled) { push @tasks, "Edit a site"; } my $a2ensite = &which('a2ensite'); if ($a2ensite) { push @tasks, 'Enable a site'; } my $a2dissite = &which('a2dissite'); if ($a2dissite) { push @tasks, 'Disable a site'; } my $a2enmod = &which('a2enmod'); if ($a2enmod) { push @tasks, 'Enable a module'; } my $a2dismod = &which('a2dismod'); if ($a2dismod) { push @tasks, 'Disable a module'; } my $conff = &first_existing("$d/apache2.conf","$d/httpd.conf"); if ($conff) { push @tasks, "Edit main config file"; } if (! @tasks) { return; } my $task = &choose("which apache task ?", @tasks); return unless $task; if ($task eq 'Edit a site') { my $site = &select_file (-Title=>'which site ?', -TextFile=>1, -TopDir=>$enabled, -Chdir=>0); return unless $site; &edit ($site); } elsif ($task eq 'Enable a site') { my $site = &select_file (-Title=>'which site ?', -TextFile=>1, -TopDir=>"$d/sites-available", -Chdir=>0); $site =~ s/^.*\///; return unless $site; system "$a2ensite $site"; } elsif ($task eq 'Disable a site') { my $site = &select_file (-Title=>'which site ?', -TextFile=>1, -TopDir=>"$enabled", -Chdir=>0); $site =~ s/^.*\///; return unless $site; system "$a2dissite $site"; } elsif ($task eq 'Enable a module') { my $module = &select_file (-Title=>'which module ?', -FPat=>'*.load', -TopDir=>"$d/mods-available", -Chdir=>0); $module =~ s/^.*\///; return unless $module; system "$a2enmod $module"; } elsif ($task eq 'Disable a module') { my $module = &select_file (-Title=>'which module ?', -FPat=>'*.load', -TopDir=>"$d/mods-enabled", -Chdir=>0); $module =~ s/^.*\///; return unless $module; system "$a2dismod $module"; } elsif ($task eq 'Edit main config file') { &edit ($conff); } my $apachectl = &which('apache2ctl') || &which('apachectl') || '/usr/local/apache/bin/apachectl'; if (&confirm ('OK to Restart Apache ?')) { system "$apachectl restart"; } } sub dirvish { if (!open(F,$dirvishconf)) { die "can't open $dirvishconf: $!\n"; } my $ary; my $Banks; my @Vaults; while () { if (/^#/) { next; } elsif (/^bank:/i) { $ary = \@Banks; } elsif (/^Runall:/i) { $ary = \@Vaults; } elsif (/^\w/) { $ary = 0; } elsif (/^\s+(\S+)/ && ref $ary) { push @$ary, $1; } } close F; my @tasks = (); push @tasks, $dirvishconf; foreach my $vault (sort @Vaults) { my $bank; foreach (@Banks) { if (-d "$_/$vault") { $bank = $_; last; } } if (!$bank) { warn "can't find vault $vault in banks @Banks\n"; next;} my $backupd = "$bank/$vault"; $BackupDirs{$vault} = $backupd; if (!-d "$backupd/dirvish") {warn "$backupd/dirvish not found\n";next;} if (!-f "$backupd/dirvish/default.conf") { open (F, ">$backupd/dirvish/default.conf"); close F; } push @tasks, "$backupd/dirvish/default.conf"; } if (@Vaults) { push @tasks, "Re-run last night's backup"; } if (1 < @Vaults) { push @tasks, "Re-run a particular vault"; } my $task = &choose('which dirvish task ?', @tasks); if ($task eq "Re-run last night's backup") { system "dirvish-runall"; } elsif ($task eq "Re-run a particular vault") { my $vault = &choose('which vault ?', sort @Vaults); next unless $vault; system "dirvish --vault $vault --image-time 21:00 &"; } elsif (-f $task) { &edit($task); } } sub modules { if (! open (P, "$lsmod |")) { &sorry("can't run $lsmod: $!"); return 0; } my %mod2lsmod = (); my $title = ''; while (

) { if (/^([a-z]\w+)\s/) { $mod2lsmod{$1}=$_; } elsif (/^[A-Z]/) { $title = $_; } } close P; my $mod = &choose('Which module ?', sort keys %mod2lsmod); return(0) unless $mod; print $title, $mod2lsmod{$mod}, "\n"; system "$modinfo $mod"; } sub ports { if (! open (P, "netstat -a |")) { &sorry("can't run netstat -a: $!"); return 0; } my @lines; while (

) { if (/LISTEN|ESTABLISH/) { push @lines, $_; } } close P; if (! open (P, "iptables -L |")) { &sorry("can't run iptables -L: $!"); } else { push @lines, "\n", "Iptables:\n"; while (

) { s/ state/state/ ; push @lines, $_; } close P; } &view ("Ports", join('', @lines)); } sub daemons { my $task = &choose('Task ?','start','restart','stop'); return unless $task; my $daemon = &select_file (-Title=>'which daemon ?', -TextFile=>1, -TopDir=>$daemon_d, -Chdir=>0); return unless $daemon; system "sh $daemon $task"; } sub crontab { if ($>) { system "crontab -e"; return 0; } if (! opendir(D,$crond)) { warn "can't opendir $crond: \n"; return 0; } my @users = sort grep { !/^\./ } readdir(D); closedir D; if (! @users) { warn "no crontabs found in $crond\n"; return 0; } my $task = &choose('crontab task ?', 'View', 'Edit', 'Manual'); return unless $task; if ($task eq 'Manual') { system 'man 5 crontab'; return; } my $user = &choose ("$task which user ?", @users); return unless $user; my $useropt = '-u '; if ($^O =~ /solaris/) { $useropt = ''; } if ($task eq 'Edit') { system "crontab -e $useropt $user"; } else { system "crontab -l $useropt $user"; } } sub chkconfig { if (! open (P, "chkconfig --list |")) { &sorry("can't run chkconfig --list: $!"); return 0; } my @l; my @xinetdl; while (

) { chop; if (/^\s/ || /based services/) { push @xinetdl, $_; } else { push @l, $_; } } if (open (F, '/etc/inittab')) { while () { if (/^\w+:(\d):initdefault:/) {warn " default run-level $1\n"; last;} } close F; } my $r = `who -r 2>/dev/null`; $r =~ s/^\s*(\S+\s+\d+).*$/$1/; if ($r) { warn("currently $r"); } my $task = &choose('chkconfig task ?', 'View', 'Edit'); return unless $task; if ($task eq 'Edit') { my %services; foreach (@l) { /^(\S+)\s+(.*)$/; $services{$1}=$2; } my $service = &choose('Edit which service ?', sort keys %services); return unless $service; &inform ($services{$service}); my @runlevels = &choose('at which runlevels ?','1','2','3','4','5'); return unless @runlevels; my $onoff = &choose("$service at runlevels ".join(",",@runlevels),'on','off'); return unless $onoff; system "chkconfig --level ".join('',@runlevels)." $service $onoff"; } else { &view('chkconfig --list', join("\n", (sort @l ),@xinetdl)); } &view ('Daemon configuration', $s); } sub trac_admin { if (! opendir(D, $tracd)) { warn "can't opendir $tracd: $!\n"; return; } @dirs = grep { !/^\./ && -d "$tracd/$_" } readdir(D); closedir D; if (! @dirs) { warn "no projects found in $tracd\n"; return; } my $dir = &choose("which project ?", @dirs); return unless $dir; system "trac-admin $tracd/$dir"; if ($svnd && -f "$svnd/conf/svnpolicy") { &edit("$svnd/conf/svnpolicy"); } } sub update_rcd { my $r = `who -r`; $r =~ s/^\s*(\S+\s+\d+).*$/$1/; warn("currently $r"); my $task = &choose('update-rc.d task ?', 'View', 'Edit'); return unless $task; if ($task eq 'Edit') { if (! opendir(D, '/etc/init.d')) { &sorry("can't opendir /etc/init.d: $!"); return 0; } my @l = sort grep { !/^\.|^README|\.sh$|S$|^single$|^halt$|^reboot$/ } readdir(D); closedir D; my $service = &choose('Edit which service ?', @l); return unless $service; system "cd /etc ; ls rc[12345].d/S*$service*"; my $onoff = &choose("$service at runlevels 2,3,4,5",'on','off'); return unless $onoff; if ($onoff eq 'on') { my $startnumber = &choose("start-order number ?", 20 .. 99); system "update-rc.d $service defaults $startnumber"; } elsif ($onoff eq 'off') { system "update-rc.d -f $service remove"; } } else { local $/; &view('ls /etc/rc[2345].d', `ls -C --tabsize=75 /etc/rc[2345].d`); } } sub system_config { my $task = &choose('which system-config ?', @system_configs); return unless $task; system "/usr/bin/system-config-$task"; } sub adduser { my $name = &ask('new username ?'); if (getpwnam($name)) { &sorry("user $name already exists"); return 0; } my @groups = &choose('groups ?', &groups()); my $group; my @secondary_groups=(); if (1 < scalar @groups) { $group = &choose('primary group ?', @groups); foreach (@groups) { if ($_ ne $group) { push @secondary_groups, $_; } } } else { $group = $groups[$[]; } return unless $group; my $fullname = &ask('full name ?'); my $shell = &choose('login shell ?', &shells()); my $cmd = &which("adduser") . " -g $group"; if (@secondary_groups) { $cmd .= " -G " . join(",",@secondary_groups) ; } if ($fullname) { $cmd .= " -c '$fullname'"; } if ($shell) { $cmd .= " -s $shell"; } $cmd .= " $name"; &confirm("OK to $cmd ?") && system $cmd; } # ------------------------- infrastructure ---------------------- sub groups { my @groups=(); my $n; setgrent; while ($n = getgrent()) { push @groups, $n; } endgrent; sort @groups; } sub shells { my @shells; my $d; my $x; foreach $d ('/bin','/usr/bin') { if (! opendir(D,$d)) { &sorry("can't opendir $d: $!\n"); return ; } while ($_ = readdir D) { if (/sh$/ && !/ssh$/ && !/\.sh$/ && !/splash$/ && !/flash$/) { push @shells, "$d/$_"; } } closedir D; } sort @shells; } sub first_existing { my $f = ''; foreach (@_) { if (-e $_) { $f = $_; last; } } return $f; } sub which { my $f; foreach $d (@PATH) { $f="$d/$_[$[]"; return $f if -x $f; } } Term-Clui-1.70/examples/audio_stuff0000755000076400017510000007715112443733555014765 0ustar pjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2003, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # SCSI: cdda2wav, cdrecord, cdparanoia, idprio, avconv, mplayer # $ENV{CDDA_DEVICE} cdrecord -scanbus # ATAPI: cdcontrol -f /dev/cd0c info, burncd, mkisofs # $ENV{CDROM} /usr/sbin/pciconf -lv, atacontrol list # MIDI: timidity, lame or toolame or twolame # # timidity -Ow -o sample.wav sample.mid # normalize-audio -m *.wav # scp *.wav theflame:/data/cd/ # ssh theflame # su - # cd /data/cd/ # cdrecord dev=0,0 -v -dao -pad -speed=12 -copy *.wav # .mid to .wav to .mp3 ... # timidity -Ow -o sample.wav sample.mid # normalize-audio -m *.wav # lame -h sample.wav sample.mp3 # .wav files can be played with # sndfile-play whatever.wav or with mplayer or with play (comes with sox) # .mpg files can be played with # sndfile-play whatever.mpg or with mplayer or mpg123 my $BigTmp = $ENV{'BIGTMP'} || '/tmp'; use Cwd qw(chdir); use Term::Clui; use Term::Clui::FileSelect; my @PATH = split (":",$ENV{PATH}); my $MidiOutPort = (); my $aconnect = which('aconnect'); my $alsamixer = which('alsamixer'); my $aplaymidi = which('aplaymidi'); my $arecordmidi = which('arecordmidi'); my $cdda2wav = which('icedax') || which('cdda2wav'); my $cdrecord = which('cdrecord') || which('wodim'); my $dvdbackup = which('dvdbackup'); my $eject = which('eject'); my $festival = which('festival'); my $growisofs = which('growisofs'); my $lame = which('lame'); my $man = which('man'); my $mkisofs = which('mkisofs') || which ('genisoimage'); my $mediainfo = which('dvd+rw-mediainfo'); my $mpg123 = which('mpg123'); my $mplayer = which('mplayer'); my $normalize = which('normalize') || which ('normalize-audio'); my $play = which('play'); # comes with sox my $rec = which('rec'); # comes with sox my $sox = which('sox'); my $sndfile_play = which('sndfile-play'); my $startBristol = which('startBristol'); my $su = which('su'); my $timidity = which('timidity'); my $toolame = which('toolame') || which('twolame'); my $mp3_player = $mpg123 || $mplayer || $sndfile_play; my $wav_player = $play || $sndfile_play || $mplayer; while (1) { my $task = choose('Do what ?', tasks()); exit unless $task; if ($task eq 'Extract and Burn') { warn "You'll need to be superuser ...\n"; system "$su root -c $0"; exit 0; } elsif ($task eq 'burn WAV->AudioCD') { burn_wav(); } elsif ($task eq 'burn files->DataCD') { burn_files(); } elsif ($task eq 'change Directory') { changedir(); } elsif ($task eq 'configure Timidity') { configure_timidity(); } elsif ($task eq 'connect MIDIports') { connect_midi_ports(); } elsif ($task eq 'consult Manual') { man(); } elsif ($task eq 'convert MIDI->WAV') { mid2wav(); } elsif ($task eq 'convert MIDI->MP3') { mid2mp3(); } elsif ($task eq 'copy audio CD') { copy_cd(); } elsif ($task eq 'copy video DVD') { copy_dvd(); } elsif ($task eq 'decode MP3->WAV') { mp32wav(); } elsif ($task eq 'edit Makefile') { edit('Makefile'); } elsif ($task eq 'encode WAV->MP2') { wav2mp2(); } elsif ($task eq 'encode WAV->MP3') { wav2mp3(); } elsif ($task eq 'list Soundfont') { list_soundfont(); } elsif ($task eq 'play AudioCD') { play_cd(); } elsif ($task eq 'play MIDI,WAV,MP3') { play(); } elsif ($task eq 'record AudioIn->WAV') { audio2wav(); } elsif ($task eq 'record Keyboard->MIDI') { kbd2mid(); } elsif ($task eq 'rip AudioCD->WAV') { rip_wav(); } elsif ($task eq 'rip MP3CD->MP3') { rip_mp3(); } elsif ($task eq 'run a Bristol synth'){ bristol(); } elsif ($task eq 'run alsamixer') { alsamixer(); } elsif ($task eq 'run Make') { system 'make'; } } exit 0; #----------------------- functionality ------------------------ sub alsamixer { if (! $alsamixer) { sorry("you need to install alsamixer."); return; } system $alsamixer; } sub bristol { if (! $startBristol) { sorry("you need to install Bristol."); return; } if (! open(P, "$startBristol -v -h |")) { sorry("can't run $startBristol -v -h: $!"); return; } my $is_in_emulations = 0; my %long2short = (); while (

) { if (/Emulation:/) { $is_in_emulations = 1; next; } if (!$is_in_emulations) { next; } if ($is_in_emulations and /Synthesiser:/) { last; } if (/^\s+-(\w+)\s+-\s(\w.*)$/) { $long2short{$2} = $1; } } close P; my $long = choose("which synth emulation ?", sort keys %long2short); return unless $long; my $out_file = ask("save output to wav file (return = don't save) ?"); if (! $out_file) { system "$startBristol -alsa -$long2short{$long}"; } else { $out_file =~ s/\.WAV$//i; system "$startBristol -alsa -$long2short{$long} -o $out_file.raw"; if (!$sox) { sorry("you need to install sox to convert raw to wav."); return; } system "$sox -c 2 -s -r 44100 -2 $out_file.raw $out_file.wav"; } } sub burn_wav { if (!$cdrecord) {sorry("you need to install cdrecord or wodim."); return;} set_cdda_device() || return; my @files = select_file(-FPat=>'{*.wav,*.WAV}',-Path=>$ENV{PWD},-Chdir=>0); return unless @files; my $files = join "' '", @files; ask("insert the C D into the drive, and press Return"); system "$cdrecord dev=0,0 -v -dao -pad -speed=12 -copy '$files'"; inform("finished burning the C D"); if ($eject) { system $eject; } } sub burn_files { my $ok = 1; if (! $mkisofs) { sorry("you need to install mkisofs or genisoimage."); return; } if (!$cdrecord) {sorry("you need to install cdrecord or wodim."); return;} if (! -e '/dev/cdrom') { sorry("can't find /dev/cdrom"); $ok = 0; } elsif (! -w '/dev/cdrom') { sorry("can't write to /dev/cdrom"); $ok=0; } my $tmpfile = "$BigTmp/cd_$$"; my $tmp_dir = "$BigTmp/mnt_$$"; if (! mkdir $tmp_dir) { sorry("can't mkdir $tmp_dir: $!"); $ok=0; } return unless $ok; # must choose_files repeatedly to within size limit my $max_mb = 800; while (1) { my $mb_so_far = `du -ms $tmp_dir`; $mb_so_far =~ s/\s.*$//; my $remaining = $max_mb - $mb_so_far; if ($remaining > 1) { warn "$remaining Mb remaining:\n"; my $f = select_file(SelDir=>1,-Title=>"looking"); if (! $f) { last; } if (-d $f) { system("cp","-R",$f,"$tmp_dir/"); } else { system("cp",$f,"$tmp_dir/"); } } elsif ($remaining < 0) { my $f = select_file(-TopDir=>$tmp_dir -SelDir=>1, -Title=>"$remaining Mb remaining: Delete which file "); if (! $f) { last; } else { system("rm","-rf","$tmp_dir/$f"); } } } system "ls -lR $tmp_dir/*"; system "$mkisofs -gui -r -J -T -allow-limited-size" ." -V DataCD -o $tmpfile $tmp_dir 2>&1 | perl -pe 's/\$/\\e[K\\e[A/'"; print "\n"; system("rm","-rf",$tmp_dir); # could mount -o loop $tmpfile and check it's OK ... if ($eject) { system $eject; } while (1) { ask("insert blank CD into drive and press Return..."); # suppress line-feeds in the progress-bar (on stderr) ... # should sleep, try, sleep, retry up to about 15 sec ... system "$cdrecord dev=/dev/cdrom -v -dao $tmpfile"; if ($eject) { system $eject; } last unless confirm("do you want to write that to another CD ?"); } if (!unlink $tmpfile) { warn "can't unlink $tmpfile: $!\n"; } } sub copy_cd { my $ok = 1; if (!$cdda2wav) {sorry("you need to install cdda2wav or icedax."); $ok=0;} if (!$cdrecord) {sorry("you need to install cdrecord or wodim."); $ok=0;} if (! -e '/dev/cdrom') { sorry("can't find /dev/cdrom"); $ok = 0; } elsif (! -w '/dev/cdrom') { sorry("can't write to /dev/cdrom"); $ok=0; } my $tmpdir = "$BigTmp/audio_stuff_$$"; if (! mkdir $tmpdir) { sorry("can't mkdir $tmpdir: $!"); $ok=0; } my $olddir = 'pwd'; if (! chdir $tmpdir) { sorry("can't chdir $tmpdir: $!"); $ok=0; } return unless $ok; ask("insert the C D into the drive, and press Return"); system "$cdda2wav dev=/dev/cdrom -vall cddb=0 -B -Owav"; if ($eject) { system $eject; } while (1) { ask("insert blank CD into drive and press Return..."); if (($> == 0) and (! -e '/dev/cdrom')) { # CURSE icedax! symlink '/dev/sr0', '/dev/cdrom'; } system "$cdrecord dev=/dev/cdrom -v -dao -useinfo -text *.wav"; if ($eject) { system $eject; } last unless confirm "do you want to write that to another CD ?"; } chdir "$oldir"; system "rm -rf $tmpdir"; } sub copy_dvd { my $ok = 1; if (!$dvdbackup) {sorry("you need to install dvdbackup."); $ok=0;} if (!$mkisofs){sorry("you need to install mkisofs or genisoimage.");$ok=0;} if (!$growisofs) {sorry("you need to install growisofs."); $ok=0;} if (! -e '/dev/cdrom') { sorry("can't find /dev/cdrom"); $ok = 0; } elsif (! -w '/dev/cdrom') { sorry("can't write to /dev/cdrom"); $ok=0; } my $tmpfile = "$BigTmp/dvd_$$.iso"; my $tmp_mnt = "$BigTmp/mnt_$$"; if (! mkdir $tmp_mnt) { sorry("can't mkdir $tmp_mnt: $!"); $ok=0; } return unless $ok; ask("insert the DVD into drive, and press Return..."); ## The old non-dvdcss-capable method using mount ... # system "mount -t iso9660 -o ro,map=off /dev/cdrom $tmp_mnt"; #my $return_code; #foreach (1..5) { # sleep, try, sleep, retry up to about 15 sec ... # sleep 2; # $return_code = system "mount -t udf -o ro /dev/cdrom $tmp_mnt"; # last unless $return_code; # sleep 2; #} #if ($return_code) { sorry("couldn't mount the DVD"); return 0; } #if (! -d "$tmp_mnt/VIDEO_TS" and ! -d "$tmp_mnt/video_ts") { # sorry("not a video DVD; can't see a /VIDEO_TS directory"); # system "ls -lR $tmp_mnt ; umount $tmp_mnt"; # if (! rmdir $tmp_mnt) { warn "can't rmdir $tmp_mnt: $!\n"; } # return 0; #} warn "$dvdbackup -v -M -o $tmp_mnt -i /dev/cdrom\n"; system "$dvdbackup -v -M -o $tmp_mnt -i /dev/cdrom"; # uses libdvdcss! # discover the DVD's title my $dh; opendir($dh, $tmp_mnt) or die "can't opendir $tmp_mnt: $!"; my @ds = grep { !/^\./ && -d "$tmp_mnt/$_" } readdir($dh); closedir $dh; if (! @ds) { die "no directories found in $tmp_mnt/\n"; } my $title = $ds[$[]; if (1 != scalar @ds) { warn "directories @ds found in $tmp_mnt/ , using $title\n"; } if (! mkdir "$tmp_mnt/$title/AUDIO_TS") { warn " can't mkdir $tmp_mnt/$title/AUDIO_TS\n"; } # mkisofs -dvd-video -o i1.img d1/NAQOYQATSI/ # growisofs -dvd-compat -Z /dev/sr0=i1.img # suppress line-feeds in the progress-bar (on stderr) ... system "$mkisofs -gui -r -J -T -dvd-video -allow-limited-size" ." -V Video_DVD -o $tmpfile '$tmp_mnt/$title'" ." 2>&1 | perl -pe 's/\$/\\e[K\\e[A/'"; # quotes 20130611, but should use the list form of system #system "umount $tmp_mnt"; print "\n"; if ($eject) { system $eject; } # if (! rmdir $tmp_mnt) { warn "can't rmdir $tmp_mnt: $!\n"; } use File::Path; File::Path::remove_tree($tmp_mnt); unlink $tmp_mnt; system "ls -l $tmpfile"; # to be fussy, could mount -o loop $tmpfile and check it's OK ... if (! -s $tmpfile) { warn " the iso fs was empty :-(\n"; return; } while (1) { ask("insert blank DVD into drive, wait for light to go out, then press Return..."); # suppress line-feeds in the progress-bar (on stderr) ... # should sleep, try, sleep, retry up to about 15 sec ... system "growisofs -dvd-compat -Z /dev/cdrom=$tmpfile" . " 2>&1 | perl -pe 's/\$/\\e[K\\e[A/'"; warn "\n"; if ($eject) { system $eject; } last unless confirm "do you want to write that to another DVD ?"; } if (!unlink $tmpfile) { warn "can't unlink $tmpfile: $!\n"; } } sub dvd_size { if (!$mediainfo) { # could try some other program ? sorry('you should install dvd+rw-mediainfo'); return undef; } my $dev = 'dev/cdrom'; my $size = undef; foreach (1..5) { sleep 2; if (! open(P, "$mediainfo $dev 2>&1 |")) { sorry("can't run $mediainfo $dev"); return undef; } while (

) { if (/Legacy lead-out.+=(\d+)$/) { $size = 0+$1; } } close P; if ($size) { return $size; } sleep 2; } sorry("no dvd media present in $dev"); return undef; } sub speak { if (!$festival) { return; } if (!@_) { return; } if (! open(P, "|$festival --tts")) { sorry("can't run $festival"); return; } print P $_[$[]; close P; } sub which_track { my $do_what = $_[$[]; # cdda2wav produces its output on stderr ARRGghhh :-( if (! open (P, "$cdda2wav -Q -H -g -v toc -J 2>&1 |")) { die "can't run $cdda2wav: $!\n"; } my @toc =

; close P; my @tracks, @header; foreach (@toc) { next if /^\s*#/; next if /not detected/; next if /not supported/; next if /Album title: '' from ''/; chop; s/^\s+//; if (/^T\d/) { s/ title '' from ''//; push @tracks, $_; } else { push @header, $_; } } print join("\n", @header), "\n"; $track = choose("$do_what which track ?", @tracks); $track =~ s/^\s*T0?//; $track =~ s/:?\s+.*$//; if ($track =~ /^\d$/) { $track = "0$track"; } return $track; } sub play_cd { if (!$cdda2wav) {sorry("you need to install cdda2wav or icedax."); return;} set_cdda_device() || return; my $task = choose('Play', 'All tracks', 'Just one track'); return unless $task; if ($task eq 'All tracks') { system "$cdda2wav cddb=0 -H -B -e -N"; return; } my $track = which_track('Play'); if ($track) { system "$cdda2wav -H -Q -x -e -N -t $track+$track"; } } sub rip_wav { if (!$cdda2wav) {sorry("you need to install cdda2wav or icedax."); return;} set_cdda_device() || return; my $task = choose('Extract', 'All tracks', 'Just one track'); return unless $task; if ($task eq 'All tracks') { system "$cdda2wav cddb=0 -H -B -Owav"; return; } $track = choose('Extract which track ?', @tracks); $track =~ s/^\s*T0?//; $track =~ s/:?\s+.*$//; if ($track =~ /^\d$/) { $track = "0$track"; } my $track = which_track('Extract'); if ($track) { my $filename = ask('to what filename ?', "${track}_track.wav"); if ($filename && ($filename !~ /\.wav$/i)) { $filename .= '.wav'; } system "$cdda2wav -H -Q -x -Owav -t $track+$track $filename"; } } sub rip_mp3 { } sub wav2mp3 { if (! $lame) { sorry("you need to install lame."); return; } my @files = select_file(-FPat=>'*.wav', -Path=>$ENV{PWD}, -Chdir=>0); foreach my $i (@files) { my $o = $i; $o =~ s/wav$/mp3/; if (-f $o && !confirm("OK to overwrite $o ?")) { next; } system "$lame -h $i $o"; } } sub wav2mp2 { if (! $toolame) { sorry("you need to install toolame."); return; } my @files = select_file(-FPat=>'*.wav', -Path=>$ENV{PWD}, -Chdir=>0); foreach my $i (@files) { my $o = $i; $o =~ s/wav$/mp2/; if (-f $o && !confirm("OK to overwrite $o ?")) { next; } system "$toolame $i"; } } sub mp32wav { if (! $lame) { sorry("you need to install lame."); return; } if (! $normalize) { sorry("you need to install normalize-audio or normalize."); return; } my @files = select_file(-FPat=>'*.mp3', -Path=>$ENV{PWD}, -Chdir=>0); foreach my $i (@files) { my $o = $i; $o =~ s/mp3$/wav/; if (-f $o && !confirm("OK to overwrite $o ?")) { next; } system "$lame --mp3input --decode $i $o"; system "$normalize '$o'"; } } sub mid2wav { # should also offer replay-through-xv2020, and sox -t alsa hw:4,0 if (! $timidity) { sorry("you need to install timidity."); return; } if (! $normalize) { sorry("you need to install normalize-audio or normalize."); return; } my @files = select_file(-FPat=>'*.mid', -Path=>$ENV{PWD}, -Chdir=>0); my $config = timiditycfg(); print "config=$config\n"; if (! $config) { sorry("can't find any timidity.cfg file"); return; } my @wavs = (); foreach my $i (@files) { my $o = $i; $o =~ s/mid$/wav/; push @wavs, $o; if (-f $o && !confirm("OK to overwrite $o ?")) { next; } system "$timidity -Ow -c $config -o $o $i"; } system "$normalize '".join("' '",@wavs)."'"; } sub mid2mp3 { if (! $timidity) { sorry("you need to install timidity."); return; } if (! $normalize) { sorry("you need to install normalize-audio or normalize."); return; } if (! $lame) { sorry("you need to install lame."); return; } my @files = select_file(-FPat=>'*.mid', -Path=>$ENV{PWD}, -Chdir=>0); my @wavs = (); return unless @files; foreach my $i (@files) { my $o = $i; $o =~ s/mid$/wav/; push @wavs, $o; if (-f $o && !confirm("OK to overwrite $o ?")) { next; } system "$timidity -Ow -o $o $i"; } system "$normalize '".join("' '",@wavs)."'"; foreach my $o (@wavs) { my $oo = $o; $oo =~ s/wav$/mp3/; if (-f $oo && !confirm("OK to overwrite $oo ?")) { next; } system "$lame -h $o $oo"; unlink $o; } } sub play { my $file = select_file(-Readable=>1, -Path=>$ENV{PWD}, -FPat=>'{*.wav,*.mp3,*.mid}'); return unless $file; if ($file =~ /\.mp3$/) { if ($mpg123) { inform( 's=stop/start b=beginning ,=rewind .=fast-forward q=quit'); system "$mpg123 -C $file"; system "stty sane"; return; } if (! $mp3_player) { sorry("you need to install mpg123 or mplayer or sndfile-play."); return; } system "$mp3_player $file"; return; } elsif ($file =~ /\.wav$/) { if (! $wav_player) { sorry("you need to install sox (play) or sndfile-play or mplayer."); return; } system "$wav_player $file"; return; } if (! $aplaymidi) { sorry("you need to install aplaymidi."); return; } # also needed by metronome below, should factorize this code out ... if (!open(P,"$aplaymidi -l |")) { die "can't run $aplaymidi -l: $!\n"; } my (%outport2device, %device2outport); while (

) { if (/^\s*(\d+:\d)\s+(.*)$/) { my $port = $1; my $device = $2; substr ($device,0,32) = ''; $device =~ s/^\s*//; $outport2device{$port} = $device; $device2outport{$device} = $port; } } close P; my @outdevices = sort keys %device2outport; my $outdevices; my $outport; if (!@outdevices) { sorry("aplaymidi can't see any midi output devices."); return; } elsif (1 == @outdevices) { inform("using midi device $outdevices[$[]"); $outport = $device2outport{$outdevices[$[]}; } else { $outport = $device2outport{choose('To which device ?',@outdevices)}; return unless $outport; } system "$aplaymidi -p $outport \"$file\""; } sub audio2wav { if (! $rec) { sorry("you need to install rec (comes with sox)."); return; } my $file = ask("To what .wav file ?"); return unless $file; if ($file !~ /\.WAV$/) { $file =~ s/\.WAV$/\.wav/; } elsif ($file !~ /\.wav$/) { $file .= '.wav'; } # could offer options, like gain, compand, autostart on signal... # must convert to 44100 Hz :-) system "$rec -c 2 $file rate 44100"; } sub midi_in_port { if (! $aconnect) { sorry("you need to install aconnect."); return; } if (!open(P,"$aconnect -i |")) {die "can't run $aconnect -i: $!\n";} my $major; my $inport; my $outport; while (

) { if (/^client\s*(\d+:)/) { $major = $1; } elsif ($major>0 and /^\s+(\d)\s+'(.*)'/) { my $minor = $1; my $device = $2; $device =~ s/\s+$//; $inport2device{"$major$minor"} = $device; $device2inport{$device} = "$major$minor"; } } close P; my @indevices = sort keys %device2inport; my $inport; if (!@indevices) { sorry("aconnect can't see any midi input devices."); return; } elsif (1 == @indevices) { inform("using MIDI-input-port $indevices[$[]"); $inport = $device2inport{$indevices[$[]}; } else { $inport = $device2inport{choose('connect from which device ?',@indevices)}; } return $inport; } sub midi_out_port { if (! $aconnect) { sorry("you need to install aconnect."); return; } if (!open(P,"$aconnect -o |")) {die "can't run $aconnect -o: $!\n";} while (

) { if (/^client\s*(\d+:)/) { $major = $1; } elsif ($major>0 and /^\s+(\d)\s+'(.*)'/) { my $minor = $1; my $device = $2; $device =~ s/\s+$//; $outport2device{"$major$minor"} = $device; $device2outport{$device} = "$major$minor"; } } close P; my @outdevices = sort keys %device2outport; my $outport; if (!@outdevices) { sorry("aconnect can't see any midi output devices."); return; } elsif (1 == @outdevices) { inform("using MIDI-output-port $outdevices[$[]"); $outport = $device2outport{$outdevices[$[]}; } else { $outport = $device2outport{choose('connect to which device ?',@outdevices)}; } return $outport; } sub connect_midi_ports { if (! $aconnect) { sorry("you need to install aconnect."); return; } if (!open(P,"$aconnect -ol |")) {die "can't run $aconnect -ol: $!\n";} my $major = -1; my %port2device = (); my %device2port = (); my @connections = (); my $device = ''; while (

) { if (/^client\s*(\d+):/) { $major = $1; next; } if ($major>0 and /^\s+(\d)\s+'(.*)'/) { my $minor = $1; $device = $2; $device =~ s/\s+$//; $port2device{"$major:$minor"} = $device; $device2port{$device} = "$major:$minor"; next; } if (/Connected From:\s+(.+)/) { foreach (split /,\s*/, $1) { push @connections, "$port2device{$_} -> $device"; } } } close P; if (@connections) { my @disconnect = (); if (1 == @connections) { my $msg = "do you want disconnect this one ?"; my $disconnect = choose($msg, @connections); if ($disconnect) { @disconnect = ($disconnect); } } else { my $msg = "do you want disconnect any of these ?"; @disconnect = choose($msg, @connections); } my $is_ok = 0; foreach (@disconnect) { if (!$_) { last; } if (/^(.+) -> (.+)/) { system "$aconnect -d $device2port{$1} $device2port{$2}"; $is_ok = 1; } else { warn "unrecognised connection $_\n"; } } if ($is_ok) { inform('OK'); } } my $inport = midi_in_port(); return unless $inport; my $outport = midi_out_port(); return unless $outport; $MidiOutPort = $outport; system "$aconnect $inport $outport"; } sub kbd2mid { my $inport = midi_in_port(); return unless $inport; my $bpm = choose('crochets (quarter-notes) per minute ?', tempi()); $bpm = $bpm || 120; my $timesig = choose('time signature ?', '3/8','6/8','9/8','12/8', '2/4','3/4','4/4','5/4','6/4','7/4','2/2','3/2'); $timesig = $timesig || '4/4'; $timesig =~ s/\//:/; my $file = ask("To what midifile ?"); return unless $file; if ($file !~ /\.mid$/) { $file .= '.mid'; } my $metronome; if ($MidiOutPort) { $metronome=choose('With a metronome ?','Yes','No'); } my $ok = ask(" to start recording, to stop ..."); if ($metronome) { system "arecordmidi -p$inport -b$bpm -i$timesig -m$MidiOutPort $file"; } else { system "arecordmidi -p$inport -b$bpm -i$timesig $file"; } } sub changedir { my $newdir = select_file(-Path=>$ENV{PWD}, -Directory=>1); return unless $newdir; if (! -d $newdir) { sorry("$newdir is not a directory"); return; } if (! chdir $newdir) { sorry("can't chdir to $newdir: $!"); return; } # assertively rename *.WAV->*.wav, *.MID->*.mid, *.MP3->*.mp3 if (! opendir (D, '.')) { sorry("can't opendir $newdir: $!"); return; } my @allfiles = grep { !/^\./ } readdir(D); closedir D; my $oldname; foreach $oldname (grep { /\.WAV$/} @allfiles) { my $newname = $oldname; $newname =~ s/WAV$/wav/; rename $oldname, $newname; } foreach $oldname (grep { /\.MP3$/} @allfiles) { my $newname = $oldname; $newname =~ s/MP3$/mp3/; rename $oldname, $newname; } foreach $oldname (grep { /\.MID$/} @allfiles) { my $newname = $oldname; $newname =~ s/MID$/mid/; rename $oldname, $newname; } } sub list_soundfont { eval 'require File::Format::RIFF'; if ($@) { sorry("you need to install File::Format::RIFF."); return; } my $config = timiditycfg(); my $dir = $ENV{PWD}; if (open (F, $config)) { while () { if (/^dir\s+(.+)$/) { $dir = $1; last; } } close F; } else { inform("can't find any timidity.cfg file ..."); } my $file = select_file( -Title=>'Which Soundfont file ?', -FPat=>'{*.sf2,*.SF2}', -Path=>$dir, ); return unless $file; open(IN, $file) or die "Could not open $file: $!\n"; my $riff1 = File::Format::RIFF->read(\*IN); close(IN); # $riff1->dump; $pdta->dump; my $pdta = $riff1->at(2); my $phdr = $pdta->at(0); my $data = $phdr->data; my %t; while ($data) { chop; my $chunk = substr $data,0,38,''; my $name = substr $chunk,0,20,''; my ($preset,$bank) = unpack 'SS', $chunk; $name =~ tr/ 0-9a-zA-Z_//cd; if ($name =~ /^EOP/) { next; } my $k = 1000*$bank + $preset; $t{$k} = sprintf "%5d %5d %s", $preset,$bank,$name; } my @t = "$file\nPreset Bank PresetName"; foreach (sort {$a<=>$b} keys %t) { push @t, $t{$_}; } view("Contents of $file", join("\n", @t)."\n"); } sub configure_timidity { if (! $timidity) { sorry("you need to install timidity."); return; } my $f = timiditycfg(); if (! $f) { inform("can't find any timidity.cfg ..."); } elsif (-w $f) { edit($f); } else { inform("you don't have write permission to $f ..."); if (!-w $ENV{PWD}) { inform("and you don't have write permission here in $ENV{PWD}"); return; } return unless confirm("Create a local timidity.cfg in $ENV{PWD} ?"); if (! open (O, ">$ENV{PWD}/timidity.cfg")) { sorry("can't write to $ENV{PWD}/timidity.cfg: $!"); return; } if (open (I, $f)) { while () { print O $_; } close I; } else { print O <<'EOT'; # Sample timidity.cfg - see "man timidity.cfg" dir /directory/where/you/keep/your/soundfonts # specify default Soundfont: soundfont Chaos4m.sf2 # but take bank0 patch0 from SteinwayGrandPiano & patch74 from Ultimate bank 0 0 %font SteinwayGrandPiano1.2.sf2 0 0 74 %font Ultimate.sf2 0 74 EOT } close O; edit("$ENV{PWD}/timidity.cfg"); } } sub man { my @topics = @_ || ( 'aconnect', 'alsamixer', 'aplaymidi', 'arecordmidi', 'atacontrol', 'audio_stuff', 'avconv', 'bristol', 'burncd', 'cdcontrol', 'cdda2wav', 'cdrecord', 'dvd+rw-mediainfo', 'File::Format::RIFF', 'genisoimage', 'icedax', 'lame', 'mkisofs', 'mplayer', 'normalize', 'normalize-audio', 'pciconf', 'sndfile-play', 'sox', 'soxexam', 'soxeffect', 'Term::Clui', 'Term::Clui::FileSelect', 'timidity', 'timidity.cfg', 'toolame', 'wodim', ); my $topic = choose('Which topic ?', @topics); return unless $topic; if ($topic eq 'audio_stuff') { system "perldoc $0"; } elsif ($topic =~ /::/) { system "perldoc $topic"; } elsif ($topic =~ /bristol/) { system "$startBristol -v -h | less"; } else { system "$man $topic"; } } #----------------------- infrastructure ------------------------ sub which { my $f; foreach $d (@PATH) {$f="$d/$_[$[]"; return $f if -x $f; }} sub tempi { qw(40 42 44 46 48 50 52 54 56 58 60 63 69 72 76 80 84 8 92 96 100 104 108 112 116 120 126 132 138 144 152 160 168 176 184 192 200 208); } sub timiditycfg { return unless $timidity; my $f; foreach $f ( "$ENV{PWD}/timidity.cfg", '/usr/local/share/timidity/timidity.cfg', '/etc/timidity.cfg', ) { if (-f $f) { return $f; } } if (! open(P, "strings $timidity |")) { return ''; } while (

) { if (/^Please check (\S+.cfg)/) { close P; return $1; } } close P; return ''; } sub set_cdda_device { if ($ENV{CDDA_DEVICE}) { return 1; } inform(" you should set the CDDA_DEVICE environment variable!"); if (-e "/dev/cdrom") { $ENV{CDDA_DEVICE} = '/dev/cdrom:@'; inform("using $ENV{CDDA_DEVICE} ..."); return 1; } elsif (-e '/dev/sr0' and ! $>) { symlink '/dev/sr0', '/dev/cdrom'; } system "eject"; system "eject -t"; sleep 3; if ($>) { warn " you need to be root to run cdrecord -scanbus\n"; $ENV{CDDA_DEVICE} = '0,0,0'; warn "trying CDDA_DEVICE='0,0,0'\n"; } elsif (! open (P, "$cdrecord -scanbus |")) { warn "can't run cdrecord -scanbus: $!\n"; return 0; } else { my @devices; while (

) { chop; s/\t/ /g; s/ +/ /g; if (/^\s+\d.*[^*]$/) { push @devices, $_; } } close P; my $device = choose("Which Device ?", @devices); $device =~ s/^\s+//; $device =~ s/\s.*$//; $ENV{CDDA_DEVICE} = $device; } if (! $ENV{CDDA_DEVICE}) { $ENV{CDDA_DEVICE} = ask('CDDA_DEVICE ?'); } if ($ENV{CDDA_DEVICE}) { return 1; } else { return 0; } } sub tasks { my @tasks = ( 'run a Bristol synth', 'burn files->DataCD', 'burn WAV->AudioCD', 'change Directory', 'configure Timidity', 'connect MIDIports', 'convert MIDI->MP3', 'convert MIDI->WAV', 'convert Muscript->MIDI', 'copy audio CD', 'copy video DVD', 'decode MP3->WAV', 'edit Muscript', 'encode WAV->MP2', 'encode WAV->MP3', 'play AudioCD', 'rip AudioCD->WAV', 'rip MP3CD->MP3', 'play MIDI,WAV,MP3', 'record AudioIn->WAV', 'record Keyboard->MIDI', 'run alsamixer', ); if (-e './Makefile') { push @tasks, ('run Make', 'edit Makefile'); } else { push @tasks, ('create Makefile'); } push @tasks, ( 'list Soundfont', 'consult Manual', ); return sort @tasks; } __END__ echo =============================================================== echo Getting rid of spaces in .mp3 files ... for i in *.[Mm][Pp]3; do mv "$i" `echo $i | tr ' ' '_'`; done echo Changing .MP3 to .mp3 ... for i in *.MP3; do mv "$i" `basename $i .MP3`.mp3; done echo Changing _-_ to _ ... for i in *_-_*.mp3; do mv "$i" `echo $i | sed s/_-_/_/`; done echo echo =============================================================== echo Decoding .mp3 files to *.wav ... for i in *.mp3; do lame --decode $i `basename $i .mp3`.wav; done echo echo =============================================================== echo normalising .wav files ... normalize -m *.wav echo echo =============================================================== echo Total size of .wav files ... du -kch *.wav | grep total echo echo =============================================================== echo Checking for non-44100-Hz encoded .wav files ... file *.wav | grep -v 44100 =pod =head1 NAME audio_stuff - wrapper for aplaymidi, cdda2wav, cdrecord, lame, timidity etc. =head1 SYNOPSIS $ audio_stuff =head1 DESCRIPTION This script, which comes along with the I Perl-module in its I directory, integrates various open-source programs for handling Muscript, Midi, WAV, MP3, CDDA and DVD files into one ArrowKey-and-Return user-interface, =head1 FEATURES burn files->DataCD burn WAV->AudioCD change Directory configure Timidity connect MIDIports consult Manual convert MIDI->MP3 convert MIDI->WAV convert Muscript->MIDI copy audio CD copy video DVD create Makefile decode MP3->WAV edit Muscript encode WAV->MP2 encode WAV->MP3 list Soundfont play MIDI,WAV,MP3 record AudioIn->WAV record Keyboard->MIDI rip AudioCD->WAV rip MP3CD->MP3 run a Bristol synth run alsamixer =over 3 =item IWAV> and IAudioCD> These features use I or I and I and I to get files off AudioCDs into I<.wav> format, or vice-versa. =item I This feature uses I or I to get files off a Video DVD and I to burn them onto an empty one. =item IMP3> and IMP3CD> These features use I and I or I to get files off MP3-CDs onto local hard-disk, or vice-versa. =item IMP3> and IWAV> These features use I to get files from I<.wav> format into I<.mp3> format or vice-versa. =item I Depending on which file you select, this feature either uses I or I to play a I<.mp3> file, or I or I to play a I<.wav> file to the headphones, or I to send a I<.mid> file to a Synthesiser. =back =head1 ENVIRONMENT When copying DVDs some big temporary files are created; if your I is too small you can create a B environment variable to use somewhere else, e.g.: export BIGTMP=/home/tmp audio_stuff =head1 AUTHOR Peter J Billam www.pjb.com.au/comp/contact.html =head1 CREDITS Based on Term::Clui, alsamixer, aplaymidi, arecordmidi, cdrecord or wodim, cdda2wav or icedax, lame, mkisofs or genisoimage, mpg123, normalize-audio, sox, sndfile_play, startBristol and timidity. =head1 SEE ALSO http://www.pjb.com.au/ , http://search.cpan.org/~pjb , http://bristol.sourceforge.net , Term::Clui, alsamixer(1), aplaymidi(1), arecordmidi(1), cdrecord(1), cdda2wav(1), festival(1), genisoimage(1), growisofs(1), icedax(1), lame(1), mpg123(1), mkisofs(1), normalize(1), normalize-audio(1), sndfile_play(1), sox(1), soxexam(7), soxeffect(7), timidity(1), wodim(1) =cut Term-Clui-1.70/examples/choose0000750000076400017500000000627011257634353014413 0ustar pjbpjb#! /usr/bin/perl # ######################################################################### # This Perl script is Copyright (c) 2009, Peter J Billam # # www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### my $Version = '1.0'; my $VersionDate = '27sep2009'; use Term::Clui; # require '/home/pjb/dist/Term-Clui-1.42/Clui.pm'; import Term::Clui; my $multiple_choice = 0; my $filter_stdin = 0; while ($ARGV[$[] =~ /^-([a-z])/) { if ($1 eq 'v') { shift; my $n = $0; $n =~ s{^.*/([^/]+)$}{$1}; print "$n version $Version $VersionDate\n"; exit 0; } elsif ($1 eq 'm') { $multiple_choice = 1; shift; } elsif ($1 eq 'f') { $filter_stdin = 1; shift; } else { print "usage:\n"; my $synopsis = 0; while () { if (/^=head1 SYNOPSIS/) { $synopsis = 1; next; } if ($synopsis && /^=head1/) { last; } if ($synopsis && /\S/) { s/^\s*/ /; print $_; next; } } exit 0; } } my $question = shift; my @list; if ($filter_stdin) { @list = <>; chomp(@list); } else { @list = @ARGV; } if ($multiple_choice) { print join("\n", choose($question, @list)),"\n"; } else { print choose($question, @list)."\n"; } __END__ =pod =head1 NAME choose - Lets the user choose between arguments, or lines of STDIN =head1 SYNOPSIS FILE=`choose 'Which header file ?' *.h` MY_GROUPS=`groups` chgrp `choose "Change $FILE to which group ?" $MY_GROUPS` $FILE lsusb | choose -f 'Which USB device ?' lsusb | choose -f -m 'Which USB devices ?' case `choose "Which SQL command ?" DELETE INSERT UPDATE` in '') exit ;; DELETE) ...;; INSERT) ...;; UPDATE) ...;; esac =head1 DESCRIPTION This script offers a shell-level interface to the Term::Clui CPAN-module. The first argument is the question; by default, subsequent arguments are offered as choices; with the B<-f> (Filter) option, the lines of STDIN are offered as the choices. For the user, it uses the Arrow-keys and Return, or B to quit. If a B<-m> multiple-choice is being offered, then SpaceBar highlights choices additional to the one under the final Return. This program comes packaged with the Term::Clui module, in the C directory. =head1 OPTIONS =over 3 =item B<-f> Causes I to work as a Bilter (like I), so that the user chooses between lines from the standard input. (The default is that the user chooses between the 2nd and all subsequent arguments.) =item B<-m> This offers multiple-choice; the equivalent of calling I in a list context. =item B<-v> Prints version number. =back =head1 CHANGES 20090928 1.1 pod tidied up, and -f options documented 20090927 1.0 first working version =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 CREDITS Based on the CPAN module Term::Clui =head1 SEE ALSO http://search.cpan.org/perldoc?Term::Clui http://search.cpan.org/~pjb http://www.pjb.com.au/ perl(1) =cut Term-Clui-1.70/py/TermClui.py0000644000076400017510000021631212360140226013412 0ustar pjb#! /usr/bin/python3 r''' a Python3 module offering a Command-Line User Interface from TermClui import * chosen = choose("A Title", a_list); # single choice chosen = choose("A Title", a_list, multichoice=True) # multiple choice x = choose("Which ?\n(Mouse, or Arrow-keys and Return)", w) # multi-line q x = choose("Which ?\n"+help_text(), w) # built-in help_text confirm(text) and do_something() answer = ask(question) answer = ask(question, suggestion) password = ask_password("Enter password : ") filename = ask_filename("Which file ?") newtext = edit(title, oldtext) edit(filename) view(title, text) # if title is not a filename view(textfile) # if textfile _is_ a filename edit(choose("Edit which file ?", list_of_files)) file = select_file(Readable=True, TopDir="/home", FPat="*.html") files = select_file(Chdir=False, multichoice=True, FPat="*.mp3") os.chdir(select_file(Directory=True, Path=os.getcwd())) TermClui.py offers a high-level user interface to give the user of command-line applications a consistent "look and feel". Its metaphor for the computer is as a human-like conversation-partner; as each question/response is completed, it is summarised to one line and remains on screen, so that the history of the session gradually accumulates on the screen, available for review or for cut/paste. This user-interface can be intermixed with standard applications which write to STDOUT or STDERR, such as make, pgp, rcs etc. For the user, choose() uses either (since 1.50) the mouse; or arrow keys (or hjkl) and Return or q; also SpaceBar for multiple choices. confirm() expects y, Y, n or N. In general, ctrl-L redraws the (currently active bit of the) screen. edit() and view() use the default EDITOR and PAGER if possible. Window-size-changes are handled, though the screen only gets redrawn after the next keystroke (e.g. ctrl-L) choose(), ask() and confirm() all accept multi-line questions: the first line should be the core question (typically it will end in a question-mark) and will remain on the screen together with the user's answer. The subsequent lines appear beneath the dialogue, and will disappear when the user has given the answer. TermClui.py does not use curses (a whole-of-screen interface), it uses a small and portable subset of vt100 sequences. Also (since 1.50) the SET_ANY_EVENT_MOUSE and kmous (terminfo) sequences, which are supported by all xterm, rxvt, konsole, screen, linux, gnome and putty terminals. Since version 1.60, a speaking interface is provided for the visually impaired user; it employs eflite or espeak. Speech is turned on if the CLUI_SPEAK environment variable is set to any non-empty string. Since version 1.62, if speakup is running, it is silenced while TermClui runs, and then restored. Because TermClui's metaphor for the computer is a human-like conversation-partner, this works very naturally. The application needs no modification. Download TermClui.py from www.pjb.com.au/midi/free/TermClui.py or from http://cpansearch.perl.org/src/PJB/Term-Clui-1.70/py/TermClui.py and put it in your PYTHONPATH. TermClui.py depends on Python3. TermClui.py is a translation into Python3 of the Perl CPAN Modules Term::Clui and Term::Clui::FileSelect. This is version 1.70 ''' import re, sys, select, signal, subprocess, os, random import termios, fcntl, struct, stat, time, dbm VERSION = '1.70' def _which(s): for d in os.getenv('PATH').split(':'): f = d+'/'+str(s) if os.path.exists(f): return f return None def _warn(string): print(string, file=sys.stderr) def _is_writeable(arg): my_type = str(type(arg)) if my_type == "": if not os.path.exists(arg): return False my_stat_result = os.stat(arg) elif my_type == "": my_stat_result = arg else: return False my_euid = os.geteuid() my_groups = os.getgroups() my_fuid = my_stat_result.st_uid my_fgid = my_stat_result.st_gid my_mode = my_stat_result.st_mode if (my_euid == my_fuid) and (my_mode & 0o200): return True if my_mode & 0o20: for gid in my_groups: if gid == my_fgid: return True if my_mode & 0o2: return True return False _Eflite = None _Eflite_FH = None # open here at top-level so one sub can silence the previous _Espeak = None _Espeak_PID = 0 # defined at top-level so one espeak can kill the previous _SpeakUpSilentFile = None # 1.62 if len(os.getenv('CLUI_SPEAK','')) > 0: for d in ['/sys/accessibility', '/proc']: if _is_writeable(d+"/speakup/silent"): _SpeakUpSilentFile = d+"/speakup/silent" break _Eflite = _which('eflite') _Espeak = _which('espeak') if _Eflite: _pipe = subprocess.Popen(_Eflite, shell=False, stdin=subprocess.PIPE) if _pipe: _Eflite_FH = _pipe.stdin else: _warn("can't run "+str(_Eflite)+": $!\n") elif not _Espeak: _warn("TermClui warning: CLUI_SPEAK set; but can't find eflite or espeak") # ------------------------ vt100 stuff ------------------------- _A_NORMAL = 0 _A_BOLD = 1 _A_UNDERLINE = 2 _A_REVERSE = 4 _KEY_UP = 0o403 _KEY_LEFT = 0o404 _KEY_RIGHT = 0o405 _KEY_DOWN = 0o402 _KEY_ENTER = "\r" _KEY_INSERT = 0o525 _KEY_DELETE = 0o524 _KEY_HOME = 0o523 _KEY_END = 0o522 _KEY_PPAGE = 0o521 _KEY_NPAGE = 0o520 _KEY_BTAB = 0o541 _getchar = lambda: sys.stdin.read(1) _ttyin = 0 _ttyout = 0 _AbsCursX = 0 _AbsCursY = 0 _TopRow = 0 _CursorRow = 0 _LastEventWasPress = False # _SpecialKey unneeded - we test for class int _irow = 0 # maintained by _puts, _up, _down, _left and _right _icol = 0 _irow_a = [] # maintined by _layout() _icol_a = [] def _puts(s): global _ttyout, _irow, _icol _irow += s.count("\n") if re.search('\r$', s): _icol = 0 else: _icol += len(s) print(s, end='', file=_ttyout) _ttyout.flush() # could terminfo sgr0, bold, rev, cub1, cuu1, cuf1, cud1 ... def _attrset(attr): global _ttyout, _A_BOLD, _A_REVERSE, _A_UNDERLINE if not attr: print("\033[0m", end='', file=_ttyout) else: if attr & _A_BOLD: print("\033[1m", end='', file=_ttyout) if attr & _A_REVERSE: print("\033[7m", end='', file=_ttyout) if attr & _A_UNDERLINE: print("\033[4m", end='', file=_ttyout) _ttyout.flush() def _beep(): global _ttyout print("\07", end='', file=_ttyout) _ttyout.flush() def _clear(): global _ttyout print("\033[H\033[J", end='', file=_ttyout) _ttyout.flush() def _clrtoeol(): global _ttyout print("\033[K", end='', file=_ttyout) _ttyout.flush() def _black(): global _ttyout print("\033[30m", end='', file=_ttyout) _ttyout.flush() def _red(): global _ttyout print("\033[31m", end='', file=_ttyout) _ttyout.flush() def _green(): global _ttyout print("\033[32m", end='', file=_ttyout) _ttyout.flush() def _blue(): global _ttyout print("\033[34m", end='', file=_ttyout) _ttyout.flush() def _violet(): global _ttyout print("\033[35m", end='', file=_ttyout) _ttyout.flush() def _getc_wrapper(timeout): # may not work on openbsd... # on Py, the select.select seems to flush the remaining [A chars :-( global _getchar, _ttyin if timeout > 0.00001: nfound = select.select([_ttyin], [], [], timeout) if not nfound[0]: return None while (True): try: return _getchar() except (IOError): continue def _dbc(c): if ord(c) < 33: _debug("ord(c)="+str(ord(c))) else: _debug("c="+str(c)) return def _getch(): global _KEY_UP, _KEY_DOWN, _KEY_RIGHT, _KEY_LEFT global _KEY_PPAGE, _KEY_NPAGE, _KEY_BTAB, _KEY_HOME, _KEY_END global _AbsCursX, _AbsCursY c = _getc_wrapper(0) if c == "\033": c = _getc_wrapper(0) if c == None: return "\033" if (c == 'A'): return _KEY_UP if (c == 'B'): return _KEY_DOWN if (c == 'C'): return _KEY_RIGHT if (c == 'D'): return _KEY_LEFT if (c == '2'): _getc_wrapper(0) return _KEY_INSERT if (c == '3'): _getc_wrapper(0) return _KEY_DELETE if (c == '5'): _getc_wrapper(0) return _KEY_PPAGE if (c == '6'): _getc_wrapper(0) return _KEY_NPAGE if (c == 'Z'): return _KEY_BTAB if (c == 'O'): # 1.68 Haiku wierdness, inherited from an old Suse c = _getc_wrapper(0) if (c == 'A'): return _KEY_UP # 1.68 if (c == 'B'): return _KEY_DOWN # 1.68 if (c == 'C'): return _KEY_RIGHT # 1.68 if (c == 'D'): return _KEY_LEFT # 1.68 if (c == 'F'): return _KEY_END # 1.68 if (c == 'H'): return _KEY_HOME # 1.68 return c if (c == '['): c = _getc_wrapper(0) if (c == 'A'): return _KEY_UP if (c == 'B'): return _KEY_DOWN if (c == 'C'): return _KEY_RIGHT if (c == 'D'): return _KEY_LEFT if (c == 'F'): return _KEY_END # 1.67 if (c == 'H'): return _KEY_HOME # 1.67 if (c == 'M'): # mouse report # http://invisible-island.net/xterm/ctlseqs/ctlseqs.html event_type = ord(_getc_wrapper(0))-32; x = ord(_getc_wrapper(0))-32; y = ord(_getc_wrapper(0))-32; #event_type = ord(_ttyin.buffer.read(1))-32; #x = ord(_ttyin.buffer.read(1))-32; #y = ord(_ttyin.buffer.read(1))-32; # my $shift = $event_type & 0x04; # used by wm # my $meta = $event_type & 0x08; # used by wm # my $control = $event_type & 0x10; # used by xterm button_drag = (event_type & 0x20) >> 5 low3bits = event_type & 0x03 if low3bits == 0x03: button_pressed = 0 else: # button 4 means wheel-up, button 5 means wheel-down if event_type & 0x40: button_pressed = low3bits + 4 else: button_pressed = low3bits + 1 t = _handle_mouse(x,y,button_pressed,button_drag) if t != '': return t else: return _getch() if re.search('\d', c) != None: c1 = _getc_wrapper(0) if c1 == '~': if c == '2': return _KEY_INSERT if c == '3': return _KEY_DELETE if c == '5': return _KEY_PPAGE if c == '6': return _KEY_NPAGE else: # cursor-position report, response to \033[6n _AbsCursY = int(c) while True: if c1 == ';': break _AbsCursY = 10*_AbsCursY + int(c1) c1 = _getc_wrapper(0) _AbsCursX = 0 while True: c1 = _getc_wrapper(0) if c1 == 'R': break _AbsCursX = 10*_AbsCursX + int(c1) return _getch() if c == 'Z': return _KEY_BTAB return c return c else: return c def _up(n): global _irow, _ttyout # if (n < 0) { &down(n); return; } print("\033[A"*n, end='', file=_ttyout) _ttyout.flush() _irow -= n def _down(n): global _irow, _ttyout #if (n < 0) { &up(n); return; } # \033[B doesn't scroll, but \n needs stty ONLRET print("\n"*n, end='', file=_ttyout) _ttyout.flush() _irow += n def _right(n): global _icol, _ttyout # if (n < 0) { &up(n); return; } print("\033[C"*n, end='', file=_ttyout) _ttyout.flush() _icol += n def _left(n): global _icol, _ttyout # if (n < 0) { &up(n); return; } print("\033[D"*n, end='', file=_ttyout) _ttyout.flush() _icol -= n def _goto(newcol,newrow): global _icol, _irow if (newcol == 0): print("\r", end='', file=_ttyout) _ttyout.flush() _icol = 0 elif (newcol > _icol): _right(newcol-_icol) elif (newcol < _icol): _left(_icol-newcol) if (newrow > _irow): _down(newrow-_irow) elif (newrow < _irow): _up(_irow-newrow) # def move(ix,iy): Unused... # printf TTY "\033[%d;%dH",$iy+1,$ix+1; } _InitscrAlreadyRun = 0 # its a counter # tty = True _ttyout_fnum = 0 _old_tcattr = 0 _IsMouseMode = False _WasMouseMode = False _IsSpeakUpSilent = False # 1.62 _WasSpeakUpSilent = False # 1.62 def _enter_mouse_mode (): # 1.50 global _ttyin, _IsMouseMode if os.getenv('CLUI_MOUSE') == 'OFF': return '' if _IsMouseMode: _warn("_enter_mouse_mode but already IsMouseMode\r\n") return 1 #_ttyin.close() #_ttyin = open("/dev/tty", mode="rb", buffering=0) print("\033[?1003h", end='', file=_ttyout) # sets SET_ANY_EVENT_MOUSE mode #_ttyout.flush() _IsMouseMode = True return 1 def _leave_mouse_mode (): # 1.50 global _ttyin, _IsMouseMode if os.getenv('CLUI_MOUSE') == 'OFF': return '' if not _IsMouseMode: _warn("_leave_mouse_mode but not IsMouseMode\r\n") return 1 #_ttyin.close() #_ttyin = open("/dev/tty", mode="r") print("\033[?1003l", end='', file=_ttyout) # cancel SET_ANY_EVENT_MOUSE _ttyout.flush() _IsMouseMode = False return 1 def _enter_speakup_silent (): # 1.62 global _ttyin, _IsSpeakUpSilent, _SpeakUpSilentFile if not _SpeakUpSilentFile: return False if _IsSpeakUpSilent: _warn("_enter_speakup_silent but already IsSpeakUpSilent\r\n") return True S = open(_SpeakUpSilentFile, 'w') S.write("7\n") # S.close() _IsSpeakUpSilent = True return True def _leave_speakup_silent (): # 1.62 global _ttyin, _IsSpeakUpSilent, _SpeakUpSilentFile if not _SpeakUpSilentFile: return False if not _IsSpeakUpSilent: _warn("_leave_speakup_silent but not IsSpeakUpSilent\r\n") return True S = open(_SpeakUpSilentFile, 'w') S.write("4\n") # S.close() _IsSpeakUpSilent = False return True def _initscr(mouse_mode=False, speakup_silent=False): global _ttyout_fnum, _old_tcattr, _getchar, _ttyin, _ttyout global _InitscrAlreadyRun, _icol,_irow global _IsMouseMode, _WasMouseMode, _IsSpeakUpSilent, _WasSpeakUpSilent if os.getenv('CLUI_MOUSE') == 'OFF': mouse_mode = False _icol = 0 _irow = 0 if _InitscrAlreadyRun > 0: _InitscrAlreadyRun+=1 if not mouse_mode and _IsMouseMode: if not _leave_mouse_mode(): return False elif mouse_mode and not _IsMouseMode: if not _enter_mouse_mode(): return False _WasMouseMode = _IsMouseMode if not speakup_silent and _IsSpeakUpSilent: if not _leave_speakup_silent(): return False elif speakup_silent and not _IsSpeakUpSilent: if not _enter_speakup_silent(): return False _WasSpeakUpSilent = _IsSpeakUpSilent _icol = 0 _irow = 0 return else: _InitscrAlreadyRun = 1 _ttyout = open("/dev/tty", mode="w") signal.signal(1, _cleanup) signal.signal(3, _cleanup) signal.signal(15, _cleanup) if mouse_mode: _ttyin = open("/dev/tty", mode="r") _IsMouseMode = True # encoding_string = ':bytes'; print("\033[?1003h", end='', file=_ttyout) # sets SET_ANY_EVENT_MOUSE else: _ttyin = open("/dev/tty", mode="r") _IsMouseMode = False if speakup_silent and not _IsSpeakUpSilent: _enter_speakup_silent() try: import tty _ttyout_fnum = _ttyout.fileno() _old_tcattr = tty.tcgetattr(_ttyout_fnum) tty.setcbreak(_ttyout_fnum) mode = termios.tcgetattr(_ttyout_fnum) OFLAG = 1 mode[OFLAG] = mode[OFLAG] & ~(termios.ONLCR | termios.ONLRET) termios.tcsetattr(_ttyout_fnum, termios.TCSANOW, mode) # _getchar = lambda: _ttyin.read(1) # but ttyin will be re-opened :-( _getchar = lambda: _ttyin_read() except (ImportError, AttributeError): _ttyout_fnum = 0 # _getchar = lambda: _ttyin.readline()[:-1][:1] _getchar = lambda: _ttyin.readline() def _ttyin_read(): global _ttyin return _ttyin.read(1) def _ttyin_readline(): global _ttyin return _ttyin.readline()[:-1][:1] def _cleanup(num,frame): import tty global _ttyout, _ttyout_fnum, _old_tcattr print("\033[0m", end='', file=_ttyout) _leave_mouse_mode() _ttyout_fnum = _ttyout.fileno() tty.setcbreak(_ttyout_fnum) termios.tcsetattr(_ttyout_fnum, termios.TCSANOW, _old_tcattr) # raise KeyboardInterrupt sys.exit() def _endwin(): global _ttyout, _old_tcattr, _InitscrAlreadyRun global _IsMouseMode, _WasMouseMode, _IsSpeakUpSilent, _WasSpeakUpSilent print("\033[0m", end='', file=_ttyout) if _InitscrAlreadyRun > 1: if _IsMouseMode and not _WasMouseMode: _leave_mouse_mode() elif not _IsMouseMode and _WasMouseMode: _enter_mouse_mode() if _IsSpeakUpSilent and not _WasSpeakUpSilent: _leave_speakup_silent() elif not _IsSpeakUpSilent and _WasSpeakUpSilent: _enter_speakup_silent() _InitscrAlreadyRun -= 1 return print("\033[?1003l", end='', file=_ttyout) _ttyout.flush() __IsMouseMode = False if _IsSpeakUpSilent: _leave_speakup_silent() import tty _ttyout_fnum = _ttyout.fileno() tty.setcbreak(_ttyout_fnum) termios.tcsetattr(_ttyout_fnum, termios.TCSANOW, _old_tcattr) _InitscrAlreadyRun = 0 # ----------------------- size handling ---------------------- _maxcols = 79 _maxrows = 24 _size_changed = True _otherlines = '' _notherlines = 0 def _check_size(): global _size_changed, _maxcols, _maxrows, _ttyout_fnum global _otherlines, _notherlines if not _size_changed: return # http://bytes.com/groups/python/607757-getting-terminal-display-size s = struct.pack("HHHH", 0, 0, 0, 0) x = fcntl.ioctl(_ttyout_fnum, termios.TIOCGWINSZ, s) [_maxrows, _maxcols, xpixels, ypixels] = struct.unpack("HHHH", x) _maxcols -= 1 if _notherlines: _otherlines_a = _fmt(_otherlines) _notherlines = len(_otherlines_a) _size_changed = False; # $SIG{'WINCH'} = sub { $size_changed = 1; }; def _set_size_changed(signum,stackframe): global _size_changed _size_changed=True signal.signal(28, _set_size_changed) # ------------------------ ask stuff ------------------------- # Options such as integer, real, positive, >x, >=x, readline(''); #print STDERR "\e[J"; #return $filename; return ask(question) def ask(question, default=''): try: r'''Prints the question and, on the same line, expects the user to input a string. Left- and Right-arrow and Backspace work as usual, ctrl-A goes to the beginning and ctrl-E to the end. If default is specified, it appears on the line initially. ask() returns the string when the user presses Enter. ''' global _silent, _KEY_LEFT, _KEY_RIGHT if not question: return '' _initscr(speakup_silent=True) nol = _display_question(question) i = 0 # cursor position n = 0 # string length s_a = [] # list of letters in string if default: _speak(question+', default is '+default) default = re.sub('\t', ' ', default) s_a = [y for y in default] n = len(default) #i = n #for j in range(len(s_a)): # _puts(s_a[j]) _puts(default) _left(n) else: _speak(question) while True: c = _getch() if c == "\r" or c == "\n": _erase_lines(1) break if _size_changed: _erase_lines(0) nol = _display_question(question) if c == _KEY_LEFT: if i > 0: i-=1 _left(1) elif c == _KEY_RIGHT and i < n: _puts('x') if _silent else _puts(s_a[j]) i+=1 elif c == _KEY_DELETE and i < n: n -= 1 s_a.pop(i) # splice(@s, $i, 1) j = i while j < n: _puts('x') if _silent else _puts(s_a[j]) j += 1 _clrtoeol() _left(n-i) elif (c == "\b") or (c == "\177"): if i > 0: n -= 1 i -= 1 if not _silent: # 1.63 _speak(s_a[i]) s_a.pop(i) # splice(@s, $i, 1) _left(1) j = i while j < n: _puts('x') if _silent else _puts(s_a[j]) j += 1 _clrtoeol() _left(n-i) elif c == "\030" or c == "\004": # clear ... _left(i) i = 0 n = 0 _clrtoeol() s_a = [] elif c == "\001" or c == _KEY_HOME: # 1.67 _left(i) i = 0 elif c == "\005" or c == _KEY_END: # 1.67 _right(n-i) i = n elif c == "\014": _speak("".join(s_a)) elif str(type(c)) == "": _beep() elif ord(c) >= 32: _beep() # splice(@s, $i, 0, $c); s_a.insert(i, c) n+=1 i+=1 if _silent: _puts('x') else: _puts(c) _speak(c) j = i while j < n: _puts(s_a[j]) j += 1 _clrtoeol() _left(n-i) else: _beep() _speak("".join(s_a), True) _endwin() _silent = False return "".join(s_a) except Exception as err: # print("handling ask exception") _endwin() subprocess.call(['stty','sane']) _warn(err) sys.exit() # ----------------------- choose stuff ------------------------- def _debug(string): tmp = open("/tmp/clui_debug", mode="a") print(string, file=tmp) tmp.close() # my (%irow, %icol, $nrows, $clue_has_been_given, $choice, $this_cell); random.seed(None) _HOME = os.getenv('HOME') or os.getenv('LOGDIR') or os.path.expanduser('~') _marked = [] _clue_has_been_given = False _this_cell = 0 _choice = '' _list = [] def choose(question, a_list, multichoice=False): try: r''' Prints the question, then a compact formatting of the list of strings with one (the cursor) highlit. Initially, the cursor is on that string which the user chose previously in response to this same question. The user then uses arrow keys (or hjkl) and Return, or q to quit. The Return key causes choose() to return the string under the cursor; q or ctrl-X for Quit causes choose() to return None. If there are too many choices to fit on the screen, the user is prompted for a (case-sensitive) clue, which is used to narrow down the choices until they do fit. If the environment variable CLUI_MOUSE is set to OFF then choose() will not interpret mouse-clicks as making a choice. The advantage of this is that the mouse can then be used to highlight and paste text from this window as usual.`` If multichoice is set, the SpaceBar works to select (or deselect) the various choices (the choice under the cursor when Return is pressed is also selected), and choose() returns a list of strings. ''' # wantarray doesn't exist in Python because no $ or @ global _maxcols, _marked, _list, _size_changed, _nrows, _icol_a, _irow_a global _irow, _otherlines, _notherlines, _otherlines_a global _ttyout, _this_cell, _clue_has_been_given, _choice, _CursorRow _list = a_list for i in range(len(_list)): _list[i] = re.sub('[\r\n]+$', '', _list[i]) # chop final \n if any a_list = _list icell = 0 _marked = [False for item in _list] question = re.sub('[\r\n]+$', '', question) question = re.sub('^[\r\n]+', '', question) _otherlines = '' _otherlines_a = [] lines = re.split('\r?\n', question, 1) firstline = lines[0] firstlinelength = len(firstline) _choice = get_default(firstline) chosen = [] _initscr(mouse_mode=True, speakup_silent=True) _size_and_layout(0) if (len(lines) > 1): _otherlines = lines[1] _otherlines_a = _fmt(lines[1]) #if len(otherlines_a): # puts("\r\n" + "\r\n".join(otherlines_a) + "\r") # goto(1+len(firstline), 0) _notherlines = len(_otherlines_a) if multichoice: if (firstlinelength < _maxcols-30): _puts(firstline+" (multiple choice with spacebar)") elif (firstlinelength < _maxcols-16): _puts(firstline + "(multiple choice)") elif (firstlinelength < _maxcols-9): _puts(firstline + "(multiple)") else: _puts(firstline) if _nrows >= _maxrows: _speak(firstline+', ', wait=True) else: _speak(firstline+', multiple choice, '+_list[_this_cell]) else: _puts(firstline) if _nrows >= _maxrows: _speak(firstline+', ', wait=True) else: _speak(firstline+', choose '+_list[_this_cell]) _clrtoeol() if _nrows >= _maxrows: _list = _narrow_the_search(_list) if not _list: _up(1) _clrtoeol() _endwin() _clue_has_been_given = False if multichoice: return [] else: return None _speak('choose '+_list[_this_cell]) _wr_screen() print("\033[6n", end='', file=_ttyout) # u7 will set _AbsCursX, _AbsCur _ttyout.flush() _CursorRow = _irow_a[_this_cell] # global, needed by handle_mouse while True: c = _getch() if _size_changed: _size_and_layout(_nrows) if _nrows >= _maxrows: _list = _narrow_the_search(_list) if not _list: _up(1) _clrtoeol() _endwin() _clue_has_been_given = False if multichoice: return [] else: return None _wr_screen() _speak('choose '+_list[_this_cell]) if (c == "q" or c == "\004" or c == "\030"): _erase_lines(1) if _clue_has_been_given: re_clue = confirm("Do you want to change your clue ?") _up(1) _clrtoeol() # erase the confirm if re_clue: _irow = 1 _list = _narrow_the_search(a_list) _wr_screen() _speak('choose '+_list[_this_cell]) continue else: _up(1) _clrtoeol() _endwin() _clue_has_been_given = False if multichoice: return [] else: return None _goto(0,0) _clrtoeol() _endwin() _clue_has_been_given = False if multichoice: return [] else: return None elif (c == "\t") and (_this_cell < (len(_list)-1)): _this_cell+=1 _wr_cell(_this_cell-1) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif (((c == "l") or (c == _KEY_RIGHT)) and (_this_cell < (len(_list)-1)) and (_irow_a[_this_cell] == _irow_a[_this_cell+1])): _this_cell+=1 _wr_cell(_this_cell-1) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif (((c == "\010") or (c == _KEY_BTAB)) and (_this_cell > 0)): _this_cell-=1 _wr_cell(_this_cell+1) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif (((c == "h") or (c == _KEY_LEFT)) and (_this_cell > 0) and (_irow_a[_this_cell] == _irow_a[_this_cell-1])): _this_cell-=1 _wr_cell(_this_cell+1) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif (((c == "j") or (c == _KEY_DOWN)) and (_irow < _nrows)): mid_col = _icol_a[_this_cell] + int(0.5*len(_list[_this_cell])) left_of_target = 1000 inew=_this_cell+1 while inew < len(_list): if _icol_a[inew] < mid_col: break # skip rest of row inew+=1 while inew < len(_list): new_mid_col = _icol_a[inew] + int(0.5*len(_list[inew])) if new_mid_col >= mid_col: # we've reached it break if (inew == (len(_list)-1)) or (_icol_a[inew+1]<=_icol_a[inew]): break # we're at EOL left_of_target = mid_col - new_mid_col inew+=1 if ((new_mid_col - mid_col) > left_of_target): inew-=1 iold = _this_cell _this_cell = inew _wr_cell(iold) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif (((c == "k") or (c == _KEY_UP)) and (_irow > 1)): mid_col = _icol_a[_this_cell] + int(0.5*len(_list[_this_cell])) right_of_target = 1000 inew = _this_cell-1 while inew > 0: if _irow_a[inew] < _irow_a[_this_cell]: # skip rest of row break inew-=1 while (inew > 0): if not _icol_a[inew]: break new_mid_col = _icol_a[inew] + int(0.5*len(_list[inew])) if new_mid_col < mid_col: # we're past it break right_of_target = new_mid_col - mid_col inew-=1 if ((mid_col - new_mid_col) > right_of_target): inew+=1 iold = _this_cell _this_cell = inew _wr_cell(iold) _wr_cell(_this_cell) _speak(_list[_this_cell]) elif c == "\014": if _size_changed: _size_and_layout(_nrows) if _nrows >= _maxrows: _list = _narrow_the_search(_list); if not _list: _up(1) _clrtoeol() _endwin() _clue_has_been_given = False if multichoice: return [] else: return None _wr_screen() elif (c == "\r") or (c == "\n"): _erase_lines(1) _goto(firstlinelength+1, 0) if multichoice: i = 0 while i < len(_list): if _marked[i] or (i==_this_cell): chosen.append(_list[i]) i+=1 _clrtoeol() remaining = _maxcols-firstlinelength last = chosen.pop() dotsprinted = False for item in chosen: if ((remaining - len(item)) < 4): dotsprinted = True _puts("...") remaining -= 3 break else: _puts(item+", ") remaining -= (2 + len(item)) if not dotsprinted: if (remaining - len(last)) > 0: _puts(last) elif remaining > 2: _puts('...') _puts("\n\r"); chosen.append(last) else: _puts(_list[_this_cell]+"\n\r") _endwin() set_default(firstline, _list[_this_cell]); # join ($,,@chosen) ? _clue_has_been_given = False if multichoice: _speak(' and '.join(chosen), wait=True) return chosen else: _speak(_list[_this_cell], wait=True) return _list[_this_cell] elif c == " ": if multichoice: _marked[_this_cell] = not _marked[_this_cell] # if (_this_cell < (len(_list)-1)): # 1.50 # _this_cell+=1 # _wr_cell(_this_cell-1) _wr_cell(_this_cell) _speak('marked') #elif (_this_cell < (len(_list)-1)): # _this_cell+=1 # _wr_cell(_this_cell-1) # _wr_cell(_this_cell) _endwin() print("choose: shouldn't reach here ...\n", file=sys.stderr) except KeyboardInterrupt: # print("handling exception") _leave_mouse_mode() _endwin() subprocess.call(['stty','sane']) return '' def _layout(my_list): global _irow_a, _icol_a, _this_cell, _maxcols, _maxrows, _choice _irow_a = [] _icol_a = [] _this_cell = 0 my_irow = 1 my_icol = 0 l = [] i = 0 while (i < len(my_list)): l.append(len(my_list[i]) + 2) if (l[i] > _maxcols-1): l[i] = _maxcols-1 if ((my_icol + l[i]) >= _maxcols): my_irow += 1 my_icol = 0 if my_irow > _maxrows: return my_irow _irow_a.append(my_irow) _icol_a.append(my_icol) my_icol += l[i] if my_list[i] == _choice: _this_cell = i i += 1 return my_irow def _wr_screen(): global _otherlines, _notherlines, _nrows, _maxrows, _list, _this_cell i = 0 while (i < len(_list)): if not i == _this_cell: _wr_cell(i) i += 1 if (_notherlines and (_nrows+_notherlines) < _maxrows): _puts("\r\n" + "\r\n".join(_otherlines_a) + "\r") _wr_cell(_this_cell) def _wr_cell(i): global _icol_a, _irow_a, _icol, _marked, _this_cell, _list global _A_BOLD, _A_REVERSE, _A_NORMAL, _A_UNDERLINE _goto(_icol_a[i], _irow_a[i]); if _marked[i]: _attrset(_A_BOLD | _A_UNDERLINE) if i == _this_cell: _attrset(_A_REVERSE) no_tabs = _list[i] no_tabs = re.sub("\t", " ", no_tabs) no_tabs = " " + no_tabs + " " _puts(no_tabs[:_maxcols]) # 1.42, 1.54 if _marked[i] or (i == _this_cell): _attrset(_A_NORMAL) def _size_and_layout(erase_rows): global _maxrows, _nrows, _list _check_size() if (erase_rows): if (erase_rows > _maxrows): erase_rows = _maxrows _erase_lines(1) _nrows = _layout(_list) def _narrow_the_search(a_list): global _maxrows, _nrows, _KEY_LEFT, _KEY_RIGHT, _clue_has_been_given global _IsMouseMode nchoices = len(a_list) n = 0 i = 0 s_a = [] s = '' my_list = a_list _clue_has_been_given = True if _IsMouseMode: # 1.55 _leave_mouse_mode() _ask_for_clue(nchoices, i, s); while True: c = _getch() if _size_changed: _size_and_layout(0) if _nrows < _maxrows: _erase_lines(1) _enter_mouse_mode() return my_list if c == _KEY_LEFT and i > 0: i-=1 _left(1) continue elif c == _KEY_RIGHT: if i < n: _puts(s_a[i]) i+=1 continue elif c == "\b" or c == "\177": if i > 0: n-=1 i-=1 _speak(s_a[i], wait=True) # 1.63 s_a.pop(i) _left(1) j = i while j < n: _puts(s_a[j]) j += 1 _clrtoeol() _left(n-i) elif c == "\003" or c == "\030" or c == "\004": if not s_a: _clue_has_been_given = False _erase_lines(1) _enter_mouse_mode() return [] _left(i) i = 0 n = 0 s_a = [] _clrtoeol() elif c == "\002": _left(i) i = 0 continue elif c == "\005": _right(n-i) i = n continue elif c == "\014": x = i # do nothing elif str(type(c)) == "": _beep() else: if ord(c) >= 32: # nchoices and ? s_a.insert(i, c) n+=1 i+=1 _puts(c) j = i while j < n: _puts(s_a[j]) j += 1 _clrtoeol() _left(n-i) _speak(c, wait=True) # 1.63 else: _beep() # grep, and if $nchoices=1 return s = "".join(s_a); # list = grep($[ <= index($_,$s), @biglist); if s: # a lambda function can't refer to s :-( # my_list = list(filter(lambda x: s.find(x)>=0, biglist)) my_list = [] for tmp_str in a_list: tmp_str.find(s)>=0 and my_list.append(tmp_str) else: my_list = a_list nchoices = len(my_list) _nrows = _layout(my_list) if (nchoices==1 or (nchoices and (_nrows<_maxrows))): _puts("\r") _clrtoeol() _up(1) _clrtoeol() _enter_mouse_mode() return my_list _ask_for_clue(nchoices, i, s) print("_narrow_the_search: shouldn't reach here ...", file=sys.stderr) def _ask_for_clue(nchoices, i, s): if nchoices: if s: headstr = "the choices won't fit; there are still"; _goto(0,1) _puts(headstr+" "+str(nchoices)+" of them") _clrtoeol() _goto(0,2) _puts("lengthen the clue : ") _right(i) _speak("still "+str(nchoices)+" choices, lengthen the clue") else: headstr = "the choices won't fit; there are" _goto(0,1) _puts(headstr+" "+str(nchoices)+" of them") _clrtoeol() _goto(0,2) _puts(" give me a clue : (or ctrl-X to quit)") _left(31) # 1.62 _speak(str(nchoices)+" choices, give me a clue, or control-X to quit") else: _goto(0,1) _puts("No choices fit this clue !") _clrtoeol(); _goto(0,2) _puts(" shorten the clue : ") _right(i) _speak("no choices fit, shorten the clue") def get_default(question): r'''Returns (what the dbm database remembers as) the choice the user made the last time they were asked this question. ''' if os.getenv('CLUI_DIR') == 'OFF': return '' if not question: return '' n_tries = 5 while n_tries > 0: try: CHOICES = dbm.open (_dbm_file(), 'c', 0o600) break except NameError: return '' except IOError: if n_tries < 2: return '' select.select([], [], [], random.uniform(0.0, 0.45)) else: return '' n_tries -= 1 my_choice = CHOICES.get(question) CHOICES.close() if my_choice: return my_choice.decode() else: return '' def set_default(question, answer): r'''Overwrites the choice the user made the last time they were confronted with this question. This can be useful in an application where one task typically follows another, to set the next default choice. ''' if os.getenv('CLUI_DIR') == 'OFF': return None if not question: return None n_tries = 5 while n_tries > 0: try: CHOICES = dbm.open (_dbm_file(), 'c', 0o600) break except NameError: return None except IOError: if n_tries < 2: return '' select.select([], [], [], random.uniform(0.0, 0.45)) else: return None n_tries -= 1 CHOICES[question] = answer CHOICES.close() return answer def _dbm_file(): global _HOME if (os.getenv('CLUI_DIR') == 'OFF'): return None if (os.getenv('CLUI_DIR')): db_dir = os.getenv('CLUI_DIR') db_dir = re.sub('^~', _HOME, db_dir) else: db_dir = _HOME+"/.clui_dir" os.path.exists(db_dir) or os.mkdir(db_dir, 0o750) return db_dir+"/choices" def _handle_mouse(x, y, button_pressed, button_drag): # 1.50 global _TopRow, _AbsCursY, _CursorRow, _LastEventWasPress global _this_cell, _irow_a, _icol_a, _list _TopRow = _AbsCursY - _CursorRow if _LastEventWasPress: _LastEventWasPress = False return '' if y < _TopRow: return '' mouse_row = y - _TopRow mouse_col = x - 1 found = False for i in range(len(_irow_a)): if _irow_a[i] == mouse_row: if _icol_a[i] < mouse_col and (_icol_a[i]+len(_list[i])) >= mouse_col: found = True break if _irow_a[i] > mouse_row: break i += 1 if not found: return '' # if xterm doesn't receive a button-up event it thinks it's dragging return_char = '' if button_pressed == 1 and not button_drag: _LastEventWasPress = True return_char = _KEY_ENTER elif button_pressed == 3 and not button_drag: _LastEventWasPress = True return_char = ' ' if i != _this_cell: t = _this_cell _this_cell = i _wr_cell(t) _wr_cell(_this_cell) return return_char # ----------------------- confirm stuff ------------------------- def confirm(question): '''Print the question, and the user replies Yes or No using "y", "Y", "n" or "N". confirm() returns True or False. ''' global _ttyin, _ttyout if not question: return(False) # return(0) unless -t STDERR if not os.isatty(sys.stdout.fileno()): return(None) _initscr(speakup_silent=True) nol = _display_question(question) _puts (" (y/n) ") _speak(question + ', y or n') while (True): response=_getch() if (re.match('[yYnN]', response)): break _beep() _left(6) _clrtoeol() if (re.match('[yY]', response)): _puts("Yes") _speak('yess', wait=True) else: _puts("No") _speak('know', wait=True) _erase_lines(1) _endwin() if (re.match('[yY]', response)): return True else: return False # ----------------------- edit stuff ------------------------- def edit(title='', text=''): r'''If there's no text and the "title" is a filename that exists and is writeable, then the user's default EDITOR is invoked on that file. If the file is only readable, the user's default PAGER is used. If there is text, the editor is invoked on that text, and the title is displayed within the temporary file-name. In either case, the resulting text is returned. ''' # my ($dirname, $basename, $rcsdir, $rcsfile, $rcs_ok); editor = os.getenv('EDITOR') or "vi"; # should also get_default() if not title: # start editor session with no preloaded file subprocess.call([editor]) elif text: # must create tmp file with title embedded in name tmpdir = '/tmp/'; safename = re.sub('[\W_]+', '_', title) fname = tmpdir + safename + str(os.getpid()) try: fh = open(fname, mode="w") except EnvironmentError as err: sorry("can't open "+fname+": "+str(err)) return '' print(text, file=fh) fh.close() subprocess.call([editor, fname]) try: fh = open(fname, mode="r") except EnvironmentError as err: sorry("can't read "+fname+": "+str(err)) return '' text = fh.read() fh.close() try: os.unlink(fname) except EnvironmentError as err: sorry("couldn't unlink "+fname+": "+str(err)) return text else: # its a file, we will try RCS ... file = title # weed out no-go situations file_stat = os.stat(file) # if os.path.isdir(file): # less yukky, but does an extra stat if stat.S_ISDIR(file_stat.st_mode): # YUK sorry(file+" is already a directory") return '' #if (-B _ and -s _): # sorry(file+" is not a text file") # return '' #if (-T _ and !-w _): if not _is_writeable(file_stat): view(file) return True # it's a writeable text file, so work out the locations if file.find(os.path.sep) >= 0: rcsdir = os.path.dirname(file)+'/RCS' basename = os.path.basename(file) rcsfile = rcsdir+os.path.sep+basename+',v' else: basename = file rcsdir = "RCS" rcsfile = rcsdir+os.path.sep+os.path.basename(file)+',v' rcslog = rcsdir+'/log' # we no longer create the RCS directory if it doesn't exist, # so you have to `mkdir RCS' to enable rcs in a directory ... rcs_ok = True if not os.path.isdir(rcsdir): rcs_ok = False elif not _is_writeable(rcsdir): rcs_ok = False print("can't write in "+rcsdir, file=sys.stderr) # if the file doesn't exist, but the RCS does, then check it out if rcs_ok and os.path.isfile(rcsfile) and not os.path.isfile(file): subprocess.call(["co", "-l", file, rcsfile]) starttime = time.time() subprocess.call([editor, file]) elapsedtime = time.time() - starttime; # could be output or logged, for worktime accounting # if (rcs_ok and -T file): # check it in if rcs_ok: if not os.path.isfile(rcsfile): msg = ask (file+' is new. Please describe it:'); if msg: quotedmsg = re.sub("'","'\"'\"'", msg) # system "ci -q -l -t-'$quotedmsg' -i $file $rcsfile"; subprocess.call(["ci", "-q", "-l", "-t-'"+quotedmsg+"'", file, rcsfile]) _logit(rcslog, basename, msg) else: msg = ask('What changes have you made to '+file+' ?') quotedmsg = re.sub(r"'", "'\"'\"'", msg) if msg: subprocess.call(["ci", "-q", "-l", "-m'"+quotedmsg+"'", file, rcsfile]) _logit(rcslog, basename, msg) def _logit(rcslog, file, msg): logfile = open(rcslog, mode="a") print(_timestamp()+' '+file+' '+os.getlogin()+' '+msg, file=logfile) logfile.close() def _timestamp(): # returns current date and time in "199403011 113520" format x = time.localtime(time.time()) return '{0:0=4}{1:0=2}{2:0=2} {3:0=2}{4:0=2}{5:0=2}'.format(x.tm_year, x.tm_mon, x.tm_mday, x.tm_hour, x.tm_min, x.tm_sec) # -------------------------- filetests -------------------------- def _re_grep(regexp, a_list): '''greps a regexp in a list of strings''' l = [] for tmpstr in a_list: if re.match(regexp, tmpstr): l.append(tmpstr) return l def _is_readable(arg): my_type = str(type(arg)) if my_type == "": if not os.path.exists(arg): return False my_stat_result = os.stat(arg) elif my_type == "": my_stat_result = arg else: return False my_euid = os.geteuid() my_groups = os.getgroups() my_fuid = my_stat_result.st_uid my_fgid = my_stat_result.st_gid my_mode = my_stat_result.st_mode if (my_euid == my_fuid) and (my_mode & 0o400): return True if my_mode & 0o40: for gid in my_groups: if gid == my_fgid: return True if my_mode & 0o4: return True return False def _is_executable(arg): my_type = str(type(arg)) if my_type == "": if not os.path.exists(arg): return False my_stat_result = os.stat(arg) elif my_type == "": my_stat_result = arg else: return False my_euid = os.geteuid() my_groups = os.getgroups() my_fuid = my_stat_result.st_uid my_fgid = my_stat_result.st_gid my_mode = my_stat_result.st_mode if (my_euid == my_fuid) and (my_mode & 0o400) and (my_mode & 0o100): return True if (my_mode & 0o40) and (my_mode & 0o10): for gid in my_groups: if gid == my_fgid: return True if (my_mode & 0o4) and (my_mode & 0o1): return True return False def _is_textfile(arg): # arg must be a str, the filename my_type = str(type(arg)) if my_type == "": if not os.path.exists(arg): return False else: return False try: f = open(arg, mode='br') except EnvironmentError as err: print("can't open "+arg+": "+err, file=sys.stderr) ascii = 0 nonascii = 0 for byte in f.read(2048): # if ord(c) > 127: if (byte > 127) or (byte<9) or ((byte>14) and (byte<32)): nonascii += 1 else: ascii += 1 f.close() if ascii == 0: return None elif (nonascii/ascii) > 0.10: return False else: return True def _is_owned(arg): my_type = str(type(arg)) if my_type == "": if not os.path.exists(arg): return False my_stat_result = os.stat(arg) elif my_type == "": my_stat_result = arg else: return False my_euid = os.geteuid() my_fuid = my_stat_result.st_uid if my_euid == my_fuid: return True return False # ----------------------- sorry stuff ------------------------- def sorry(msg): # warns user of an error condition r'''Prints the message to stderr preceded by the word "Sorry, " ''' print('Sorry, '+str(msg), file=sys.stderr) _speak('Sorry, '+str(msg), wait=True) def inform(msg): r'''Prints the message to /dev/tty or to stderr. ''' msg = re.sub('[\r\n]+$', '', msg) try: ttyout = open('/dev/tty', mode='w') print(msg, file=ttyout) ttyout.close() except: print(str(msg), file=sys.stderr) _speak(str(msg), wait=True) # ----------------------- view stuff ------------------------- def view(title='', text=''): # or ($filename) = r'''If there's no text and the "title" is a filename that exists and is readable, then a pager is invoked on that file. Else, a pager is invoked on the text, and the title is displayed somewhere as a title. If the text covers 60% or more of the screen, the user's default PAGER is used; if the text is two lines or less, it is just printed; in between, a built-in tiny pager is used which offers the user the choices "q" to clear the text and continue, or Enter to leave the text on the screen and continue. ''' # 1.65 if it's a .doc file, then wvText, antiword or catdoc should be used global _OpenFile pager = os.getenv('PAGER') if not pager: for f in ["/usr/bin/less", "/usr/bin/more"]: if os.path.exists(f): default_pager = f break if (not text) and os.path.exists(title) and _Open(title, mode='r'): nlines = 0 for line in _OpenFile: nlines += 1 if (nlines > _maxrows): break _OpenFile.close() if (nlines > int(0.6*_maxrows)): subprocess.call(pager, title) else: fh = open(title, mode='r') text = fh.read() fh.close() _tiview(title, text); else: lines = re.split('\r?\n', text, _maxrows-1) if len(lines) < 21: _tiview (title, text) else: tmpdir = '/tmp/' safename = re.sub('[\W_]+', '_', title) fname = tmpdir + safename + os.getpid() if not _Open(fname, mode="w"): return '' _OpenFile.print(text) _OpenFile.close() subprocess.call(pager, fname) _Unlink(tmp) def _tiview(title='', text=''): global _icol, _irow if not text: return False title = re.sub('\t', ' ', title) titlelength = len(title) _check_size() rows = _fmt(text, nofill=True); _initscr(); if 3 > len(rows): _puts(title+"\r\n"+("\r\n".join(rows))+"\r\n") _speak(title+', '+(' '.join(rows)), wait=True) _endwin() return True if titlelength > (_maxcols-35): _puts (title+"\r\n") else: _puts (title+" ( to continue, q to clear)\r\n") _puts("\r" + "\r\n".join(rows) + "\r") # the perl version does clrtoeol _speak(title+', enter to continue,'+(' '.join(rows))) _icol = 0 _irow = len(rows) _goto(titlelength+1, 0) while (True): c = _getch() if (c == 'q' or c == "\030" or c == "\027" or c == "\030" or c == "\003" or c == "\c\\"): _erase_lines(0) _endwin() return True elif (c == "\r" or c == "\n"): # retains text on screen _clrtoeol() _goto(0, len(rows)+1) _endwin() return True elif (c == "\014"): _puts("\r") _endwin() _tiview(title, text) return True print("_tiview: shouldn't reach here\n", file=sys.stderr) return False # ----------------------- help_text -------------------------- def help_text(mode=''): ''' This returns a short help message for the user. If mode is "ask" then the text describes the keys the user has available when responding to an ask() question; If mode is "multi" then the text describes the keys and mouse actions the user has available when responding to a multiple-choice choose() question; otherwise, it describes the keys and mouse actions the user has available when responding to a single-choice choose(). ''' if mode == 'ask': return "\nLeft and Right arrowkeys, Backspace, Delete; control-B = beginning; control-E = end; control-X = clear; then Return." if os.getenv('CLUI_MOUSE') == 'OFF': text = "\nmove around with Arrowkeys (or hjkl);" else: text = "\nmove around with Mouse or Arrowkeys (or hjkl);" if re.match('mult',mode): text += " multiselect with Rightclick or Spacebar;" text += " then either q or ctrl-X for quit," if os.getenv('CLUI_MOUSE') == 'OFF': text += " or Return to choose." else: text += " or choose with Leftclick or Return." return text # -------------------------- infrastructure ------------------------- SpeakMode = set() def _speak(text, wait=None): # 1.60 global _Eflite_FH, _Espeak, _Espeak_PID if (not _Eflite_FH and not _Espeak) or not text or len(text) == 0: return None if 'dot' in SpeakMode: text = re.sub('\s*\.\s*', ' dot ', text) text = re.sub(r'\s*\.(\w)', r' dot \1', text) if _Eflite_FH: if len(text) == 1: if text == '.': _Eflite_FH.write(bytes("s\nq { dot }\nd\n",'ISO-8859-1')) else: _Eflite_FH.write(bytes("s\nl {"+text+"}\n",'ISO-8859-1')) _Eflite_FH.flush() if wait: time.sleep(0.5) else: _Eflite_FH.write(bytes("s\nq {"+text+"}\nd\n",'ISO-8859-1')) _Eflite_FH.flush() # useless emacspeak op: tts_sy nc_state all 0 0 1 225\nq {[:np ]} if wait: time.sleep(0.3+0.07*len(text)) elif _Espeak: if _Espeak_PID > 0.5: os.kill(_Espeak_PID, signal.SIGHUP) os.wait() _Espeak_PID = None; _Espeak_PID = os.fork() if _Espeak_PID > 0.5: if wait: if len(text) == 1: time.sleep(0.6) else: time.sleep(0.4+0.07*len(text)) else: pipe = subprocess.Popen(_Espeak, stdin=subprocess.PIPE) if not pipe: sys.exit() def _huphandler(signum,stackframe): pipe.kill() os.wait() sys.exit() signal.signal(signal.SIGHUP, _huphandler) if text == '.': text = 'dot' pipe.stdin.write(text.encode('utf8')+b"\n") pipe.stdin.flush() pipe.stdin.close() os.wait() sys.exit() _OpenFile = 0 def _Open(filename, mode="r"): global _OpenFile try: _OpenFile = open(filename, mode=mode) return True except EnvironmentError as err: print("\ncan't open "+filename+': '+str(err), file=sys.stderr) return False def _Unlink(filename): try: os.unlink(filename) return True except EnvironmentError as err: print("\ncan't unlink "+filename+": "+str(err), file=sys.stderr) return False def _display_question(question, nofirstline=False): '''used by ask() and confirm(), but not by choose() ...''' _check_size() otherlines_a = [] # my ($firstline, @otherlines); if nofirstline: otherlines_a = _fmt(question) else: # [firstline,otherlines] = re.split('\r?\n', question, 2) lines = re.split('\r?\n', question, 1) if (lines[0]): _puts(lines[0] + " ") if (len(lines) > 1): otherlines_a = _fmt(lines[1]) if len(otherlines_a): _puts("\r\n" + "\r\n".join(otherlines_a) + "\r") _goto(1+len(lines[0]), 0) return len(otherlines_a) def _erase_lines(nline): '''leaves cursor at beginning of line nline and clears rest of screen''' global _ttyout _goto(0, nline) print("\033[J", end='', file=_ttyout) _ttyout.flush() def _fmt(text, nofill=False): '''Used by _tiview, ask and confirm; formats the text within maxcols cols''' # my (@i_words, $o_line, @o_lines, $o_length, $last_line_empty, $w_length); # my (@i_lines, $initial_space); global _maxcols o_line = '' o_lines = [] o_length = 0 last_line_empty = False i_lines = re.split('\r?\n',text) for i_line in i_lines: if (re.search('^\s*$', i_line)): if (o_line): o_lines.append(o_line) o_line='' o_length=0 if (not last_line_empty): o_lines.append('') last_line_empty = True continue last_line_empty = False if nofill: o_lines.append(i_line[0:_maxcols]) continue # if ($i_line =~ s/^(\s+)//) { # line begins with space ? split_list = re.split(r'^(\s+)', i_line, 1) if (len(split_list) > 2): i_line = split_list[2] initial_space = re.sub(r'\t', ' ', split_list[1]) if (o_line): o_lines.append(o_line) o_line = initial_space o_length = len(initial_space) else: initial_space = '' i_words = re.split(r'\s+', i_line) for i_word in i_words: w_length = len(i_word) if ((o_length + w_length) >= _maxcols): # >= 1.54 o_lines.append(o_line) o_line = initial_space o_length = len(initial_space) if (w_length > _maxcols): # chop it ! o_lines,append(i_word[0:_maxcols]) continue if (o_line): o_line += ' ' o_length += 1 o_line += i_word o_length += w_length if (o_line): o_lines.append(o_line) if (len(o_lines) < _maxrows-2): return (o_lines) else: return o_lines[0, _maxrows-2] def back_up(): r'''Moves the cursor up one line, to the beginning of the line, and clears the line. Useful if your application is validating the results of an ask() and wishes to re-pose the question. ''' ttyout = open("/dev/tty", mode="w") print("\r\033[K\033[A\033[K", end='', file = ttyout) ttyout.close def select_file(Chdir=True, Create=False, ShowAll=False, DisableShowAll=False, SelDir=False, FPat='*', File='', Path='', Title='', TopDir='/', TextFile=False, Readable=False, Writeable=False, Executable=False, Owned=False, Directory=False, multichoice=False): r''' This function asks the user to select a file from the filesystem. It offers Rescan and ShowAll buttons. The options are modelled on those of Tk::FileDialog but with various new options: TopDir, TextFile, Readable, Writeable, Executable, Owned and Directory Multiple choice is possible in a limited circumstance; when select_file() is invoked with multichoice=True, with Chdir=False and without Create. It is not possible to select multiple files lying in different directories. Three problem filenames: 'Create New File', 'Show DotFiles' and 'Hide DotFiles' will, if present in your filesystem, cause confusion. Chdir Enable the user to change directories. The default is True. If it is set to False, and multichoice to True, and Create is not set, then the user can select multiple files. Create Enables the user to specify a file that does not exist. The default is False. ShowAll Determines whether hidden files (.*) are displayed. The default is False. DisableShowAll Disables the ability of the user to change the status of the ShowAll flag. By default the user is allowed to change the status). SelDir If True, enables selection of a directory rather than a file. The default is False. To _enforce_ selection of a directory, use the Directory option. FPat Sets the default file selection pattern, in glob format, e.g. '*.html'. Only files matching this pattern will be displayed. If you want multiple patterns, you can use formats like '*.[ch]' or see glob.glob for details. The default is '*'. File The file selected, or the default file. The default default is whatever the user selected last time in this directory. Path The path of the selected file, or the initial path. The default is $HOME. Title The Title of the dialog box. If Title is specified, then select_file() dynamically appends "in " to it. The default title is "in directory /where/ever". TopDir Restricts the user to remain within a directory or its subdirectories. The default is "/". TextFile Only text files will be displayed. The default is False. Readable Only readable files will be displayed. The default is False. Writeable Only writeable files will be displayed. The default is False. Executable Only executable files will be displayed. The default is False. Owned Only files owned by the current user will be displayed. This is useful if the user is being asked to choose a file for a os.chmod() or chgrp operation, for example. The default is False. Directory Only directories will be displayed. The default is False. ''' import glob # if (!defined $option{'-Path'}) { $option{'-Path'}=$option{'-initialdir'}; } # if (!defined $option{'-FPat'}) { $option{'-FPat'}=$option{'-filter'}; } # if (!defined $option{'-ShowAll'}) {$option{'-ShowAll'}=$option{'-dotfiles'};} # if ($option{'-Directory'}) { $option{'-Chdir'}=1; $option{'-SelDir'}=1; } # my $multichoice = 0; # if (wantarray && !$option{'-Chdir'} && !$option{'-Create'}) { # $option{'-DisableShowAll'} = 1; # $multichoice = 1; if multichoice and not Chdir and not Create: DisableShowAll = True else: multichoice = False # } elsif (!defined $option{'-Chdir'}) { # $option{'-Chdir'} = 1; # } if Path and os.path.isdir(Path): dir = re.sub('([^/])$', r'\1/', Path) else: dir = re.sub('([^/])$', r'\1/', _HOME) if TopDir: if os.path.isdir(TopDir): TopDir = re.sub('([^/])$', r'\1/', TopDir) if TopDir.find(dir) >= 0: dir = TopDir #my ($new, $file, @allfiles, @files, @dirs, @pre, @post, %seen, $isnew); #my @dotfiles; while True: if SelDir: pre = ['./'] else: pre = [] post = [] try: allfiles = sorted(os.listdir(dir)) except EnvironmentError as err: sorry(str(err)) return None dotfiles = _re_grep(r'^\.', allfiles) if ShowAll: if dotfiles and not DisableShowAll: post=['Hide DotFiles'] else: allfiles = _re_grep(r'^[^.]', allfiles) if dotfiles and not DisableShowAll: post=['Show DotFiles'] # split @allfiles into @files and @dirs for option processing ... # @dirs = grep(-d "$dir/$_" and -r "$dir/$_", @allfiles); dirs = [] for f in allfiles: ff= os.path.join(dir, f) if os.path.isdir(ff) and _is_readable(ff): dirs.append(f) files = [] if Directory: pass elif FPat: baselength = len(dir) + len(os.path.sep) -1 for ff in glob.glob(os.path.join(dir,FPat)): if not os.path.isdir(ff): f = ff[baselength:] files.append(f) else: for f in allfiles: ff= os.path.join(dir, f) if not os.path.isdir(ff) and _is_readable(ff): files.append(f) if Chdir: for i in range(len(dirs)): dirs[i] += os.path.sep if TopDir: up = re.sub('[^/]+/?$', '', dir) # find parent directory if up.find(TopDir) >= 0: pre.insert(0, '../') # must check for symlinks to outside the TopDir ... else: pre.insert(0, '../') elif not SelDir: dirs = [] if Create: post.insert(0, 'Create New File') if TextFile: #@files = grep(-T "$dir/$_", @files); } i = 0 while i < len(files): ff= os.path.join(dir, files[i]) if not _is_textfile(ff): files.pop(i) else: i += 1 if Owned: #@files = grep(-o "$dir/$_", @files); } i = 0 while i < len(files): ff= os.path.join(dir, files[i]) if not _is_owned(ff): files.pop(i) else: i += 1 if Executable: #@files = grep(-x "$dir/$_", @files); } i = 0 while i < len(files): ff= os.path.join(dir, files[i]) if not _is_executable(ff): files.pop(i) else: i += 1 if Writeable: #@files = grep(-w "$dir/$_", @files); } i = 0 while i < len(files): ff= os.path.join(dir, files[i]) if not _is_writeable(ff): files.pop(i) else: i += 1 if Readable: #@files = grep(-r "$dir/$_", @files); } i = 0 while i < len(files): ff= os.path.join(dir, files[i]) if not _is_readable(ff): files.pop(i) else: i += 1 allfiles = pre + sorted(dirs+files) + post # reconstitute allfiles if Title: title = Title+" in "+dir else: title = "in directory "+dir+" ?" if File: set_default(title, File) SpeakMode.add('dot') if multichoice: new = choose(title, allfiles, multichoice=True) SpeakMode.remove('dot') if not new: return [] for i in range(len(new)): new[i] = dir+new[i] return new new = choose (title, allfiles) SpeakMode.remove('dot') if (ShowAll and new == 'Hide DotFiles'): ShowAll = False _up(1) continue # ARGHHHhhh no redo :-( elif (not ShowAll and new == 'Show DotFiles'): ShowAll = True _up(1) continue # ARGHHHhhh no redo :-( if new == "Create New File": new = ask("new file name ?") # validating this is a chore :-( if not new: continue if re.match('^/', new): file = new; else: file = dir+new file = re.sub('//+', '/', file) # simplify //// down to / while re.match(r'./\.\./', file): file = re.sub(r'[^/]*/\.\./', '', file) # zap /../ file = re.sub(r'/[^/]*/\.\.$', '', file) # and /.. at end if TopDir: # check against escape from TopDir if file.find(TopDir) > -1: dir = TopDir continue if os.path.isdir(file): # pre-existing directory ? if SelDir: return file else: dir=file if re.match('[^/]$', dir): dir += '/' continue #$file =~ m#^(.*/)([^/]+)$#; dirname = os.path.dirname(file) basename = os.path.basename(file) if os.path.exists(file): continue # must check for createbility (e.g. dir exists and is writeable) if os.path.isdir(dirname) and _is_writeable(dirname): return file if not _is_writeable(dirname): sorry ("directory "+dirname+" does not exist.") continue sorry ("directory "+dirname+" is not writeable.") continue if not new: return None if (new == './') and SelDir: return dir if re.match('^/', new): file = new # abs filename else: file = dir+new # rel filename (slash always at end) if (new == '../'): dir = re.sub('[^/]+/?$', '', dir) back_up() continue elif new == './': if SelDir: return dir file = dir elif re.search('/$', file): dir = file back_up() continue elif os.path.isfile(file): return file Term-Clui-1.70/py/test_script0000755000076400017510000002004511367734047013621 0ustar pjb#! /usr/bin/python3 ######################################################################### # This Python script is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Python itself. # ######################################################################### from TermClui import * import sys # import TermClui::FileSelect colour = "" paint = "" name = "" text = "" def main(): while True: task = choose('Test which TermClui.py function ?', ['ask','choose','confirm','edit','view','select_file'] ); if not task: sys.exit() eval('test_'+task+'()') def test_choose(): colours = ['Red','Orange','Black','Grey','Blue'] paints = [ 'Bizzare extremely long name that certainly will never occur on any real artist pallette', 'Alizarin Crimson', 'Burnt Sienna', 'Cadmium Yellow', 'Cobalt Blue', 'Flake White', 'Indian Red', 'Indian Yellow', 'Ivory Black', 'Lemon Yellow', 'Naples Yellow', 'Prussian Blue', 'Raw Sienna', 'Raw Umber', 'Red Ochre', 'Rose Madder', 'Ultramarine Blue', 'Vandyke Brown', 'Viridian Green', 'Yellow Ochre' ] scientists = [ 'Luis Alvarez', 'Alain Aspect', 'Michael Barnsley', 'Johann Bernouilli', 'Nicolas Bernouilli', 'Friedrich Wilhelm Bessel', 'John Bell', 'Antoine Becquerel', 'Hans Bethe', 'David Bohm', 'Niels Bohr', 'Ludwig Boltzmann', 'Hermann Bondi', 'George Boole', 'Max Born', 'Satyendra Bose', 'Robert Boyle', 'Léon Brillouin', 'Eugenio Calabi', 'Georg Cantor', 'James Chadwick', 'Gregory Chaitin', 'Subrahmanyan Chandrasekar', 'Geoffrey Chew', 'Alonzo Church', 'John Horton Conway', 'Francis Crick', 'Marie Curie', 'Charles Darwin', 'Humphrey Davy', 'Richard Dawkins', 'Louis de Broglie', 'Max Delbrück', 'René Descartes', 'Willem de Sitter', 'Bruce DeWitt', 'Paul Dirac', 'Freeman Dyson', 'Arthur Stanley Eddington', 'Albert Einstein', 'Leonhard Euler', 'Hugh Everett', 'Michael Faraday', 'Pierre Fatou', 'Mitchell Feigenbaum', 'Pierre de Fermat', 'Enrico Fermi', 'Richard Feynman', 'Joseph Fraunhofer', 'Galileo Galilei', 'Evariste Galois', 'George Gamov', 'Carl Friedrich Gauss', 'Murray Gell-Mann', 'Kurt Gödel', 'Alan Guth', 'Stephen Hawking', 'Felix Hausdorff', 'Werner Heisenberg', 'Charles Hermite', 'Peter Higgs', 'David Hilbert', 'Fred Hoyle', 'Edwin Hubble', 'Christian Huygens', 'David Hilbert', 'Edwin Hubble', 'Pascual Jordan', 'Gaston Julia', 'Marc Kac', 'Theodor Kaluza', 'Stuart Kauffman', 'William Lord Kelvin', 'Gustav Robert Kirchhoff', 'Oskar Klein', 'Helge von Kock', 'Willis Lamb', 'Lev Davidovich Landau', 'Paul Langevin', 'Pierre Simon de Laplace', 'Gottfried Wilhelm Leibnitz', 'Paul Lévy', 'Hendrik Lorentz', 'James Clark Maxwell', 'Marston Morse', 'Benoit Mandelbrot', 'Gregor Mendel', 'Dmitri Mendeleev', 'Robert Millikan', 'Hermann Minkowski', 'John von Neumann', 'Isaac Newton', 'Emmy Noether', 'Hans Christian Oersted', 'Lars Onsager', 'Robert Oppenheimer', 'Abraham Pais', 'Heinz Pagels', 'Vilfredo Pareto', 'Louis Pasteur', 'Wolfgang Pauli', 'Linus Pauling', 'Guiseppe Peano', 'Rudolf Peierls', 'Roger Penrose', 'Arno Penzias', 'Jean Perrin', 'Max Planck', 'Boris Podolsky', 'Henri Poincaré', 'Isidor Rabi', 'Srinivasa Ramanujan', 'Lord Rayleigh', 'Lewis Fry Richardson', 'B. Riemann', 'Nathan Rosen', 'Ernest Rutherford', 'Abdus Salam', 'Erwin Schrödinger', 'Karl Schwarzschild', 'Julian Schwinger', 'Claude Shannon', 'Waclaw Sierpinski', 'Leo Szilard', 'Kip Thorne', 'Alan Turning', 'Sin-itro Tomonaga', 'Stanislaw Ulam', 'James Watson', 'Karl Weierstrauss', 'Hermann Weyl', 'Steven Weinberg', 'John Wheeler', 'Charles Weiner', 'Norbert Wiener', 'Eugene Wigner', 'Robert Wilson', 'Edward Witten', 'Shing-Tung Yau', 'Chen-Ning Yang', 'Hideki Yukawa', 'George Kingsley Zipf', ] multi = choose('Mode ?', ['Single-choice', 'Multi-choice']) if not multi: return False if (multi == 'Single-choice'): paint = choose ("Your favourite paint ?\n"+help_text(''), paints) scientist = choose ("Your favourite scientist ?", scientists) multiline_question = r'''Your favourite colour ? This tests how the 'choose' subroutine handles multi-line questions. After you choose, all but the first line should disappear, leaving the question and answer on the screen as a record of the dialogue. The other lines should only get displayed if there is room. ''' colour = choose (multiline_question, colours); print('paint='+str(paint)+', scientist='+str(scientist)+', colour='+str(colour)) else: fav_paints = choose("Your favourite paints ?\n"+help_text('multi'), paints, multichoice=True); fav_scientists = choose("Your favourite scientists ?", scientists, multichoice=True); print("paints = "+', '.join(fav_paints) + "\nscientists = "+', '.join(fav_scientists)) return def test_confirm(): multiline_question = r'''OK to proceed with the test ? This step checks the 'confirm' subroutine and whether it handles a multiline question OK. After you choose Yes or No all but the first line should disappear, leaving the question and answer on the screen as a record of the dialogue. ''' if not confirm (multiline_question): return False confirm('Did the text vanish except for the 1st line ?') name = '' colour = '' paint = '' text = '' def test_ask(): global name, colour, paint multiline_question = r'''Enter a string : The point of this test is to check out the behaviour of &ask with multi-line questions; subsequent lines after the initial question should be formatted within the window width ... ''' string = ask(multiline_question+help_text('ask')) colours = ['Red','Orange','Black','Grey','Blue'] colour = choose('Your favourite colour ?', colours) if not colour: return False names = dict( Red='Fred', Orange='Solange', Black='Jack', Grey='May', Blue='Sue' ) name = ask("Choose a name which rhymes with "+colour+" :", names[colour]) print('string='+string+', name='+name) def test_edit(): global name, colour, paint, text text = r''' There was a brave soul called {0}, Whose favourite colour was {1}; But some {2} ... And that was the end of {0}. '''.format(name, colour, paint) text = edit('Your limerick', text); print('text='+text) def test_view(): global text view('Your limerick:', text or 'try testing "ask" and "edit" first :-)') def test_select_file(): bool_opts = ['Chdir','Create','ShowAll','DisableShowAll', 'SelDir','TextFile','Readable','Writeable','Executable','Owned', 'Directory'] text_opts = ('FPat','File','Path','Title','TopDir') multiple = choose('Select',['Single file','Multiple files']) if multiple == 'Multiple files': bool_opts.pop(0) bool_opts.pop(0) opts = dict() for bool_opt in bool_opts: opts[bool_opt] = choose("option "+bool_opt+" ?",['default','0','1']) if not opts[bool_opt]: return False if opts[bool_opt] == 'default': del(opts[bool_opt]) elif opts[bool_opt] == '0': opts[bool_opt] = False elif opts[bool_opt] == '1': opts[bool_opt] = True for text_opt in text_opts: opts[text_opt] = ask("option "+text_opt+" ?", opts.get(text_opt, '')); if not opts[text_opt]: del(opts[text_opt]) if multiple == 'Multiple files': # files = select_file(-Chdir=0, opts); opts['Chdir'] = False opts['multichoice'] = True files = select_file(**opts) print("You selected "+str(files), file=sys.stderr) else: # given the dict, how can I put together an arg-by-name call ? print("You selected " +str(select_file(**opts)), file=sys.stderr) main()