The 2004 Perl Advent Calendar
[about] | [archives] | [contact] | [home]

On the 21st day of Advent my True Language brought to me..
Sys::Hostname
[next]

Many of the modules I've talked about in the advent calendar are about doing quite complex things in Perl. They're about creating objects, creating we pages and managing databases, or even writing full blown applications. Let us not forget that Perl is used extensively for system administration tasks too. It's not the most glamorous of roles - being the duct tape that holds your system together - but it is a vitally important one.

If like me you carry a bunch of configuration files around with you between computers, you'll often find yourself inserting big chunks of Perl code in your .bashrc (or other shell config) or .emacs file (or other editor config) to do complex stuff. Often in these cases you'll want to do subtly different things depending on what host you're on. This is where Sys::Hostname comes in. With it you can determine what host you're on (no matter how weird the system you're running on) and then take the right steps

Sys::Hostname is really easy to use:

  use Sys::Hostname;
  print hostname(), "\n";

On my Mac Powerbook this prints the name of the bad guy from Blake's 7 that it's named after.

  travis

On the perladvent.org Linux server the very same code prints out the name of the gentle giant from the same series that it's named after:

   gan

The actual complexities of what's required to work out the hostname on the various systems that Perl can run on (the manual states it tries gethostname(), `$Config{aphostname}`, uname, syscall(SYS_gethostname), `hostname`, `uname -n`, and the file /com/host.

Using this in config files

I have bound to a key in emacs a command that pops open a terminal in the directory I'm currently editing in. On my Mac the code that we place in the .emacs configuration directory is very familiar.

  (defun terminal-here ()
   "load a terminal"
   (interactive)
   (call-process "perl" nil t nil "-e" "
 
     # get the terminal
     use Mac::Glue;
     my $term = Mac::Glue->new('Terminal');
     # work out where we're going
     use String::ShellQuote;
     my $path = shell_quote($ARGV[0]);
     # go there
     $term->do_script(qq{cd $path; clear});
     $term->activate;
 
  "
   (file-name-directory (buffer-file-name))
  ))
  (global-set-key [?\A-t] 'terminal-here)  ; command-T = terminal

When the user hits command-T we shell out to Perl and use the by now familiar Mac::Glue to open a new terminal window in the correct place for us. The problem with this is that this won't work at all well on the remote server - there's no copy of Terminal running on that machine, it's a Linux box. We need to open a xterm in the correct place instead. The command for that is

   xterm -e 'cd /my/path && exec bash'

We can thus modify the above script to detect that we're on gan and fire a different command:

  (defun terminal-here ()
   "load a terminal"
   (interactive)
   (call-process "perl" nil t nil "-e" "
     # work out where we're going
     use String::ShellQuote;
     my $path = shell_quote($ARGV[0]);
     # if we're on gan, run the xterm in the background instead
     use Sys::Hostname;
     if (hostname eq 'gan')
     {
        use Proc::Daemon;
        Proc::Daemon::Init;
        exec(qq{xterm -e 'cd $path && exec bash'});
     }
 
     # on one of my mac clients, use Terminal.app
     # get the terminal
     use Mac::Glue;
     my $term = Mac::Glue->new('Terminal');
     # go there
     $term->do_script(qq{cd $path; clear});
     $term->activate;
 
  "
   (file-name-directory (buffer-file-name))
  ))
  (global-set-key [?\A-t] 'terminal-here)  ; command-T = terminal

If we realise we're running on gan we fork into the background using Proc::Daemon and then execute the xterm with the exec command instead of running the Mac::Glue code. Because the exec command replaces the perl process with the loaded xterm completely the exec command never returns and the code below it is never executed.

I can now have one .emacs file that runs on all my machines. This means that I can check it into subversion and I only have to worry about maintaining one file, rather than propagating changes between the different files I have on the different machines - I can do it all with svn up.

Testing modules more on my machine

One of the other uses for using Sys::Hostname is writing extra tests for your code that are only run on your local machine. For example, the Test::DatabaseRow test suite can't run all the tests it has on the user's machine because it makes use of the quite extensive mysql database I have on my local computer that doesn't ship with the module and no other user has. A similar situation that often crops up is that I need a vast collection of modules (including my own closed source modules that might not be on CPAN) to test properly and I can't expect someone who's installing my module to have installed them all.

This problem can be addressed by making the test skip on all machines that aren't my own. I implement this as a simple hostname check at the top of my script that prints out the skip message and ends if I'm not on the right machine.

  #!/usr/bin/perl -w
  # turn on the safety features
  use strict;
  # check that this is running on my laptop and nowhere else
  BEGIN
  {
    my $skiptext = "1..0 # Skipped: these tests run on authors pc only\n";
    eval
    {
      # check the hostname is right
      require Sys::Hostname;
      Sys::Hostname->import;
      unless (hostname() eq "uk-wrk-0017")
      {
        print $skiptext;
        exit;
      }
      # even if that's the same, better check I'm in /etc/passwd
      # open it read only to be on the safe side!
      require Tie::File;
      require Fcntl;
      tie my @array, 'Tie::File', "/etc/passwd", mode => Fcntl::O_RDONLY(),
        or die "Can't open file!: $!";
      unless (grep { /Mark Fowler/ } @array)
      {
        print $skiptext;
        exit;
      }
    };
    # problems loading any of those modules?  Not my machine.
    if ($@)
    {
      print $skiptext;
      exit;
    }
  }
  use Test::More tests => 9;
  # the rest of the tests

Because the whole code is running in a BEGIN block all the code is executed before an of the rest of the code below it is even parsed. This means even things like use SomeObscureModule down the bottom of the code (where the obscure module is only installed on my machine) won't cause it to fail, as for anyone else by the time that line is parsed the script will have exited like so:

  bash$ perl -Ilib t/04local.t 
  1..0 # Skipped: these tests run on authors pc only

If you run this script under Test::Harness with make test or build test then the harness will recognise this valid skip and note it duely:

  t/00myfakedbi....ok                                                          
  t/01basic........ok                                                          
  t/02throws.......ok                                                          
  t/03tests........ok                                                          
  t/04local........skipped
          all skipped: these tests run on authors pc only
  t/05warn.........skipped
          all skipped: no Test::Warn
  t/06multiple.....ok                                                          
  t/07results......ok                                                          
  t/08utf8.........ok               

  • GNU Emacs Lisp Manual
  • Proc::Daemon
  • Mac::Glue
  • Test::Harness