forked from matthewpersico/Devel-ptkdb
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ptkdb.pm
4426 lines (3310 loc) · 128 KB
/
ptkdb.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
package DB ;
##
## Expedient fix for perl 5.8.0. True DB::DB is further down.
##
##
sub DB {}
use Tk ;
#
# If you've loaded this file via a browser
# select "Save As..." from your file menu
#
# ptkdb Perl Tk perl Debugger
#
# Copyright 1998, 2003, Andrew E. Page
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of either:
#
# a) the GNU General Public License as published by the Free
# Software Foundation; either version 1, or (at your option) any
# later version, or
#
# b) the "Artistic License" which comes with this Kit.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
# the GNU General Public License or the Artistic License for more details.
#
####################################
### Sample .Xresources for ptkdb ###
####################################
# /*
# * Perl Tk Debugger XResources.
# * Note... These resources are subject to change.
# *
# * Use 'xfontsel' to select different fonts.
# *
# * Append these resource to ~/.Xdefaults | ~/.Xresources
# * and use xrdb -override ~/.Xdefaults | ~/.Xresources
# * to activate them.
# */
# /* Set Value to se to place scrollbars on the right side of windows
# CAUTION: extra whitespace at the end of the line is causing
# failures with Tk800.011.
# */
# ptkdb*scrollbars: sw
#
# /* controls where the code pane is oriented, down the left side, or across the top */
# /* values can be set to left, right, top, bottom */
# ptkdb*codeside: left
# /*
# * Background color for the balloon
# * CAUTION: For certain versions of Tk trailing
# * characters after the color produces an error
# */
# ptkdb.frame2.frame1.rotext.balloon.background: green
# ptkdb.frame2.frame1.rotext.balloon.font: fixed /* Hot Variable Balloon Font */
#
#
# ptkdb.frame*font: fixed /* Menu Bar */
# ptkdb.frame.menubutton.font: fixed /* File menu */
# ptkdb.frame2.frame1.rotext.font: fixed /* Code Pane */
# ptkdb.notebook.datapage.frame1.hlist.font: fixed /* Expression Notebook Page */
#
# ptkdb.notebook.subspage*font: fixed /* Subroutine Notebook Page */
# ptkdb.notebook.brkptspage*entry.font: fixed /* Delete Breakpoint Buttons */
# ptkdb.notebook.brkptspage*button.font: fixed /* Breakpoint Expression Entries */
# ptkdb.notebook.brkptspage*button1.font: fixed /* Breakpoint Expression Entries */
# ptkdb.notebook.brkptspage*checkbutton.font: fixed /* Breakpoint Checkbuttons */
# ptkdb.notebook.brkptspage*label.font: fixed /* Breakpoint "Cond" label */
#
# ptkdb.toplevel.frame.textundo.font: fixed /* Eval Expression Entry Window */
# ptkdb.toplevel.frame1.text.font: fixed /* Eval Expression Results Window */
# ptkdb.toplevel.button.font: fixed /* "Eval..." Button */
# ptkdb.toplevel.button1.font: fixed /* "Clear Eval" Button */
# ptkdb.toplevel.button2.font: fixed /* "Clear Results" Button */
# ptkdb.toplevel.button3.font: fixed /* "Clear Dismiss" Button */
#
#
# /*
# * Background color for where the debugger has stopped
# */
# ptkdb*stopcolor: blue
#
# /*
# * Background color for set breakpoints
# */
# ptkdb*breaktagcolor: red
#
# /*
# * Font for where the debugger has stopped
# */
# ptkdb*stopfont: -*-fixed-bold-*-*-*-*-*-*-*-*-*-*-*
#
# /*
# * Background color for the search tag
# */
# ptkdb*searchtagcolor: green
use strict ;
use vars qw($VERSION @dbline %dbline);
#
# This package is the main_window object
# for the debugger. We start with the Devel::
# prefix because we want to install it with
# the DB:: package that is required to be in a Devel/
# subdir of a directory in the @INC set.
#
package Devel::ptkdb ;
##
## do this check once, rather than repeating the string comparison again and again
##
my $isWin32 = $^O eq 'MSWin32' ;
=head1 NAME
Devel::ptkdb - Perl debugger using a Tk GUI
=head1 DESCRIPTION
ptkdb is a debugger for perl that uses perlTk for a user interface.
Features include:
Hot Variable Inspection
Breakpoint Control Panel
Expression List
Subroutine Tree
=begin html
<body bgcolor=white>
=end html
=head1 SYNOPSIS
To debug a script using ptkdb invoke perl like this:
perl -d:ptkdb myscript.pl
=head1 Usage
perl -d:ptkdb myscript.pl
=head1 Code Pane
=over 4
=item Line Numbers
Line numbers are presented on the left side of the window. Lines that
have lines through them are not breakable. Lines that are plain text
are breakable. Clicking on these line numbers will insert a
breakpoint on that line and change the line number color to
$ENV{'PTKDB_BRKPT_COLOR'} (Defaults to Red). Clicking on the number
again will remove the breakpoint. If you disable the breakpoint with
the controls on the BrkPt notebook page the color will change to
$ENV{'PTKDB_DISABLEDBRKPT_COLOR'}(Defaults to Green).
=item Cursor Motion
If you place the cursor over a variable (i.e. $myVar, @myVar, or
%myVar) and pause for a second the debugger will evaluate the current
value of the variable and pop a balloon up with the evaluated
result. I<This feature is not available with Tk400.>
If Data::Dumper(standard with perl5.00502)is available it will be used
to format the result. If there is an active selection, the text of
that selection will be evaluated.
=back
=head1 Notebook Pane
=over 2
=item Exprs
This is a list of expressions that are evaluated each time the
debugger stops. The results of the expresssion are presented
heirarchically for expression that result in hashes or lists. Double
clicking on such an expression will cause it to collapse; double
clicking again will cause the expression to expand. Expressions are
entered through B<Enter Expr> entry, or by Alt-E when text is
selected in the code pane.
The B<Quick Expr> entry, will take an expression, evaluate it, and
replace the entries contents with the result. The result is also
transfered to the 'clipboard' for pasting.
=item Subs
Displays a list of all the packages invoked with the script
heirarchially. At the bottom of the heirarchy are the subroutines
within the packages. Double click on a package to expand
it. Subroutines are listed by their full package names.
=item BrkPts
Presents a list of the breakpoints current in use. The pushbutton
allows a breakpoint to be 'disabled' without removing it. Expressions
can be applied to the breakpoint. If the expression evaluates to be
'true'(results in a defined value that is not 0) the debugger will
stop the script. Pressing the 'Goto' button will set the text pane
to that file and line where the breakpoint is set. Pressing the
'Delete' button will delete the breakpoint.
=back
=head1 Menus
=head2 File Menu
=over
=item About...
Presents a dialog box telling you about the version of ptkdb. It
recovers your OS name, version of perl, version of Tk, and some other
information
=item Open
Presents a list of files that are part of the invoked perl
script. Selecting a file from this list will present this file in the
text window.
=item Save Config...
Requires Data::Dumper. Prompts for a filename to save the
configuration to. Saves the breakpoints, expressions, eval text and
window geometry. If the name given as the default is used and the
script is reinvoked, this configuration will be reloaded
automatically.
B<NOTE:> You may find this preferable to using
=item Restore Config...
Requires Data::Dumper. Prompts for a filename to restore a configuration saved with
the "Save Config..." menu item.
=item Goto Line...
Prompts for a line number. Pressing the "Okay" button sends the window to the line number entered.
item Find Text...
Prompts for text to search for. Options include forward search,
backwards search, and regular expression searching.
=item Quit
Causes the debugger and the target script to exit.
=back
=head2 Control Menu
=over
=item Run
The debugger allows the script to run to the next breakpoint or until the script exits.
item Run To Here
Runs the debugger until it comes to wherever the insertion cursor
in text window is placed.
=item Set Breakpoint
Sets a breakpoint on the line at the insertion cursor.
item Clear Breakpoint
Remove a breakpoint on the at the insertion cursor.
=item Clear All Breakpoints
Removes all current breakpoints
=item Step Over
Causes the debugger to step over the next line. If the line is a
subroutine call it steps over the call, stopping when the subroutine
returns.
=item Step In
Causes the debugger to step into the next line. If the line is a
subroutine call it steps into the subroutine, stopping at the first
executable line within the subroutine.
=item Return
Runs the script until it returns from the currently executing
subroutine.
=item Restart
Saves the breakpoints and expressions in a temporary file and restarts
the script from the beginning. CAUTION: This feature will not work
properly with debugging of CGI Scripts.
=item Stop On Warning
When C<-w> is enabled the debugger will stop when warnings such as, "Use
of uninitialized value at undef_warn.pl line N" are encountered. The debugger
will stop on the NEXT line of execution since the error can't be detected
until the current line has executed.
This feature can be turned on at startup by adding:
$DB::ptkdb::stop_on_warning = 1 ;
to a .ptkdbrc file
=back
=head2 Data Menu
=over
=item Enter Expression
When an expression is entered in the "Enter Expression:" text box,
selecting this item will enter the expression into the expression
list. Each time the debugger stops this expression will be evaluated
and its result updated in the list window.
=item Delete Expression
Deletes the highlighted expression in the expression window.
=item Delete All Expressions
Delete all expressions in the expression window.
=item Expression Eval Window
Pops up a two pane window. Expressions of virtually unlimitted length
can be entered in the top pane. Pressing the 'Eval' button will cause
the expression to be evaluated and its placed in the lower pane. If
Data::Dumper is available it will be used to format the resulting
text. Undo is enabled for the text in the upper pane.
HINT: You can enter multiple expressions by separating them with commas.
=item Use Data::Dumper for Eval Window
Enables or disables the use of Data::Dumper for formatting the results
of expressions in the Eval window.
=back
=head2 Stack Menu
Maintains a list of the current subroutine stack each time the
debugger stops. Selecting an item from this menu will set the text in
the code window to that particular subourtine entry point.
=head2 Bookmarks Menu
Maintains a list of bookmarks. The booksmarks are saved in ~/.ptkdb_bookmarks
=over
=item Add Bookmark
Adds a bookmark to the bookmark list.
=back
=head1 Options
Here is a list of the current active XResources options. Several of
these can be overridden with environmental variables. Resources can be
added to .Xresources or .Xdefaults depending on your X configuration.
To enable these resources you must either restart your X server or use
the xrdb -override resFile command. xfontsel can be used to select
fonts.
/*
* Perl Tk Debugger XResources.
* Note... These resources are subject to change.
*
* Use 'xfontsel' to select different fonts.
*
* Append these resource to ~/.Xdefaults | ~/.Xresources
* and use xrdb -override ~/.Xdefaults | ~/.Xresources
* to activate them.
*/
/* Set Value to se to place scrollbars on the right side of windows
CAUTION: extra whitespace at the end of the line is causing
failures with Tk800.011.
sw -> puts scrollbars on left, se puts scrollars on the right
*/
ptkdb*scrollbars: sw
/* controls where the code pane is oriented, down the left side, or across the top */
/* values can be set to left, right, top, bottom */
ptkdb*codeside: left
/*
* Background color for the balloon
* CAUTION: For certain versions of Tk trailing
* characters after the color produces an error
*/
ptkdb.frame2.frame1.rotext.balloon.background: green
ptkdb.frame2.frame1.rotext.balloon.font: fixed /* Hot Variable Balloon Font */
ptkdb.frame*font: fixed /* Menu Bar */
ptkdb.frame.menubutton.font: fixed /* File menu */
ptkdb.frame2.frame1.rotext.font: fixed /* Code Pane */
ptkdb.notebook.datapage.frame1.hlist.font: fixed /* Expression Notebook Page */
ptkdb.notebook.subspage*font: fixed /* Subroutine Notebook Page */
ptkdb.notebook.brkptspage*entry.font: fixed /* Delete Breakpoint Buttons */
ptkdb.notebook.brkptspage*button.font: fixed /* Breakpoint Expression Entries */
ptkdb.notebook.brkptspage*button1.font: fixed /* Breakpoint Expression Entries */
ptkdb.notebook.brkptspage*checkbutton.font: fixed /* Breakpoint Checkbuttons */
ptkdb.notebook.brkptspage*label.font: fixed /* Breakpoint Checkbuttons */
ptkdb.toplevel.frame.textundo.font: fixed /* Eval Expression Entry Window */
ptkdb.toplevel.frame1.text.font: fixed /* Eval Expression Results Window */
ptkdb.toplevel.button.font: fixed /* "Eval..." Button */
ptkdb.toplevel.button1.font: fixed /* "Clear Eval" Button */
ptkdb.toplevel.button2.font: fixed /* "Clear Results" Button */
ptkdb.toplevel.button3.font: fixed /* "Clear Dismiss" Button */
/*
* Background color for where the debugger has stopped
*/
ptkdb*stopcolor: blue
/*
* Background color for set breakpoints
*/
ptkdb*breaktagcolor*background: yellow
ptkdb*disabledbreaktagcolor*background: white
/*
* Font for where the debugger has stopped
*/
ptkdb*stopfont: -*-fixed-bold-*-*-*-*-*-*-*-*-*-*-*
/*
* Background color for the search tag
*/
ptkdb*searchtagcolor: green
=head1 Environmental Variables
=over 4
=item PTKDB_BRKPT_COLOR
Sets the background color of a set breakpoint
=item PTKDB_DISABLEDBRKPT_COLOR
Sets the background color of a disabled breakpoint
=item PTKDB_CODE_FONT
Sets the font of the Text in the code pane.
=item PTKDB_CODE_SIDE
Sets which side the code pane is packed onto. Defaults to 'left'.
Can be set to 'left', 'right', 'top', 'bottom'.
Overrides the Xresource ptkdb*codeside: I<side>.
=item PTKDB_EXPRESSION_FONT
Sets the font used in the expression notebook page.
=item PTKDB_EVAL_FONT
Sets the font used in the Expression Eval Window
=item PTKDB_EVAL_DUMP_INDENT
Sets the value used for Data::Dumper 'indent' setting. See man Data::Dumper
=item PTKDB_SCROLLBARS_ONRIGHT
A non-zero value Sets the scrollbars of all windows to be on the
right side of the window. Useful for Windows users using ptkdb in an
XWindows environment.
=item PTKDB_LINENUMBER_FORMAT
Sets the format of line numbers on the left side of the window. Default value is %05d. useful
if you have a script that contains more than 99999 lines.
=item PTKDB_DISPLAY
Sets the X display that the ptkdb window will appear on when invoked. Useful for debugging CGI
scripts on remote systems.
=item PTKDB_BOOKMARKS_PATH
Sets the path of the bookmarks file. Default is $ENV{'HOME'}/.ptkdb_bookmarks
=item PTKDB_STOP_TAG_COLOR
Sets the color that highlights the line where the debugger is stopped
=back
=head1 FILES
=head2 .ptkdbrc
If this file is present in ~/ or in the directory where perl is
invoked the file will be read and executed as a perl script before the
debugger makes its initial stop at startup. There are several 'api'
calls that can be used with such scripts. There is an internal
variable $DB::no_stop_at_start that may be set to non-zero to prevent
the debugger from stopping at the first line of the script. This is
useful for debugging CGI scripts.
There is a system ptkdbrc file in $PREFIX/lib/perl5/$VERS/Devel/ptkdbrc
=over 4
=item brkpt($fname, @lines)
Sets breakspoints on the list of lines in $fname. A warning message
is generated if a line is not breakable.
=item condbrkpt($fname, @($line, $expr) )
Sets conditional breakpoints in $fname on pairs of $line and $expr. A
warning message is generated if a line is not breakable. NOTE: the
validity of the expression will not be determined until execution of
that particular line.
=item brkonsub(@names)
Sets a breakpoint on each subroutine name listed. A warning message is
generated if a subroutine does not exist. NOTE: for a script with no
other packages the default package is "main::" and the subroutines
would be "main::mySubs".
=item brkonsub_regex(@regExprs)
Uses the list of @regExprs as a list of regular expressions to set breakpoints. Sets breakpoints
on every subroutine that matches any of the listed regular expressions.
=item textTagConfigure(tag, ?option?, ?value?)
Allows the user to format the text in the code window. The option
value pairs are the same values as the option for the tagConfigure
method documented in Tk::Text. Currently the following tags are in
effect:
'code' Format for code in the text pane
'stoppt' Format applied to the line where the debugger is currently stopped
'breakableLine' Format applied to line numbers where the code is 'breakable'
'nonbreakableLine' Format applied to line numbers where the code is no breakable
'breaksetLine' Format applied to line numbers were a breakpoint is set
'breakdisabledLine' Format applied to line numbers were a disabled breakpoint is set
'search_tag' Format applied to text when located by a search.
Example:
#
# Turns off the overstrike on lines that you can't set a breakpoint on
# and makes the text color yellow.
#
textTagConfigure('nonbreakableLine', -overstrike => 0, -foreground => "yellow") ;
=item add_exprs(@exprList)
Add a list of expressions to the 'Exprs' window. NOTE: use the single
quote character \' to prevent the expression from being "evaluated" in
the string context.
Example:
#
# Adds the $_ and @_ expressions to the active list
#
add_exprs('$_', '@_') ;
=back
=head1 NOTES
=head2 Debugging Other perlTk Applications
ptkdb can be used to debug other perlTk applications if some cautions
are observed. Basically, do not click the mouse in the application's
window(s) when you've entered the debugger and do not click in the
debugger's window(s) while the application is running. Doing either
one is not necessarily fatal, but it can confuse things that are going
on and produce unexpected results.
Be aware that most perlTk applications have a central event loop.
User actions, such as mouse clicks, key presses, window exposures, etc
will generate 'events' that the script will process. When a perlTk
application is running, its 'MainLoop' call will accept these events
and then dispatch them to appropriate callbacks associated with the
appropriate widgets.
Ptkdb has its own event loop that runs whenever you've stopped at a
breakpoint and entered the debugger. However, it can accept events
that are generated by other perlTk windows and dispatch their
callbacks. The problem here is that the application is supposed to be
'stopped', and logically the application should not be able to process
events.
A future version of ptkdb will have an extension that will 'filter'
events so that application events are not processed while the debugger
is active, and debugger events will not be processed while the target
script is active.
=head2 Debugging CGI Scripts
One advantage of ptkdb over the builtin debugger(-d) is that it can be
used to debug CGI perl scripts as they run on a web server. Be sure
that that your web server's perl instalation includes Tk.
Change your
#! /usr/local/bin/perl
to
#! /usr/local/bin/perl -d:ptkdb
TIP: You can debug scripts remotely if you're using a unix based
Xserver and where you are authoring the script has an Xserver. The
Xserver can be another unix workstation, a Macintosh or Win32 platform
with an appropriate XWindows package. In your script insert the
following BEGIN subroutine:
sub BEGIN {
$ENV{'DISPLAY'} = "myHostname:0.0" ;
}
Be sure that your web server has permission to open windows on your
Xserver (see the xhost manpage).
Access your web page with your browswer and 'submit' the script as
normal. The ptkdb window should appear on myHostname's monitor. At
this point you can start debugging your script. Be aware that your
browser may timeout waiting for the script to run.
To expedite debugging you may want to setup your breakpoints in
advance with a .ptkdbrc file and use the $DB::no_stop_at_start
variable. NOTE: for debugging web scripts you may have to have the
.ptkdbrc file installed in the server account's home directory (~www)
or whatever username your webserver is running under. Also try
installing a .ptkdbrc file in the same directory as the target script.
=head1 KNOWN PROBLEMS
=over
=item I<Breakpoint Controls>
If the size of the right hand pane is too small the breakpoint controls
are not visible. The breakpoints are still there, the window may have
to be enlarged in order for them to be visible.
=item Balloons and Tk400
The Balloons in Tk400 will not work with ptkdb. All other functions
are supported, but the Balloons require Tk800 or higher.
=back
=head1 AUTHOR
Andrew E. Page, [email protected]
=head1 ACKNOWLEDGEMENTS
Matthew Persico For suggestions, and beta testing.
=head1 BUG REPORTING
Please report bugs through the following URL:
http://sourceforge.net/tracker/?atid=437609&group_id=43854&func=browse
=cut
require 5.004 ;
##
## Perform a check to see if we have the Tk library, if not, attempt
## to load it for the user
##
sub BEGIN {
eval {
require Tk ;
} ;
if( $@ ) {
print << "__PTKDBTK_INSTALL__" ;
***
*** The PerlTk library could not be found. Ptkdb requires the PerlTk library.
***
Preferably Tk800.015 or better:
In order to install this the following conditions must be met:
1. You have to have access to a C compiler.
2. You must have sufficient permissions to install the libraries on your system.
To install PerlTk:
a Download the Tk library source from http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/Tk
b Uncompress the archive and run "perl Makefile.PL"
c run "make install"
If this process completes successfully ptkdb should be operational now.
We can attempt to run the CPAN module for you. This will, after some questions, download
and install the Tk library automatically.
Would you like to run the CPAN module? (y/n)
__PTKDBTK_INSTALL__
my $answer = <STDIN> ;
chomp $answer ;
if( $answer =~ /y|yes/i) {
require CPAN ;
CPAN::install Tk ;
} # if
} # if $@
} # end of sub BEGIN
use Tk 800 ;
use Data::Dumper ;
use FileHandle ;
require Tk::Dialog;
require Tk::TextUndo ;
require Tk::ROText;
require Tk::NoteBook ;
require Tk::HList ;
require Tk::Table ;
use vars qw(@dbline) ;
use Config ;
sub DoBugReport {
my($str) = 'sourceforge.net/tracker/?atid=437609&group_id=43854&func=browse' ;
my(@browsers) = qw/netscape mozilla/ ;
my($fh, $pid, $sh) ;
if( $isWin32 ) {
$sh = '' ;
@browsers = '"' . $ENV{'PROGRAMFILES'} . '\\Internet Explorer\\IEXPLORE.EXE' . '"' ;
}
else {
$sh = 'sh' ;
$str = "\'http://" . $str . "\'" ;
}
$fh = new FileHandle() ;
for( @browsers ) {
$pid = open($fh, "$sh $_ $str 2&> /dev/null |") ;
sleep(2) ;
waitpid $pid, 0 ;
return if( $? == 0 ) ;
}
print "##\n" ;
print "## Please submit a bug report through the following URL:\n" ;
print '## http://sourceforge.net/tracker/?atid=437609&group_id=43854&func=browse', "\n" ;
print "##\n" ;
}
#
# Check to see if the package actually
# exists. If it does import the routines
# and return a true value ;
#
# NOTE: this needs to be above the 'BEGIN' subroutine,
# otherwise it will not have been compiled by the time
# that it is called by sub BEGIN.
#
sub check_avail {
my ($mod, @list) = @_ ;
eval {
require $mod ; import $mod @list ;
} ;
return 0 if $@ ;
return 1 ;
} # end of check_avail
sub BEGIN {
$DB::on = 0 ;
$DB::subroutine_depth = 0 ; # our subroutine depth counter
$DB::step_over_depth = -1 ;
#
# the bindings and font specs for these operations have been placed here
# to make them accessible to people who might want to customize the
# operations. REF The 'bind.html' file, included in the perlTk FAQ has
# a fairly good explanation of the binding syntax.
#
#
# These lists of key bindings will be applied
# to the "Step In", "Step Out", "Return" Commands
#
$Devel::ptkdb::pathSep = '\x00' ;
$Devel::ptkdb::pathSepReplacement = "\0x01" ;
@Devel::ptkdb::step_in_keys = ( '<Shift-F9>', '<Alt-s>', '<Button-3>' ) ; # step into a subroutine
@Devel::ptkdb::step_over_keys = ( '<F9>', '<Alt-n>', '<Shift-Button-3>' ) ; # step over a subroutine
@Devel::ptkdb::return_keys = ( '<Alt-u>', '<Control-Button-3>' ) ; # return from a subroutine
@Devel::ptkdb::toggle_breakpt_keys = ( '<Alt-b>' ) ; # set or unset a breakpoint
# Fonts used in the displays
#
# NOTE: The environmental variable syntax here works like this:
# $ENV{'NAME'} accesses the environmental variable "NAME"
#
# $ENV{'NAME'} || 'string' results in $ENV{'NAME'} or 'string' if $ENV{'NAME'} is not defined.
#
#
@Devel::ptkdb::button_font = $ENV{'PTKDB_BUTTON_FONT'} ? ( "-font" => $ENV{'PTKDB_CODE_FONT'} ) : () ; # font for buttons
@Devel::ptkdb::code_text_font = $ENV{'PTKDB_CODE_FONT'} ? ( "-font" => $ENV{'PTKDB_CODE_FONT'} ) : () ;
@Devel::ptkdb::expression_text_font = $ENV{'PTKDB_EXPRESSION_FONT'} ? ( "-font" => $ENV{'PTKDB_EXPRESSION_FONT'} ) : () ;
@Devel::ptkdb::eval_text_font = $ENV{'PTKDB_EVAL_FONT'} ? ( -font => $ENV{'PTKDB_EVAL_FONT'} ) : () ; # text for the expression eval window
$Devel::ptkdb::eval_dump_indent = $ENV{'PTKDB_EVAL_DUMP_INDENT'} || 1 ;
#
# Windows users are more used to having scroll bars on the right.
# If they've set PTKDB_SCROLLBARS_ONRIGHT to a non-zero value
# this will configure our scrolled windows with scrollbars on the right
#
# this can also be done by setting:
#
# ptkdb*scrollbars: se
#
# in the .Xdefaults/.Xresources file on X based systems
#
if( exists $ENV{'PTKDB_SCROLLBARS_ONRIGHT'} && $ENV{'PTKDB_SCROLLBARS_ONRIGHT'} ) {
@Devel::ptkdb::scrollbar_cfg = ('-scrollbars' => 'se') ;
}
else {
@Devel::ptkdb::scrollbar_cfg = ( ) ;
}
#
# Controls how far an expression result will be 'decomposed'. Setting it
# to 0 will take it down only one level, setting it to -1 will make it
# decompose it all the way down. However, if you have a situation where
# an element is a ref back to the array or a root of the array
# you could hang the debugger by making it recursively evaluate an expression
#
$Devel::ptkdb::expr_depth = -1 ;
$Devel::ptkdb::add_expr_depth = 1 ; # how much further to expand an expression when clicked
$Devel::ptkdb::linenumber_format = $ENV{'PTKDB_LINENUMBER_FORMAT'} || "%05d " ;
$Devel::ptkdb::linenumber_length = 5 ;
$Devel::ptkdb::linenumber_offset = length sprintf($Devel::ptkdb::linenumber_format, 0) ;
$Devel::ptkdb::linenumber_offset -= 1 ;
#
# Check to see if "Data Dumper" is available
# if it is we can save breakpoints and other
# various "functions". This call will also
# load the subroutines needed.
#
$Devel::ptkdb::DataDumperAvailable = 1 ; # assuming that it is now
$Devel::ptkdb::useDataDumperForEval = $Devel::ptkdb::DataDumperAvailable ;
#
# DB Options (things not directly involving the window)
#
# Flag to disable us from intercepting $SIG{'INT'}
$DB::sigint_disable = defined $ENV{'PTKDB_SIGINT_DISABLE'} && $ENV{'PTKDB_SIGINT_DISABLE'} ;
#
# Possibly for debugging perl CGI Web scripts on
# remote machines.
#
$ENV{'DISPLAY'} = $ENV{'PTKDB_DISPLAY'} if exists $ENV{'PTKDB_DISPLAY'} ;
} # end of BEGIN
##
## subroutine provided to the user for initializing
## files in .ptkdbrc
##
sub brkpt {
my ($fName, @idx) = @_ ;
my($offset) ;
local(*dbline) = $main::{'_<' . $fName} ;
$offset = $dbline[1] =~ /use\s+.*Devel::_?ptkdb/ ? 1 : 0 ;
for( @idx ) {
if( !&DB::checkdbline($fName, $_ + $offset) ) {
my ($package, $filename, $line) = caller ;
print "$filename:$line: $fName line $_ is not breakable\n" ;
next ;
}
$DB::window->insertBreakpoint($fName, $_, 1) ; # insert a simple breakpoint
}
} # end of brkpt
#
# Set conditional breakpoint(s)
#
sub condbrkpt {
my ($fname) = shift ;
my($offset) ;
local(*dbline) = $main::{'_<' . $fname} ;
$offset = $dbline[1] =~ /use\s+.*Devel::_?ptkdb/ ? 1 : 0 ;
while( @_ ) { # arg loop
my($index, $expr) = splice @_, 0, 2 ; # take args 2 at a time
if( !&DB::checkdbline($fname, $index + $offset) ) {
my ($package, $filename, $line) = caller ;
print "$filename:$line: $fname line $index is not breakable\n" ;
next ;
}
$DB::window->insertBreakpoint($fname, $index, 1, $expr) ; # insert a simple breakpoint
} # end of arg loop
} # end of conditionalbrkpt
sub brkonsub {
my(@names) = @_ ;
for( @names ) {
# get the filename and line number range of the target subroutine
if( !exists $DB::sub{$_} ) {
print "No subroutine $_. Try main::$_\n" ;
next ;
}
$DB::sub{$_} =~ /(.*):([0-9]+)-([0-9]+)$/o ; # file name will be in $1, start line $2, end line $3
for( $2..$3 ) {
next unless &DB::checkdbline($1, $_) ;
$DB::window->insertBreakpoint($1, $_, 1) ;
last ; # only need the one breakpoint
}
} # end of name loop
} # end of brkonsub
#
# set breakpoints on subroutines matching a regular
# expression