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:
So let's start on our implementation.use Sys::uptime; my $uptime; tie $uptime, 'Sys::uptime'; printf "Load average over the last minute: %s\n", $uptime->load('one');
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.package Sys::uptime; use Class::Struct; use Carp; use strict;
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.my $WAIT_CACHE = 5;
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' => '$', ];
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.
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.sub TIESCALAR { my $class = shift; my $self = { up => new Uptime, last_update => 0 }; bless $self, $class; $self; }
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:
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.printf "Load average over the last minute: %s\n", $uptime->load('one');
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}; }
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.
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.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."; } }
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;
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; }
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 | |
by btrott (Parson) on Jul 07, 2001 at 10:29 UTC | |
by blueflashlight (Pilgrim) on Jul 08, 2001 at 19:14 UTC |