http://qs1969.pair.com?node_id=148730
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