perl5db.pl

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

#   + Cosmetic bugs in printing stack trace.
#   +  `frame' & 8 to print "expanded args" in stack trace.
#   + Can list/break in imported subs.
#   + new `maxTraceLen' option.
#   + frame & 4 and frame & 8 granted.
#   + new command `m'
#   + nonstoppable lines do not have `:' near the line number.
#   + `b compile subname' implemented.
#   + Will not use $` any more.
#   + `-' behaves sane now.
# Changes: 0.99: Completion for `f', `m'.
#   +  `m' will remove duplicate names instead of duplicate functions.
#   + `b load' strips trailing whitespace.
#     completion ignores leading `|'; takes into account current package
#     when completing a subroutine name (same for `l').
# Changes: 1.07: Many fixed by tchrist 13-March-2000
#   BUG FIXES:
#   + Added bare minimal security checks on perldb rc files, plus
#     comments on what else is needed.
#   + Fixed the ornaments that made "|h" completely unusable.
#     They are not used in print_help if they will hurt.  Strip pod
#     if we're paging to less.
#   + Fixed mis-formatting of help messages caused by ornaments
#     to restore Larry's original formatting.
#   + Fixed many other formatting errors.  The code is still suboptimal,
#     and needs a lot of work at restructuring.  It's also misindented
#     in many places.
#   + Fixed bug where trying to look at an option like your pager
#     shows "1".
#   + Fixed some $? processing.  Note: if you use csh or tcsh, you will
#     lose.  You should consider shell escapes not using their shell,
#     or else not caring about detailed status.  This should really be
#     unified into one place, too.
#   + Fixed bug where invisible trailing whitespace on commands hoses you,
#     tricking Perl into thinking you weren't calling a debugger command!
#   + Fixed bug where leading whitespace on commands hoses you.  (One
#     suggests a leading semicolon or any other irrelevant non-whitespace
#     to indicate literal Perl code.)
#   + Fixed bugs that ate warnings due to wrong selected handle.
#   + Fixed a precedence bug on signal stuff.
#   + Fixed some unseemly wording.
#   + Fixed bug in help command trying to call perl method code.
#   + Fixed to call dumpvar from exception handler.  SIGPIPE killed us.
#   ENHANCEMENTS:
#   + Added some comments.  This code is still nasty spaghetti.
#   + Added message if you clear your pre/post command stacks which was
#     very easy to do if you just typed a bare >, <, or {.  (A command
#     without an argument should *never* be a destructive action; this
#     API is fundamentally screwed up; likewise option setting, which
#     is equally buggered.)
#   + Added command stack dump on argument of "?" for >, <, or {.
#   + Added a semi-built-in doc viewer command that calls man with the
#     proper %Config::Config path (and thus gets caching, man -k, etc),
#     or else perldoc on obstreperous platforms.
#   + Added to and rearranged the help information.
#   + Detected apparent misuse of { ... } to declare a block; this used
#     to work but now is a command, and mysteriously gave no complaint.
#
# Changes: 1.08: Apr 25, 2001  Jon Eveland <[e-mail]>
#   BUG FIX:
#   + This patch to perl5db.pl cleans up formatting issues on the help
#     summary (h h) screen in the debugger.  Mostly columnar alignment
#     issues, plus converted the printed text to use all spaces, since
#     tabs don't seem to help much here.
#
# Changes: 1.09: May 19, 2001  Ilya Zakharevich <[e-mail]>
#   Minor bugs corrected;
#   + Support for auto-creation of new TTY window on startup, either
#     unconditionally, or if started as a kid of another debugger session;
#   + New `O'ption CreateTTY
#       I<CreateTTY>      bits control attempts to create a new TTY on events:
#                         1: on fork()
#                         2: debugger is started inside debugger
#                         4: on startup
#   + Code to auto-create a new TTY window on OS/2 (currently one
#     extra window per session - need named pipes to have more...);
#   + Simplified interface for custom createTTY functions (with a backward
#     compatibility hack); now returns the TTY name to use; return of ''
#     means that the function reset the I/O handles itself;
#   + Better message on the semantic of custom createTTY function;
#   + Convert the existing code to create a TTY into a custom createTTY
#     function;
#   + Consistent support for TTY names of the form "TTYin,TTYout";
#   + Switch line-tracing output too to the created TTY window;
#   + make `b fork' DWIM with CORE::GLOBAL::fork;
#   + High-level debugger API cmd_*():
#      cmd_b_load($filenamepart)            # b load filenamepart
#      cmd_b_line($lineno [, $cond])        # b lineno [cond]
#      cmd_b_sub($sub [, $cond])            # b sub [cond]
#      cmd_stop()                           # Control-C
#      cmd_d($lineno)                       # d lineno (B)
#      The cmd_*() API returns FALSE on failure; in this case it outputs
#      the error message to the debugging output.
#   + Low-level debugger API
#      break_on_load($filename)             # b load filename
#      @files = report_break_on_load()      # List files with load-breakpoints
#      breakable_line_in_filename($name, $from [, $to])
#                                           # First breakable line in the
#                                           # range $from .. $to.  $to defaults
#                                           # to $from, and may be less than
#                                           # $to
#      breakable_line($from [, $to])        # Same for the current file
#      break_on_filename_line($name, $lineno [, $cond])
#                                           # Set breakpoint,$cond defaults to
#                                           # 1
#      break_on_filename_line_range($name, $from, $to [, $cond])
#                                           # As above, on the first
#                                           # breakable line in range
#      break_on_line($lineno [, $cond])     # As above, in the current file
#      break_subroutine($sub [, $cond])     # break on the first breakable line
#      ($name, $from, $to) = subroutine_filename_lines($sub)
#                                           # The range of lines of the text
#      The low-level API returns TRUE on success, and die()s on failure.
#
# Changes: 1.10: May 23, 2001  Daniel Lewart <[e-mail]>
#   BUG FIXES:
#   + Fixed warnings generated by "perl -dWe 42"
#   + Corrected spelling errors
#   + Squeezed Help (h) output into 80 columns
#
# Changes: 1.11: May 24, 2001  David Dyck <[e-mail]>
#   + Made "x @INC" work like it used to
#
# Changes: 1.12: May 24, 2001  Daniel Lewart <[e-mail]>
#   + Fixed warnings generated by "O" (Show debugger options)
#   + Fixed warnings generated by "p 42" (Print expression)
# Changes: 1.13: Jun 19, 2001 [e-mail]
#   + Added windowSize option
# Changes: 1.14: Oct  9, 2001 multiple
#   + Clean up after itself on VMS (Charles Lane in 12385)
#   + Adding "@ file" syntax (Peter Scott in 12014)
#   + Debug reloading selfloaded stuff (Ilya Zakharevich in 11457)
#   + $^S and other debugger fixes (Ilya Zakharevich in 11120)
#   + Forgot a my() declaration (Ilya Zakharevich in 11085)
# Changes: 1.15: Nov  6, 2001 Michael G Schwern <[e-mail]>
#   + Updated 1.14 change log
#   + Added *dbline explainatory comments
#   + Mentioning perldebguts man page
# Changes: 1.16: Feb 15, 2002 Mark-Jason Dominus <[e-mail]>
#   + $onetimeDump improvements
# Changes: 1.17: Feb 20, 2002 Richard Foley <[e-mail]>
#   Moved some code to cmd_[.]()'s for clarity and ease of handling,
#   rationalised the following commands and added cmd_wrapper() to
#   enable switching between old and frighteningly consistent new
#   behaviours for diehards: 'o CommandSet=pre580' (sigh...)
#     a(add),       A(del)            # action expr   (added del by line)
#   + b(add),       B(del)            # break  [line] (was b,D)
#   + w(add),       W(del)            # watch  expr   (was W,W)
#                                     # added del by expr
#   + h(summary), h h(long)           # help (hh)     (was h h,h)
#   + m(methods),   M(modules)        # ...           (was m,v)
#   + o(option)                       # lc            (was O)
#   + v(view code), V(view Variables) # ...           (was w,V)
# Changes: 1.18: Mar 17, 2002 Richard Foley <[e-mail]>
#   + fixed missing cmd_O bug
# Changes: 1.19: Mar 29, 2002 Spider Boardman
#   + Added missing local()s -- DB::DB is called recursively.
# Changes: 1.20: Feb 17, 2003 Richard Foley <[e-mail]>
#   + pre'n'post commands no longer trashed with no args
#   + watch val joined out of eval()
# Changes: 1.21: Jun 04, 2003 Joe McMahon <[e-mail]>
#   + Added comments and reformatted source. No bug fixes/enhancements.
#   + Includes cleanup by Robin Barker and Jarkko Hietaniemi.
# Changes: 1.22  Jun 09, 2003 Alex Vandiver <[e-mail]>
#   + Flush stdout/stderr before the debugger prompt is printed.
# Changes: 1.23: Dec 21, 2003 Dominique Quatravaux
#   + Fix a side-effect of bug #24674 in the perl debugger ("odd taint bug")
# Changes: 1.24: Mar 03, 2004 Richard Foley <[e-mail]>
#   + Added command to save all debugger commands for sourcing later.
#   + Added command to display parent inheritance tree of given class.
#   + Fixed minor newline in history bug.
# Changes: 1.25: Apr 17, 2004 Richard Foley <[e-mail]>
#   + Fixed option bug (setting invalid options + not recognising valid short forms)
# Changes: 1.26: Apr 22, 2004 Richard Foley <[e-mail]>
#   + unfork the 5.8.x and 5.9.x debuggers.
#   + whitespace and assertions call cleanup across versions 
#   + H * deletes (resets) history
#   + i now handles Class + blessed objects
# Changes: 1.27: May 09, 2004 Richard Foley <[e-mail]>
#   + updated pod page references - clunky.
#   + removed windowid restriction for forking into an xterm.
#   + more whitespace again.
#   + wrapped restart and enabled rerun [-n] (go back n steps) command.
# Changes: 1.28: Oct 12, 2004 Richard Foley <[e-mail]>
#   + Added threads support (inc. e and E commands)
# Changes: 1.29: Nov 28, 2006 Bo Lindbergh <[e-mail]> 
#   + Added macosx_get_fork_TTY support 
# Changes: 1.30: Mar 06, 2007 Andreas Koenig <[e-mail]>
#   + Added HistFile, HistSize
########################################################################

=head1 DEBUGGER INITIALIZATION

The debugger starts up in phases.

=head2 BASIC SETUP

First, it initializes the environment it wants to run in: turning off
warnings during its own compilation, defining variables which it will need
to avoid warnings later, setting itself up to not exit when the program
terminates, and defaulting to printing return values for the C<r> command.

=cut

# Needed for the statement after exec():
#
# This BEGIN block is simply used to switch off warnings during debugger
# compiliation. Probably it would be better practice to fix the warnings,
# but this is how it's done at the moment.

BEGIN {
    $ini_warn = $^W;
    $^W       = 0;
}    # Switch compilation warnings off until another BEGIN.

local ($^W) = 0;    # Switch run-time warnings off during init.

=head2 THREADS SUPPORT

If we are running under a threaded Perl, we require threads and threads::shared
if the environment variable C<PERL5DB_THREADED> is set, to enable proper
threaded debugger control.  C<-dt> can also be used to set this.

Each new thread will be announced and the debugger prompt will always inform
you of each new thread created.  It will also indicate the thread id in which
we are currently running within the prompt like this:

	[tid] DB<$i>

Where C<[tid]> is an integer thread id and C<$i> is the familiar debugger
command prompt.  The prompt will show: C<[0]> when running under threads, but
not actually in a thread.  C<[tid]> is consistent with C<gdb> usage.

While running under threads, when you set or delete a breakpoint (etc.), this
will apply to all threads, not just the currently running one.  When you are 
in a currently executing thread, you will stay there until it completes.  With
the current implementation it is not currently possible to hop from one thread
to another.

The C<e> and C<E> commands are currently fairly minimal - see C<h e> and C<h E>.

Note that threading support was built into the debugger as of Perl version
C<5.8.6> and debugger version C<1.2.8>.

=cut

BEGIN {
  # ensure we can share our non-threaded variables or no-op
  if ($ENV{PERL5DB_THREADED}) {
	require threads;
	require threads::shared;
	import threads::shared qw(share);
	$DBGR;
	share(\$DBGR);
	lock($DBGR);
	print "Threads support enabled\n";
  } else {
	*lock  = sub(*) {};
	*share = sub(*) {};
  }
}

# This would probably be better done with "use vars", but that wasn't around
# when this code was originally written. (Neither was "use strict".) And on
# the principle of not fiddling with something that was working, this was
# left alone.
warn(               # Do not ;-)
    # These variables control the execution of 'dumpvar.pl'.
    $dumpvar::hashDepth,
    $dumpvar::arrayDepth,
    $dumpvar::dumpDBFiles,
    $dumpvar::dumpPackages,
    $dumpvar::quoteHighBit,
    $dumpvar::printUndef,
    $dumpvar::globPrint,
    $dumpvar::usageOnly,

    # used to save @ARGV and extract any debugger-related flags.
    @ARGS,

    # used to control die() reporting in diesignal()
    $Carp::CarpLevel,

    # used to prevent multiple entries to diesignal()
    # (if for instance diesignal() itself dies)
    $panic,

    # used to prevent the debugger from running nonstop
    # after a restart
    $second_time,
  )
  if 0;

foreach my $k (keys (%INC)) {
	&share(\$main::{'_<'.$filename});
};

# Command-line + PERLLIB:
# Save the contents of @INC before they are modified elsewhere.
@ini_INC = @INC;

# This was an attempt to clear out the previous values of various
# trapped errors. Apparently it didn't help. XXX More info needed!
# $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!

# We set these variables to safe values. We don't want to blindly turn
# off warnings, because other packages may still want them.
$trace = $signal = $single = 0;    # Uninitialized warning suppression
                                   # (local $^W cannot help - other packages!).

# Default to not exiting when program finishes; print the return
# value when the 'r' command is used to return from a subroutine.
$inhibit_exit = $option{PrintRet} = 1;

=head1 OPTION PROCESSING

The debugger's options are actually spread out over the debugger itself and 
C<dumpvar.pl>; some of these are variables to be set, while others are 
subs to be called with a value. To try to make this a little easier to
manage, the debugger uses a few data structures to define what options
are legal and how they are to be processed.

First, the C<@options> array defines the I<names> of all the options that
are to be accepted.

=cut

@options = qw(
  CommandSet   HistFile      HistSize
  hashDepth    arrayDepth    dumpDepth
  DumpDBFiles  DumpPackages  DumpReused
  compactDump  veryCompact   quote
  HighBit      undefPrint    globPrint
  PrintRet     UsageOnly     frame
  AutoTrace    TTY           noTTY
  ReadLine     NonStop       LineInfo
  maxTraceLen  recallCommand ShellBang
  pager        tkRunning     ornaments
  signalLevel  warnLevel     dieLevel
  inhibit_exit ImmediateStop bareStringify
  CreateTTY    RemotePort    windowSize
  DollarCaretP
);

@RememberOnROptions = qw(DollarCaretP);

=pod

Second, C<optionVars> lists the variables that each option uses to save its
state.

=cut

%optionVars = (
    hashDepth     => \$dumpvar::hashDepth,
    arrayDepth    => \$dumpvar::arrayDepth,
    CommandSet    => \$CommandSet,
    DumpDBFiles   => \$dumpvar::dumpDBFiles,
    DumpPackages  => \$dumpvar::dumpPackages,
    DumpReused    => \$dumpvar::dumpReused,
    HighBit       => \$dumpvar::quoteHighBit,
    undefPrint    => \$dumpvar::printUndef,
    globPrint     => \$dumpvar::globPrint,
    UsageOnly     => \$dumpvar::usageOnly,
    CreateTTY     => \$CreateTTY,
    bareStringify => \$dumpvar::bareStringify,
    frame         => \$frame,
    AutoTrace     => \$trace,
    inhibit_exit  => \$inhibit_exit,
    maxTraceLen   => \$maxtrace,
    ImmediateStop => \$ImmediateStop,
    RemotePort    => \$remoteport,
    windowSize    => \$window,
    HistFile      => \$histfile,
    HistSize      => \$histsize,
);