home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _ec9eb73b39591cd964a9a038ce5d2ba5 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.2 KB  |  103 lines
  1. package ActiveState::Rx;
  2.  
  3. use strict;
  4. our $VERSION = '0.60';
  5.  
  6. # <stolen from="re.pm">
  7. sub doit {
  8.   my $on = shift;
  9.   my $debug = shift || "";
  10.   require XSLoader;
  11.   XSLoader::load('ActiveState::Rx');
  12.   set_debug($debug eq "debug" and $on);
  13.   install() if $on;
  14.   deinstall() unless $on || $debug;
  15. }
  16.  
  17. sub import {
  18.   shift;
  19.   doit(1,@_);
  20. }
  21.  
  22. sub unimport {
  23.   shift;
  24.   doit(0,@_);
  25. }
  26. # </stolen>
  27.  
  28. # Translate a regex hash structure into a more tree-like structure
  29. # that is more easily traversed and analyzed.
  30. sub translate_tree {
  31.     my %tree = %{shift()};
  32.     my $node = shift;        # Starting node.
  33.     
  34.     my @treeroots;        # Array of top level tree nodes (roots).
  35.     
  36.     while(defined $node) {
  37.     if(ref($tree{$node}) eq 'HASH') {
  38.         my %nodeguts = %{$tree{$node}};
  39.         
  40.         # Add the node to the treeroots array only there
  41.         # exists a handler function that could some day
  42.         # "draw" it. We don't want to mess around with nodes we
  43.         # can't handle...
  44.         if(defined $nodeguts{TYPE}) {
  45.         push @treeroots, _process_node(\%tree, \%nodeguts, $node);
  46.         }
  47.         else {
  48.         print STDERR "Skipping node $node\n";
  49.         }
  50.         
  51.         # If the current node didn't give us a next node to traverse to
  52.         # then we must give up.
  53.         unless($node = $nodeguts{NEXT}) {
  54.         last;
  55.         }
  56.     }
  57.     }
  58.     
  59.     return \@treeroots;
  60. }
  61.  
  62. sub _process_node {
  63.     my %tree = %{shift()};
  64.     my %nodeguts = %{shift()};
  65.     my $nodename = shift();
  66.     
  67.     #    print Dumper($nodename);
  68.     #    print Dumper(\%nodeguts);
  69.     
  70.     $nodeguts{'__this__'} = $nodename;
  71.     
  72.     if($nodeguts{CHILD}) {
  73.     # Now build another translated tree based on the child node of
  74.     # this node.
  75.     my $treerootsref = translate_tree(\%tree, $nodeguts{CHILD});
  76.     $nodeguts{CHILD} = $treerootsref;
  77.     }
  78.     return \%nodeguts;
  79. }
  80.  
  81. 1;
  82.  
  83. __END__
  84.  
  85. =head1 NAME
  86.  
  87. ActiveState::Rx - Regular Expression Debugger
  88.  
  89. =head1 DESCRIPTION
  90.  
  91. Please see L<ActiveState::Rx::Info> for details on how to use Rx.
  92.  
  93. =head1 AUTHOR
  94.  
  95. Mark-Jason Dominus <mjd@plover.com>
  96. Ken Simpson <KenS@ActiveState.com>
  97. Neil Watkiss <NeilW@ActiveState.com>
  98.  
  99. =head1 COPYRIGHT
  100.  
  101. Copyright (c) 2001, ActiveState Corp.  All rights reserved.
  102. ActiveState is a devision of Sophos.
  103.