update Perl sample scripts

This commit is contained in:
marschap
2006-04-30 17:13:44 +00:00
parent 7494d6cfc8
commit ee6e26e934
4 changed files with 693 additions and 177 deletions
+204 -64
View File
@@ -29,6 +29,9 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
#
use 5.005;
use strict;
use Getopt::Std;
use IO::Socket;
use Fcntl;
@@ -37,38 +40,63 @@ use Fcntl;
############################################################
# Host which runs lcdproc daemon (LCDd)
$HOST = "localhost";
my $SERVER = "localhost";
# Port on which LCDd listens to requests
$PORT = "13666";
# These define the visible part of the file...
$top = 3; # How far from the end of the file should we start?
$lines = 3; # How many lines to display?
$left = 1; # Left/right scrolling position,
$width = 20; # and number of characters per line to show
my $PORT = "13666";
############################################################
# End of user configurable parts
############################################################
$slow = 1; # Should we pause after the current frame?
# These define the visible part of the file...
my $top = 3; # How far from the end of the file should we start?
my $lines = 3; # How many lines to display?
my $left = 1; # Left/right scrolling position,
my $width = 20; # and number of characters per line to show
if($#ARGV < 0)
{
print "Usage: tail.pl file\n";
exit;
my $progname = $0;
$progname =~ s#.*/(.*?)$#$1#;
# declare functions
sub error($@);
sub usage($);
## main routine ##
my %opt = ();
# get options #
if (getopts('F:s:p:hV', \%opt) == 0) {
usage(1);
}
$filename = shift @ARGV;
# check options
usage(0) if ($opt{h});
if ($opt{V}) {
print STDERR $progname ." version 1.1\n";
exit(0);
}
# check number of arguments
usage(1) if ($#ARGV != 0);
# set variables
$SERVER = defined($opt{s}) ? $opt{s} : $SERVER;
$PORT = defined($opt{p}) ? $opt{p} : $PORT;
my $filename = shift @ARGV;
my $slow = 1; # Should we pause after the current frame?
# Connect to the server...
$remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $HOST,
my $remote = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr => $SERVER,
PeerPort => $PORT,
)
|| die "Cannot connect to LCDproc port\n";
or error(1, "cannot connect to LCDd daemon at $SERVER:$PORT");
# Make sure our messages get there right away
$remote->autoflush(1);
@@ -80,15 +108,22 @@ print $remote "hello\n";
# server even if there isn't meant to be one. If you don't, you may find
# your program crashes after running for a while when the buffers fill up.
my $lcdresponse = <$remote>;
print $lcdresponse;
#print $lcdresponse;
# get width & height from server's greet message
if ($lcdresponse =~ /\bwid\s+(\d+)\b/) {
$width = 0 + $1;
}
if ($lcdresponse =~ /\bhgt\s+(\d+)\b/) {
$lines = (0 + $1) - 1;
$top = $lines;
}
# Turn off blocking mode...
fcntl($remote, F_SETFL, O_NONBLOCK);
# Set up some screen widgets...
print $remote "client_set name {Tail}\n";
print $remote "client_set name {$progname}\n";
$lcdresponse = <$remote>;
print $remote "screen_add tail\n";
$lcdresponse = <$remote>;
@@ -106,68 +141,69 @@ print $remote "widget_add tail 3 string\n";
$lcdresponse = <$remote>;
# NOTE: You have to ask LCDd to send you keys you want to handle
print $remote "client_add_key E\n";
print $remote "client_add_key Left\n";
$lcdresponse = <$remote>;
print $remote "client_add_key F\n";
print $remote "client_add_key Right\n";
$lcdresponse = <$remote>;
print $remote "client_add_key G\n";
print $remote "client_add_key Up\n";
$lcdresponse = <$remote>;
print $remote "client_add_key H\n";
print $remote "client_add_key Down\n";
$lcdresponse = <$remote>;
# Forever, we should do stuff...
while(1)
{
while (1) {
# Handle input... (spew it to the console)
# Also, certain keys scroll the display
while(defined($input = <$remote>)) {
if ( $input =~ /^success$/ ) { next; }
print $input;
while(defined(my $input = <$remote>)) {
next if ($input =~ /^success$/o);
#print $input;
$slow = -10;
# Make sure we handle each line...
@lines = split(/\n/, $input);
foreach $line (@lines)
{
if($line =~ /^key (\S)/) # Keypresses are useful.
{
$key = $1;
if($key eq "G") { $top++; }
if($key eq "H")
{
if($top > $lines) {$top--; }
my @lines = split(/\n/, $input);
foreach my $line (@lines) {
if ($line =~ /^key (\S+)/) { # Keypresses are useful.
my $key = $1;
if ($key eq 'Down') {
$top++;
}
if($key eq "F") { $left++; }
if($key eq "E")
{
if($left > 1) {$left--; }
elsif ($key eq 'Up') {
$top-- if ($top > $lines);
}
elsif ($key eq 'Right') {
$left++;
}
elsif ($key eq 'Left') {
$left-- if ($left > 1);
}
}
}
}
# Now, show what the file contains, if anything...
if( -f $filename )
{
if ( -f $filename ) {
# Grab some text.
$right = $left + $width - 1;
$text = `tail -$top $filename | head -$lines | cut -c$left-$right`;
@lines = split(/\n/, $text);
my $right = $left + $width - 1;
my $text = `tail -$top $filename | head -$lines | cut -c$left-$right`;
my @lines = split(/\n/, $text);
# Now, display that text...
for($i=0; $i<$lines; $i++)
{
$j = $i + 1;
$k = $i + 2;
if($#lines < $i) { $line = " "; } # Avoid blank lines
else { $line = $lines[$i]; }
if(!($line =~ /\S/)) { $line = " ";}
print $remote "widget_set tail $j 1 $k {$line }\n";
for (my $i = 0; $i < $lines; $i++) {
my $j = $i + 1;
my $k = $i + 2;
# Avoid blank lines
my $line = ($#lines < $i) ? " " : $lines[$i];
$line = " " if ($line =~ /^\s*$/o);
print $remote "widget_set tail $j 1 $k {$line}\n";
my $lcdresponse = <$remote>;
}
}
else # If the file is unreadable, show an error
{
else { # If the file is unreadable, show an error
print $remote "widget_set tail 1 1 2 {$filename}\n";
$lcdresponse = <$remote>;
print $remote "widget_set tail 2 1 3 {doesn't exist.}\n";
@@ -177,14 +213,118 @@ while(1)
}
# And wait a little while before we show stuff again.
if($slow > 0) {sleep 1; $slow++;}
elsif($slow > 4) {sleep 2; $slow++;}
elsif($slow > 64) {sleep 4; }
else {$slow++;}
if ($slow > 0) { sleep 1; $slow++; }
elsif ($slow > 4) { sleep 2; $slow++; }
elsif ($slow > 64) { sleep 4; }
else { $slow++; }
# The "slow" thing just lets us have a better response time
# while the user is pressing keys... But while the user
# is inactive, it gradually decreases update frequency.
}
close ($remote) || die "close: $!";
close ($remote) or error(1, "close() failed");
exit;
## print out error message and eventually exit ##
# Synopsis: error($status, $message)
sub error($@)
{
my $status = shift;
my @msg = @_;
print STDERR $progname . ": " . join(" ", @msg) . "\n";
exit($status) if ($status);
}
## print out usage message and exit ##
# Synopsis: usage($status)
sub usage($)
{
my $status = shift;
print STDERR "Usage: $progname [<options>] <file>\n";
if (!$status) {
print STDERR " where <options> are\n" .
" -s <server> connect to <server> (default: $SERVER)\n" .
" -p <port> connect to <port> on <server> (default: $PORT)\n" .
" -h show this help page\n" .
" -V display version number\n";
}
else {
print STDERR "For help, type: $progname -h\n";
}
exit($status);
}
__END__
=pod
=head1 NAME
tail.pl -- show tail of a file on LCD
=head1 SYNOPSIS
B<tail.pl>
[B<-s> I<server>]
[B<-p> I<port>]
[B<-h>]
[B<-V>]
=head1 DESCRIPTION
B<tail.pl> is a small example client for LCDd, the lcdproc server.
It shows the tail of th file given as parameter on the LCD.
If the LCD supports keys you can use the keys mapped to C<Up>, C<Down>,
C<Left> and C<Right> to scroll the contents shown on the screen.
=head1 OPTIONS
=over 4
=item B<-s> I<server>
Connect to the LCDd daemon at host I<server> instead of the default C<localhost>.
=item B<-p> I<port>
Use port I<port> when connecting to the LCDd server instead of the default
LCDd port C<13666>.
=item B<-h>
Display a short help page and exit.
=item B<-V>
Display tail.pl's version number and exit.
=back
=head1 SEE ALSO
L<tail(1)>,
L<LCDd(8)>
=head1 AUTHORS
tail.pl was written by various members of the LCDproc project team;
this manual page was written by Peter Marschall.
=cut
# EOF