File Coverage

blib/lib/UI/Various/Button.pm
Criterion Covered Total %
statement 34 34 100.0
branch 2 2 100.0
condition n/a
subroutine 14 14 100.0
pod 3 3 100.0
total 53 53 100.0


line stmt bran cond sub pod time code
1             package UI::Various::Button;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             UI::Various::Button - general button widget of L
8              
9             =head1 SYNOPSIS
10              
11             use UI::Various;
12             my $main = UI::Various::main();
13             $main->window(UI::Various::Button->new(text => 'Quit',
14             code => sub{ exit(); }));
15             $main->mainloop();
16              
17             =head1 ABSTRACT
18              
19             This module defines the general button widget of an application using
20             L.
21              
22             =head1 DESCRIPTION
23              
24             Besides the common attributes inherited from C the
25             C
26              
27             =head2 Attributes
28              
29             =over
30              
31             =cut
32              
33             #########################################################################
34              
35 11     11   112 use v5.14;
  11         31  
36 11     11   46 use strictures;
  11         16  
  11         60  
37 11     11   1858 no indirect 'fatal';
  11         21  
  11         50  
38 11     11   558 no multidimensional;
  11         20  
  11         56  
39 11     11   288 use warnings 'once';
  11         21  
  11         451  
40              
41             our $VERSION = '0.23';
42              
43 11     11   47 use UI::Various::core;
  11         17  
  11         107  
44 11     11   54 use UI::Various::widget;
  11         19  
  11         551  
45 11     11   49 BEGIN { require 'UI/Various/' . UI::Various::core::using() . '/Button.pm'; }
46              
47             require Exporter;
48             our @ISA = qw(UI::Various::widget);
49             our @EXPORT_OK = qw();
50              
51             #########################################################################
52              
53             =item code [rw, recommended]
54              
55             the command invoked by the button
56              
57             Note that the command gets a reference to the top-level widget (C or
58             C) as first and a reference to itself as second parameter. This is
59             especially useful to end a dialogue, as those might not return a usable
60             reference on creation, e.g. in C.
61              
62             =cut
63              
64             sub code($;$)
65             {
66             return access('code',
67             sub{
68 15 100   15   66 unless (ref($_) eq 'CODE')
69             {
70 1         3 error('_1_attribute_must_be_a_2_reference',
71             'code', 'CODE');
72 1         10 return undef;
73             }
74             },
75 37     37 1 218 @_);
76             }
77              
78             =item text [rw, recommended]
79              
80             the text of the button as string or variable reference
81              
82             =cut
83              
84             sub text($;$)
85             {
86 151     151 1 1130 return access('text', undef, @_);
87             }
88              
89             #########################################################################
90             #
91             # internal constants and data:
92              
93 11         833 use constant ALLOWED_PARAMETERS =>
94 11     11   117 (UI::Various::widget::COMMON_PARAMETERS, qw(text code));
  11         187  
95 11     11   54 use constant DEFAULT_ATTRIBUTES => (text => '', code => sub{} );
  11         22  
  11         1529  
96              
97             #########################################################################
98             #########################################################################
99              
100             =back
101              
102             =head1 METHODS
103              
104             Besides the accessors (attributes) described above and by
105             L and the methods
106             inherited from L only the
107             constructor is provided by the C
108              
109             =cut
110              
111             #########################################################################
112              
113             =head2 B - constructor
114              
115             see L
116             constructor for UI elements>
117              
118             =cut
119              
120             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
121              
122             sub new($;\[@$])
123             {
124 35     35 1 4699 debug(3, __PACKAGE__, '::new');
125 35         232 return construct({ DEFAULT_ATTRIBUTES },
126             '^(?:' . join('|', ALLOWED_PARAMETERS) . ')$',
127             @_);
128             }
129              
130             1;
131              
132             #########################################################################
133             #########################################################################
134              
135             =head1 SEE ALSO
136              
137             L
138              
139             =head1 LICENSE
140              
141             Copyright (C) Thomas Dorner.
142              
143             This library is free software; you can redistribute it and/or modify it
144             under the same terms as Perl itself. See LICENSE file for more details.
145              
146             =head1 AUTHOR
147              
148             Thomas Dorner Edorner (at) cpan (dot) orgE
149              
150             =cut