Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Magic Status Variable

by particle (Vicar)
on Mar 01, 2002 at 23:56 UTC ( #148730=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info /msg particle
Description: MagicStatus.pm allows you to tie a scalar variable that will warn when it is assigned a value you wish to watch. One use might be to track and debug the return status from a function.

since it's taking more than a month for me to get my CPAN id, i'll post here first. all comments are welcome.

Update: added rjray's suggestions, released as Revision 1.1

Update: added abaxaba's suggestion (silly me, i should have caught that!)

package MagicStatus;
require 5.6.0;
use Tie::Scalar;
our @ISA = qw( Tie::Scalar );
(our $Version) = '$Revision: 1.2 $' =~ /([\d.]+)/;

sub mywarn {warn @_};

sub TIESCALAR 
{
    my $class   = shift;
    my $watch   = $_[0] || undef;
    my $val     = $_[1] || '';
    my $method  = $_[2] || \&mywarn;
    my $message = $_[3] || undef;
    my $self = { 
        WATCH   => $watch, 
        VAL     => $val, 
        METHOD  => $method, 
        MESSAGE => $message,
    };
    return bless $self, $class;
}

sub FETCH { shift->{VAL} }

sub STORE 
{
    my $self   = shift;
    $self->{VAL} = shift;
    my $value = defined $self->{WATCH} ? $self->{WATCH} : 'undef' ;
    my $message;
    if( defined $self->{MESSAGE} ) 
    { 
        $message = $self->{MESSAGE} 
    }
    else
    {
        $message = "MagicStatus(" . $value . ") at ". 
            (caller)[1] . ", " . 
            (caller)[0] . ", " . 
            (caller)[2] . "\n";
    }
    defined $self->{WATCH} 
        ? $self->{VAL} eq $self->{WATCH} 
            && do{ &{ $self->{METHOD} }($message) }
        : defined $self->{VAL} 
            || do{ &{ $self->{METHOD} }($message) }
    ;
}

1;
__END__

=head1 NAME

MagicStatus - Scalar variable that B<warn>s on a specified value

=head1 SYNOPSIS

  use MagicStatus;

  my $oops = sub { print "oops!\n"; warn shift };

  tie my $status, 'MagicStatus', undef, 0, $oops, "look what i found!\
+n";
  # value to watch for is set to undef, 
  # initial value is set to 0, 
  # method is set to $oops
  # message is set to "look what i found!\n"

  $status = 1; 
  # status is now 1

  $status = system($command, @args);
  # status contains the return code from $comand

  $status = undef; 
  # warns with "oops!\nlook what i found!\n"

  $status = 'magic!';
  # status is now 'magic!'

=head1 DESCRIPTION

This module allows you to tie a scalar variable that will B<warn> when
+ it is assigned a value you wish to watch. One use might be to track 
+and debug the return status from a function.

=over 4

=item C<WATCH>

Use the WATCH hash key to specify the value to watch for. If the varia
+ble is set to this value, the METHOD coderef is called. If no value i
+s specified for the WATCH key, it defaults to I<undef>.

=item C<VAL>

Use the VAL hash key to specify the initial value for the scalar varia
+ble. If no initial value is set, it defaults to I<''>. 

=item C<METHOD>

Use the METHOD hash key to specify a coderef to call if the WATCH valu
+e is encountered. If no value for the METHOD key is set, it defaults 
+to B<\&mywarn>, which is a wrapper around B<warn>.

=item C<MESSAGE>

Use the MESSAGE hash key to specify a message to send to the METHOD co
+deref. If no value is set, it defaults to C<MagicStatus(WATCH) at FIL
+E, FUNCTION, LINE> (where FILE is the filename, FUNCTION is the funct
+ion name, and LINE is the line number where the WATCH value was set.

=back

=head1 BUGS

None known so far. Please let me know if you find any.

=head1 AUTHOR

particle

=head1 COPYRIGHT

Copyright 2002 particle. All rights reserved.

This library is free software, you may redistribute it and/or modify i
+t under the same terms as Perl itself.

=head1 SEE ALSO 

perl(1), Tie::Scalar(3pm).

=cut

Comment on Magic Status Variable
Download Code
Re: Magic Status Variable
by rjray (Chaplain) on Mar 02, 2002 at 00:23 UTC

    Consider implementing a "callback" system as an option over (or in place of) the warn statement. Allow the programmer to provide a coderef that gets called with the object ($self) and the warning message as arguments.

    Consider the applications to event-based environments like Tk, GTK+, etc., that may not have a STDERR in the traditional sense.

    --rjray

      done. i've implemented your changes, and reposted the code above. thanks for your suggestions!

      ~Particle ;

Re: Magic Status Variable
by abaxaba (Hermit) on Mar 04, 2002 at 05:25 UTC
    You may want to:
    require v5.6.0 #or something, as you use the our thingie, which, IIRC, is supported 5.6+.

    $] >= 5.6 or die "$0 - Need Perl 5.6 or greater...\n"; also works, I'm guessing.
    Of course, if our is 5.003+, you're probably OK. :)

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://148730]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (7)
As of 2014-08-02 10:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (56 votes), past polls