File Coverage

lib/Tie/Wx/Widget.pm

Criterion	Covered	Total	%
statement	13	41	31.7
branch	1	28	3.5
condition	1	9	11.1
subroutine	5	13	38.4
pod	0	3	0.0
total	20	94	21.2

use v5.6;
use strict;
use warnings;
use Tie::Scalar;

package Tie::Wx::Widget;
our $VERSION = '1.0';
our @ISA = 'Tie::Scalar';
our $complainmethod = 'die';

sub import   { $complainmethod = 'warn_mode' if defined $_[1] and $_[1] eq 'warn'}
sub die_mode { $complainmethod = 'die'}
sub warn_mode{ $complainmethod = 'warn'}
sub complain { $complainmethod eq 'die' ? die $_[0] : warn $_[0] }

sub TIESCALAR {
    my ($self, $widget, $store, $fetch) = @_;

    if    (not ref $widget)                        {complain("$widget isn't even a referece, has to a Wx object")}
    elsif (index($widget, '=') == -1)              {complain("$widget isn't even an object, has to a Wx object")}
    elsif (not $widget->isa('Wx::Control'))        {complain("$widget is no Wx widget")}
    elsif (not $widget->can('GetValue'))           {complain("$widget has no method: GetValue")}
    elsif (not $widget->can('SetValue'))           {complain("$widget has no method: SetValue")}
    elsif (defined $store and ref $store ne 'CODE'){complain("no coderef as STORE callback")}
    elsif (defined $fetch and ref $fetch ne 'CODE'){complain("no coderef as FETCH callback")}
    else {
        my %hash = ('w' => $widget, 'widget' => $widget);
        $hash{'store'} = $store if defined $store;
        $hash{'fetch'} = $fetch if defined $fetch;
        return bless \%hash, $self;
    }
    return 0;
}
sub FETCH {
    if (exists $_[0]->{'fetch'}) { &{$_[0]->{'fetch'}}( $_[0]->{'w'} ) }
    else                         { return $_[0]->{'w'}->GetValue       }
}
sub STORE {
    return 0 if ref $_[1];
    if (exists $_[0]->{'store'}) { &{$_[0]->{'store'}}( $_[0]->{'w'}, $_[1] ) }
    else                         { return $_[0]->{'w'}->SetValue( $_[1] )     }
}
sub UNTIE {} # to prevent crashes if called
sub DESTROY {} # to prevent crashes if called

'one';

__END__