File Coverage

blib/lib/Tk/MIMEApp/DataToTk.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Tk::MIMEApp::DataToTk;
2              
3 1     1   27202 use 5.006;
  1         5  
  1         57  
4 1     1   7 use strict;
  1         1  
  1         43  
5 1     1   5 use warnings FATAL => 'all';
  1         7  
  1         66  
6              
7             =head1 NAME
8              
9             Tk::MIMEApp::DataToTk - The great new Tk::MIMEApp::DataToTk!
10              
11             =head1 VERSION
12              
13             Version 0.03
14              
15             =cut
16              
17             our $VERSION = '0.03';
18              
19 1     1   899 use subs qw/data2tk/;
  1         18  
  1         5  
20             require Exporter;
21             our @ISA = qw(Exporter);
22             our @EXPORT = qw(data2tk);
23              
24 1     1   497 use Tk;
  0            
  0            
25             use Tk::MIMEApp;
26              
27              
28             our ($MW,$MTB);
29              
30              
31              
32              
33             =head1 SYNOPSIS
34              
35             This module is a shortcut to get Tk::MIMEApp to run whatever is after __DATA__.
36              
37              
38             #!perl
39             use strict;
40             use Tk::MDTextBook::Data2Tk;
41             data2tk;
42             __DATA__
43             MIME Version: 1.0
44             Content-Type: multipart/mixed; boundary=##--##--##--##--##
45             Title: Window Title
46              
47             Here is a prologue
48             --##--##--##--##--##
49             Content-Type: application/x-ptk.markdown
50             Title: _Basic MarkDown
51             ID: Page1
52              
53             # MarkDown Tk Text Thingy.
54              
55             ## Here is a sub-header
56              
57             And a paragraph here
58             because I wanted to
59             check that it handles stuff
60             right over several lines.
61              
62             --##--##--##--##--##
63             Content-Type: application/x-ptk.markdown
64             Title: _Tk and Scripting
65             ID: Page2
66              
67             ##### Tk windows and scripts
68              
69             Here is my markdown. Here is some stuff in a preformatted block:
70              
71             field label <-- put stuff here!
72             another label ... and more
73             and so on
74              
75             --##--##--##--##--##
76             Content-Type: application/x-yaml.menu
77              
78             ---
79             - _File:
80             - _Exit: exit
81             - '---' : '---'
82             - _Help:
83             - _About: MyPackage::ShowPreamble
84             - _Help : MyPackage::ShowEpilog
85              
86             --##--##--##--##--##
87             Content-Type: application/x-perl
88              
89             package MyPackage;
90              
91             sub myScriptSub {
92             print "Hello from script sub!\n";
93             }
94              
95             sub getObjectList {
96             my @shelf = @Tk::MDTextBook::Shelf;
97             my $object = $shelf[$#shelf]; # get the last one!
98             return $object->{Objects};
99             }
100              
101             sub getMW {
102             return $Tk::MDTextBook::Data2Tk::MW;
103             }
104              
105             sub getPreamble {
106             return getObjectList()->{Main}->{Preamble};
107             }
108              
109             sub getEpilog {
110             return getObjectList()->{Main}->{Epilog};
111             }
112              
113             sub ShowPreamble {
114             getMW()->messageBox(-message=>getPreamble());
115             }
116              
117             sub ShowEpilog {
118             getMW()->messageBox(-message=>getEpilog());
119             }
120              
121             --##--##--##--##--##--
122             Here is the epilogue
123              
124              
125             =head1 EXPORT
126              
127             =over
128              
129             =item data2tk - EXPORTED BY DEFAULT!
130              
131             =back
132              
133             =head1 SUBROUTINES/METHODS
134              
135             =head2 data2tk
136              
137             =cut
138              
139              
140             sub data2tk {
141             # call this to set up a window and populate it using what's in
142             $MW = new MainWindow();
143             $MTB = $MW->MIMEApp->pack(-expand=>1,-fill=>'both');
144             $MTB->loadMultipart(\*main::DATA); # takes a file handle
145             $MW->MainLoop;
146             }
147              
148             =head2 raise
149              
150             You can call this from your App code, to raise a page by ID.
151             ID has to be given in the MIME header for that part.
152              
153             =cut
154              
155             sub raise {
156             my ($id) = @_;
157             $MTB->raise($id);
158             }
159              
160             =head1 AUTHOR
161              
162             jimi, C<< >>
163              
164             =head1 BUGS
165              
166             Please report any bugs or feature requests to C, or through
167             the web interface at L. I will be notified, and then you'll
168             automatically be notified of progress on your bug as I make changes.
169              
170              
171              
172              
173             =head1 SUPPORT
174              
175             You can find documentation for this module with the perldoc command.
176              
177             perldoc Tk::MIMEApp::DataToTk
178              
179              
180             You can also look for information at:
181              
182             =over 4
183              
184             =item * RT: CPAN's request tracker (report bugs here)
185              
186             L
187              
188             =item * AnnoCPAN: Annotated CPAN documentation
189              
190             L
191              
192             =item * CPAN Ratings
193              
194             L
195              
196             =item * Search CPAN
197              
198             L
199              
200             =back
201              
202              
203             =head1 ACKNOWLEDGEMENTS
204              
205              
206             =head1 LICENSE AND COPYRIGHT
207              
208             Copyright 2013 jimi.
209              
210             This program is free software; you can redistribute it and/or modify it
211             under the terms of the the Artistic License (2.0). You may obtain a
212             copy of the full license at:
213              
214             L
215              
216             Any use, modification, and distribution of the Standard or Modified
217             Versions is governed by this Artistic License. By using, modifying or
218             distributing the Package, you accept this license. Do not use, modify,
219             or distribute the Package, if you do not accept this license.
220              
221             If your Modified Version has been derived from a Modified Version made
222             by someone other than you, you are nevertheless required to ensure that
223             your Modified Version complies with the requirements of this license.
224              
225             This license does not grant you the right to use any trademark, service
226             mark, tradename, or logo of the Copyright Holder.
227              
228             This license includes the non-exclusive, worldwide, free-of-charge
229             patent license to make, have made, use, offer to sell, sell, import and
230             otherwise transfer the Package with respect to any patent claims
231             licensable by the Copyright Holder that are necessarily infringed by the
232             Package. If you institute patent litigation (including a cross-claim or
233             counterclaim) against any party alleging that the Package constitutes
234             direct or contributory patent infringement, then this Artistic License
235             to you shall terminate on the date that such litigation is filed.
236              
237             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
238             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
239             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
240             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
241             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
242             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
243             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
244             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
245              
246              
247             =cut
248              
249             1; # End of Tk::MIMEApp::DataToTk