Tie: Creating Special Objects

By using tie, we can create some really neat objects-- you can hide a complex object behind a simple scalar variable, which makes for some pretty nifty tricks.

Introduction

Here's a fun use of tie. It lets you tie a variable to your system's uptime command; it parses uptime's output and stores the results in a nice little object that you can use.

What's neat about this is that, on each access to your scalar variable (or rather, to the scalar variable's methods), the data fields are automatically updated by the magic of tie. We don't want to slow down our application too much, though, so we'll put in a cache so that we only update our uptime values if it's been more than 5 seconds since we last looked at the output.

Users of our class, then, have it easy: they can just do something like this to use the class: 

    use Sys::uptime;
    my $uptime;
    tie $uptime, 'Sys::uptime';

    printf "Load average over the last minute: %s\n",
        $uptime->load('one');

[download]
So let's start on our implementation.

Starting Out

We'll start by declaring our class. We'll call it Sys::uptime, since that seems like a relatively fitting name. We're going to base our underlying object on Class::Struct, so we pull that in, as well. Then we pull in Carp and strict for errors and error checking, respectively.

    package Sys::uptime;
    use Class::Struct;
    use Carp;
    use strict;

[download]
Next we need some way to know whether we should update our uptime cache. The $WAIT_CACHE variable will be the number of seconds to wait before we run uptime again. 
    my $WAIT_CACHE = 5;

[download]
As mentioned above, we're going to be using a Class::Struct object to hold the data that we parse out of uptime. Class::Struct is a neat class; you give it some class specifications (the data fields that you'll be storing, and their data types), and it creates a class for you.

We need four fields: uptime, where we'll store the "up X days, Y min" string; users, where we'll store the number of users currently logged in; load, a hash where we'll store the load averages from the last one, five, and fifteen minutes (as given to us by uptime); and as_string, the uptime output (just in case we want it). 

    struct 'Uptime' => [
        'uptime'    => '$',
        'users'     => '$',
        'load'      => '%',
        'as_string' => '$',
    ];

[download]

The Special Tie Methods

Now that we've set everything up, we can move on to creating the class into which we'll tie our scalar.

To create a tied object, you need to define several special methods (documented extensively in perltie). The routines used for tying scalars are TIESCALAR (called when you use the tie function), FETCH (called when you try to fetch something from your scalar), STORE (called when you store something in the scalar), and DESTROY (called when your object is to be destroyed). We don't need STORE, because uptime is read-only; and we don't need to worry about DESTROY, either (because we don't have any memory to deallocate, any circular references to dispose of, etc.).

So let's define our TIESCALAR routine. It takes a class name into which we're going to bless our tied object. We'll create an anonymous hash where we'll place a new Uptime object (as defined above), and a last_update field; we'll update this with the time function every time we update our uptime cache. Then we can check against this value to see if we need to update the cache again.

So we create $self, bless $self into $class (our tie class), then return $self; $self is a reference, so it's a scalar. So we're fine. 

    sub TIESCALAR {
        my $class = shift;
        my $self = {
            up          => new Uptime,
            last_update => 0
        };
        bless $self, $class;
        $self;
    }

[download]
Now we need to define the FETCH function. This will be called every time the user uses the scalar object, so this is quite important: on each access, we need to check if we should update the cache; if we need to, we update it and the last_update time. get_uptime parses the uptime output and returns to us the relevant pieces of information (relevant to us, at least :); then we simply use the accessor methods of the Uptime object to update our data.

First, though, we need to take care of something important. This is an interesting tied scalar, because it's a scalar holding a bunch of other stuff inside of it--an Uptime object, for instance. FETCH needs to return a value: but what should it return?

Well, we wrote above how we wanted users of our class to use it. For example, they could write: 

    printf "Load average over the last minute: %s\n",
        $uptime->load('one');

[download]
This makes it look like "load" is a method of our tied scalar--but it's not. It's a method of our Uptime object (it was created automatically for us by Class::Struct). So our FETCH routine needs to return our Uptime object so that we can then invoke the "load" method (in this example) on that object.

So we'll return the Uptime object ($self->{up}) from our FETCH method. 

    sub FETCH {
        my $self = shift;
        if (time - $self->{last_update} > $WAIT_CACHE) {
            $self->{last_update} = time;
            my($str, $upt, $users, $one, $five, $fifteen) =
                get_uptime();

            my $up = $self->{up};
            $up->as_string($str);
            $up->uptime($upt);
            $up->users($users);
            $up->load('one', $one);
            $up->load('five', $five);
            $up->load('fifteen', $fifteen);
        }
        return $self->{up};
    }

[download]

Parsing Uptime Output

So we're done with our special tie methods. Now we just need to write the function to get and parse the uptime output. This basically entails crafting a regular expression to find the relevant bits of information and extract them.

We'll make this function general--in particular, we won't make it a method of our tied class, because that would make it less easily reusable in the future, if need be. It should have one simple purpose: to parse the output of uptime and return the information we need.

And it does so, using the regular expression documented in the code.

NOTE:: regex updated on April 27, 2001, courtesy of Alistair Mills. 

    sub get_uptime {
        local $_ = `uptime`;
        chomp;
        if (/^\s+\S+\s+                   # opening cruft
            up\s+(.+?(,)?.+?),             # uptime
            \s+(\d+)\s+users?,          # number of users
            \s+load\s+averages?:\s+     # load average...
            (.+?),\s+(.+?),\s+(.+?)\s*  # ...and values
            $/x) {
            return($_, $1, $2, $3, $4, $5);
        }
        else {
            croak "What was that? Bad uptime.";
        }
    }

[download]
And that's it! We've completed our tie class, and now all that's left is to figure out how we can use it.

The Whole Thing

Here's the whole thing all at once, just so you don't have to paste bits and pieces out: 
    package Sys::uptime;
    use Class::Struct;
    use Carp;
    use strict;

    my $WAIT_CACHE = 5;

    struct 'Uptime' => [
        'uptime'    => '$',
        'users'     => '$',
        'load'      => '%',
        'as_string' => '$',
    ];

    sub TIESCALAR {
        my $class = shift;
        my $self = {
            up          => new Uptime,
            last_update => 0
        };
        bless $self, $class;
        $self;
    }

    sub FETCH {
        my $self = shift;
        if (time - $self->{last_update} > $WAIT_CACHE) {
            $self->{last_update} = time;
            my($str, $upt, $users, $one, $five, $fifteen) =
                get_uptime();

            my $up = $self->{up};
            $up->as_string($str);
            $up->uptime($upt);
            $up->users($users);
            $up->load('one', $one);
            $up->load('five', $five);
            $up->load('fifteen', $fifteen);
        }
        return $self->{up};
    }

    sub get_uptime {
        local $_ = `uptime`;
        chomp;
        if (/^\s+\S+\s+                   # opening cruft
            up\s+(.+?,?.+?),             # uptime
            \s+(\d+)\s+users?,          # number of users
            \s+load\s+averages?:\s+     # load average...
            (.+?),\s+(.+?),\s+(.+?)\s*  # ...and values
            $/x) {
            return($_, $1, $2, $3, $4, $5);
        }
        else {
            croak "What was that? Bad uptime.";
        }
    }

    1;

[download]

A Sample Program

Here's a small sample program that dumps out the information given to us (and updated) by our Sys::uptime class. 
    use Sys::uptime;

    my $uptime;
    tie $uptime, 'Sys::uptime';

    while (1) {
        print $uptime->uptime, "\n";
        print $uptime->users, "\n";
        print $uptime->load('one'), "\n";
        print $uptime->load('five'), "\n";
        print $uptime->load('fifteen'), "\n";
        print $uptime->as_string, "\n";

        sleep 3;
    }

[download]

POSSIBLE CAVEATS

It's possible that your uptime output differs slightly from mine. The regular expression used to parse it isn't extremely robust, so it may not parse correctly, which will give you an error message. If so, post the output of your uptime command in response to this, and I'll update the regexp until everyone's happy, if possible. :)

SEE ALSO

You should definitely take a look at perltie, which has some other great examples of using tie.

Update 7.6.2001: thanks to blueflashlight for pointing out the incorrect FETCH method in the section where I had the entire module all together (rather than in pieces). I was assigning to five,ten,fifteen rather than one,five,fifteen.

Replies are listed 'Best First'.
Re: Tie: Creating Special Objects
by blueflashlight (Pilgrim) on Jul 07, 2001 at 07:42 UTC
    Excellent tutorial! The only problem is that I've gotten errors from the regex on three different unixes. I've quadruple-checked my syntax, so i don't think it's that.

    the program I'm using with the the module is ...

    #!/usr/bin/perl -w

use strict;
use lib(".");
use Uptime;

$|++;

my $uptime;

tie $uptime, 'Uptime';

printf("%20s%-20s\n", "uptime:\t",   $uptime->uptime);
printf("%20s%-20s\n", "users:\t",    $uptime->users);
printf("%20s%-20s\n", "load(1):\t",  $uptime->load('one'));
printf("%20s%-20s\n", "load(5):\t",  $uptime->load('five'));
printf("%20s%-20s\n", "load(15):\t", $uptime->load('fifteen'));
printf("%20s%-20s\n", "string:\t",   $uptime->as_string);

    [download]


    ... and the output I get on an AIX system, a Solaris system, and a Darwin system, is ...

    ./dumpuptime.pl 
            uptime:     21 days,   8:02     
Use of uninitialized value in printf at ./dumpuptime.pl line 14.
             users:                         
           load(1):     1                   
           load(5):     0.04                
          load(15):     0.03                
            string:      20:39pm  up 21 days,   8:02,  1 users,  load 
+average:  0.04, 0.03, 0.04

    [download]


    Do I have something wrong, or is the regex in the tutoral off? Thanks, -s-
[reply]
[d/l]
[select]
      I think there are two problems here, both mine. The first is that the regex is slightly wrong. I have now updated it (it was capturing when it should not have been). The second problem is that I named the fields in the Uptime struct incorrectly. They should be one, five, and fifteen, as you have them, but I named them five, ten, and fifteen. This incorrect naming was only in the section where the entire module was presented (not where it was in bits and pieces amidst explanation).

      Thanks for alerting me to these. :)

[reply]
        thank *you*... the update works great, and the whole tutorial was very informative.
[reply]

Back to Tutorials