update Perl sample scripts
This commit is contained in:
+204
-64
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user