client for radio.linux.org.au

To: debian-hams@lists.debian.org
Subject: client for radio.linux.org.au
From: Joop Stakenborg <aba@casema.net>
Date: Wed, 27 Oct 1999 09:33:14 +0200
Message-id: <[🔎] 19991027093314.A8202@casema.net>

Here is something for you guys to try out: a client for radio.linux.org.au.
On startup the program connects to the linux hamsoft database and
shows the latest entries. When you click on an entry and click on the
'read' button, it will open the new entry in a netscape window.
Netscape has to be running in order to do this.

The applications has been built on a potato (unstable) system, with
libgtk1.2 (version 1.2.6-1) and libgtk-perl (version 0.6123-1),
but will probably work with older libraries.

So, you have to install libgtk-perl. 

Please send comments to me or the mailing list.
If you find it useful, I will announce it on linux-hams.

Thanks,

Joop
--

 Joop Stakenborg PA4TU, ex-PA3ABA 
      <pa3aba@debian.org>
 Linux Amateur Radio Software Database
    http://radio.linux.org.au

#!/usr/bin/perl -w

# This is hamsoft, version 0.1, Oct 25, 1999

# Copyright (c) 1999 Joop Stakenborg <pa4tu@amsat.org>
# This code is distributed under the terms of the GNU General Public License.

# This is a hacked up script from Alex Shnitman <alexsh@linux.org.il>, who
# wrote 'slashes.pl' for reading slashdot news, I fixed a couple of things
# and wrote support for the hamsoft db.

# Hamsoft is a reader for new hamradio software packages at radio.linux.org.au.
# When you select an entry in the list and click on read, the entry
# will be opened in a netscape window. Netscape has to be running already!!
# If you leave the program idle, it will refresh every 'REFRESH_TIMEOUT'
# seconds. This can be set below.

use Gtk;
init Gtk;
use Socket;
use IO::Handle;
use strict;

# You can tell the script to use a proxy. If $PROXY is empty it
# will not use one. By default the script takes the value of the
# http_proxy environment variable (suggested by ERDI 'Cactus' Gergo),
# so if there isn't one no proxy will be used.
my $PROXY = "";
my $PROXYPORT = 0;
if($ENV{http_proxy}) {
  $ENV{http_proxy} =~ m$http://(.*?):(.*?)/$;
  $PROXY = $1;
  $PROXYPORT = $2;
}

# Number of seconds before a refresh is performed.
my $REFRESH_TIMEOUT = 3600;

# Path to Netscape executable
my $BROWSER_CMD = "/usr/X11R6/bin/netscape -remote 'OpenURL(##, new_window)'";

############ End of configuration

# $clist and $status hold the references to the Gtk CList holding the
# articles, and the status line which is actually a label. @articles
# holds the URLs of the articles.
my($clist, $status, @articles);

sub MainWindow {
    my $mainwin = new Gtk::Window;
    $mainwin->set_title("Linux Hamsoft Database Client");
    $mainwin->signal_connect("destroy", \&Gtk::main_quit);
    $mainwin->signal_connect("delete_event", \&Gtk::false);
    $mainwin->set_usize(600,200);
    $mainwin->set_policy(1,1,1);
    

    # vertical box with scrolled window and clist
    my $scrolled_win = new Gtk::ScrolledWindow(undef, undef);
    $scrolled_win->set_policy('automatic', 'automatic');
    my $vbox = new Gtk::VBox(0,5);
    $vbox->border_width(5);
    $clist = new_with_titles Gtk::CList("Link", "Title", "Version", "Date");
    $clist->column_titles_passive;
    $clist->set_selection_mode("browse");
    $clist->set_column_width(0, 300);
    $clist->set_column_width(1, 80);
    $clist->set_column_width(2, 80);
    $clist->set_column_width(3, 80);
    $clist->signal_connect("button_press_event", 
      sub {
          my $event = $_[1];
          if ($event->{button} == 2) { 
            $event->{button} = 1;
            Gtk::Gdk::event_put($clist, $event);
          }
          return 1;
    });
    $clist->signal_connect("button_release_event", 
      sub {
          my $event = $_[1];
          my $button = $event->{button};
          my $x = $event->{"x"};
          my $y = $event->{"y"};
          my ($r, $c) = $clist->get_selection_info($x, $y);
          if ($button == 2 && defined $r && defined $c && $r!=-1 && $c!=-1) {
            $clist->select_row($r, $c);
            &Browse($articles[$clist->selection]);
          }
          return 1;
    });
    $scrolled_win->add($clist);
    $vbox->pack_start($scrolled_win, 1, 1, 0);
    $clist->show;
    $scrolled_win->show;
    $mainwin->add($vbox);
    $vbox->show;
    
    # horixontal box with 3 buttons
    my $hbox = new Gtk::HBox(0,0); 
    my $but;
    $but = new_with_label Gtk::Button("  Refresh  ");
    $but->signal_connect("clicked", \&Refresh);
    $hbox->pack_start($but, 0,0,0);
    $but->show;
    $but = new_with_label Gtk::Button("  Read  ");
    $but->signal_connect("clicked", 
      sub {
          return unless(defined $clist->selection);
          &Browse($articles[$clist->selection]);
    });
    $hbox->pack_start($but, 0,0,0);
    $but->show;
    $status = new Gtk::Label("Refreshing...");
    $hbox->pack_start($status, 0,0,10);
    $status->show;
    $but = new_with_label Gtk::Button("  Quit  ");
    $but->signal_connect("clicked", \&Gtk::main_quit);
    $hbox->pack_end($but, 0,0,0);
    $but->show;
    $vbox->pack_start($hbox, 0,0,0);
    $hbox->show;

    # Add a timeout to refresh the list automatically.
    Gtk->timeout_add(1000*$REFRESH_TIMEOUT, \&Refresh, undef);
    
    $mainwin->show;
}

sub Browse {
    my($url) = @_;
    $url =~ s/\.shtml$/_F.shtml/;
    my $cmd = $BROWSER_CMD;
    $cmd =~ s/\#\#/$url/;
    system($cmd);
    $status->set("Sent URL to the browser");
    # If I don't return 1 explicitly then timeout_add won't reschedule
    # the event again.
    return 1;
}
    

sub Refresh {
    my($iaddr, $proto, $port, $paddr, $url);

    if($PROXY) {
      $iaddr = gethostbyname($PROXY);
      $port = $PROXYPORT;
      $url = "http://radio.linux.org.au/recent.phtml";;
    } 
      else {
      $iaddr = gethostbyname("radio.linux.org.au");
      $port = 80;
      $url = "/recent.phtml";
      }

    $proto = getprotobyname("tcp");
    $paddr = sockaddr_in($port, $iaddr);
    $status->set("Connecting to radio.linux.org.au...");  # this actually
						          # won't show...
    socket(RADIO, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
    connect(RADIO, $paddr) or die "connect: $!";
    autoflush RADIO 1;
    print RADIO "GET $url HTTP/1.0\r\nHost: radio.linux.org.au\r\nUser-Agent: Hamsoft-Client/0.1\r\n\r\n";         # Do not break up this string
    $status->set("Connected; waiting for reply...");

    # Skip HTTP header
    local $/ = "\r\n\r\n";
    my $http_header = <RADIO>;
    my @http_headerlist = split(/\r\n/, $http_header);
    my $http_status = shift @http_headerlist;
    my($httpver, $nstatus, $vstatus) = ($http_status =~ /(.*?) (.*?) (.*)/);
    if ($nstatus !~ /^2/) {
      $status->set("HTTP error $nstatus: $vstatus");
      return;
    }
    $status->set("Data arriving...");
    $clist->clear;
    undef @articles;
    # Get text data
    local $/ = "\n";
    foreach (<RADIO>) {
      my($link, $title, $version, $date) = split(/\t/);
      if ($link !~ /\n/) {          # just in case of empty lines
        $clist->append($link, $title, $version, $date);
        push(@articles, $link);
      }
    }
    close RADIO;
    $status->set("New software entries retrieved ".(localtime));
}

&MainWindow;
&Refresh;
main Gtk;

Reply to:

Follow-Ups:
- Re: client for radio.linux.org.au
  - From: Hamish Moffatt <hamish@debian.org>

Prev by Date: Intend to package "node", and amateur radio application.
Next by Date: Re: client for radio.linux.org.au
Previous by thread: Intend to package "node", and amateur radio application.
Next by thread: Re: client for radio.linux.org.au
Index(es):
- Date
- Thread