nt
		  globPrint PrintRet UsageOnly frame AutoTrace
		  TTY noTTY ReadLine NonStop LineInfo maxTraceLen
		  recallCommand ShellBang pager tkRunning ornaments
		  signalLevel warnLevel dieLevel inhibit_exit
		  ImmediateStop bareStringify
		  RemotePort);

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

%optionAction  = (
		  compactDump	=> \&dumpvar::compactDump,
		  veryCompact	=> \&dumpvar::veryCompact,
		  quote		=> \&dumpvar::quote,
		  TTY		=> \&TTY,
		  noTTY		=> \&noTTY,
		  ReadLine	=> \&ReadLine,
		  NonStop	=> \&NonStop,
		  LineInfo	=> \&LineInfo,
		  recallCommand	=> \&recallCommand,
		  ShellBang	=> \&shellBang,
		  pager		=> \&pager,
		  signalLevel	=> \&signalLevel,
		  warnLevel	=> \&warnLevel,
		  dieLevel	=> \&dieLevel,
		  tkRunning	=> \&tkRunning,
		  ornaments	=> \&ornaments,
		  RemotePort	=> \&RemotePort,
		 );

%optionRequire = (
		  compactDump	=> 'dumpvar.pl',
		  veryCompact	=> 'dumpvar.pl',
		  quote		=> 'dumpvar.pl',
		 );

# These guys may be defined in $ENV{PERL5DB} :
$rl		= 1	unless defined $rl;
$warnLevel	= 0	unless defined $warnLevel;
$dieLevel	= 0	unless defined $dieLevel;
$signalLevel	= 1	unless defined $signalLevel;
$pre		= []	unless defined $pre;
$post		= []	unless defined $post;
$pretype	= []	unless defined $pretype;

warnLevel($warnLevel);
dieLevel($dieLevel);
signalLevel($signalLevel);

&pager(
    (defined($ENV{PAGER}) 
	? $ENV{PAGER}
	: ($^O eq 'os2' 
	   ? 'cmd /c more' 
	   : 'more'))) unless defined $pager;
setman();
&recallCommand("!") unless defined $prc;
&shellBang("!") unless defined $psh;
$maxtrace = 400 unless defined $maxtrace;

if (-e "/dev/tty") {  # this is the wrong metric!
  $rcfile=".perldb";
} else {
  $rcfile="perldb.ini";
}

# This isn't really safe, because there's a race
# between checking and opening.  The solution is to
# open and fstat the handle, but then you have to read and
# eval the contents.  But then the silly thing gets
# your lexical scope, which is unfortunately at best.
sub safe_do { 
    my $file = shift;

    # Just exactly what part of the word "CORE::" don't you understand?
    local $SIG{__WARN__};  
    local $SIG{__DIE__};    

    unless (is_safe_file($file)) {
	CORE::warn <<EO_GRIPE;
perldb: Must not source insecure rcfile $file.
        You or the superuser must be the owner, and it must not 
	be writable by anyone but its owner.
EO_GRIPE
	return;
    } 

    do $file;
    CORE::warn("perldb: couldn't parse $file: $@") if $@;
}


# Verifies that owner is either real user or superuser and that no
# one but owner may write to it.  This function is of limited use
# when called on a path instead of upon a handle, because there are
# no guarantees that filename (by dirent) whose file (by ino) is
# eventually accessed is the same as the one tested. 
# Assumes that the file's existence is not in doubt.
sub is_safe_file {
    my $path = shift;
    stat($path) || return;	# mysteriously vaporized
    my($dev,$ino,$mode,$nlink,$uid,$gid) = stat(_);

    return 0 if $uid != 0 && $uid != $<;
    return 0 if $mode & 022;
    return 1;
}

if (-f $rcfile) {
    safe_do("./$rcfile");
} 
elsif (defined $ENV{HOME} && -f "$ENV{HOME}/$rcfile") {
    safe_do("$ENV{HOME}/$rcfile");
}
elsif (defined $ENV{LOGDIR} && -f "$ENV{LOGDIR}/$rcfile") {
    safe_do("$ENV{LOGDIR}/$rcfile");
}

if (defined $ENV{PERLDB_OPTS}) {
  parse_options($ENV{PERLDB_OPTS});
}

# Here begin the unreadable code.  It needs fixing.

if (exists $ENV{PERLDB_RESTART}) {
  delete $ENV{PERLDB_RESTART};
  # $restart = 1;
  @hist = get_list('PERLDB_HIST');
  %break_on_load = get_list("PERLDB_ON_LOAD");
  %postponed = get_list("PERLDB_POSTPONE");
  my @had_breakpoints= get_list("PERLDB_VISITED");
  for (0 .. $#had_breakpoints) {
    my %pf = get_list("PERLDB_FILE_$_");
    $postponed_file{$had_breakpoints[$_]} = \%pf if %pf;
  }
  my %opt = get_list("PERLDB_OPT");
  my ($opt,$val);
  while (($opt,$val) = each %opt) {
    $val =~ s/[\\\']/\\$1/g;
    parse_options("$opt'$val'");
  }
  @INC = get_list("PERLDB_INC");
  @ini_INC = @INC;
  $pretype = [get_list("PERLDB_PRETYPE")];
  $pre = [get_list("PERLDB_PRE")];
  $post = [get_list("PERLDB_POST")];
  @typeahead = get_list("PERLDB_TYPEAHEAD", @typeahead);
}

if ($notty) {
  $runnonstop = 1;
} else {
  # Is Perl being run from a slave editor or graphical debugger?
  $slave_editor = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
  $rl = 0, shift(@main::ARGV) if $slave_editor;

  #require Term::ReadLine;

  if ($^O eq 'cygwin') {
    # /dev/tty is binary. use stdin for textmode
    undef $console;
  } elsif (-e "/dev/tty") {
    $console = "/dev/tty";
  } elsif ($^O eq 'dos' or -e "con" or $^O eq 'MSWin32') {
    $console = "con";
  } elsif ($^O eq 'MacOS') {
    if ($MacPerl::Version !~ /MPW/) {
      $console = "Dev:Console:Perl Debug"; # Separate window for application
    } else {
      $console = "Dev:Console";
    }
  } else {
    $console = "sys\$command";
  }

  if (($^O eq 'MSWin32') and ($slave_editor or defined $ENV{EMACS})) {
    $console = undef;
  }

  # Around a bug:
  if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID})) { # In OS/2
    $console = undef;
  }

  if ($^O eq 'epoc') {
    $console = undef;
  }

  $console = $tty if defined $tty;

  if (defined $remoteport) {
    require IO::Socket;
    $OUT = new IO::Socket::INET( Timeout  => '10',
                                 PeerAddr => $remoteport,
                                 Proto    => 'tcp',
                               );
    if (!$OUT) { die "Unable to connect to remote host: $remoteport\n"; }
    $IN = $OUT;
  }
  else {
    if (defined $console) {
      open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
      open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
        || open(OUT,">&STDOUT");	# so we don't dongle stdout
    } else {
      open(IN,"<&STDIN");
      open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
      $console = 'STDIN/OUT';
    }
    # so open("|more") can read from STDOUT and so we don't dingle stdin
    $IN = \*IN;

    $OUT = \*OUT;
  }
  select($OUT);
  $| = 1;			# for DB::OUT
  select(STDOUT);

  $LINEINFO = $OUT unless defined $LINEINFO;
  $lineinfo = $console unless defined $lineinfo;

  $| = 1;			# for real STDOUT

  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
  unless ($runnonstop) {
    print $OUT "\nLoading DB routines from $header\n";
    print $OUT ("Editor support ",
		$slave_editor ? "enabled" : "available",
		".\n");
    print $OUT "\nEnter h or `h h' for help, or `$doccmd perldebug' for more help.\n\n";
  }
}

@ARGS = @ARGV;
for (@args) {
    s/\'/\\\'/g;
    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
}

if (defined &afterinit) {	# May be defined in $rcfile
  &afterinit();
}

$I_m_init = 1;

############################################################ Subroutines

sub DB {
    # _After_ the perl program is compiled, $single is set to 1:
    if ($single and not $second_time++) {
      if ($runnonstop) {	# Disable until signal
	for ($i=0; $i <= $stack_depth; ) {
	    $stack[$i++] &= ~1;
	}
	$single = 0;
	# return;			# Would not print trace!
      } elsif ($ImmediateStop) {
	$ImmediateStop = 0;
	$signal = 1;
      }
    }
    $runnonstop = 0 if $single or $signal; # Disable it if interactive.
    &save;
    ($package, $filename, $line) = caller;
    $filename_ini = $filename;
    $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
      "package $package;";	# this won't let them modify, alas
    local(*dbline) = $main::{'_<' . $filename};

    # we need to check for pseudofiles on Mac OS (these are files
    # not attached to a filename, but instead stored in Dev:Pseudo)
    if ($^O eq 'MacOS' && $#dbline < 0) {
	$filename_ini = $filename = 'Dev:Pseudo';
	*dbline = $main::{'_<' . $filename};
    }

    $max = $#dbline;
    if (($stop,$action) = split(/\0/,$dbline{$line})) {
	if ($stop eq '1') {
	    $signal |= 1;
	} elsif ($stop) {
	    $evalarg = "\$DB::signal |= 1 if do {$stop}"; &eval;
	    $dbline{$line} =~ s/;9($|\0)/$1/;
	}
    }
    my $was_signal = $signal;
    if ($trace & 2) {
      for (my $n = 0; $n <= $#to_watch; $n++) {
	$evalarg = $to_watch[$n];
	local $onetimeDump;	# Do not output results
	my ($val) = &eval;	# Fix context (&eval is doing array)?
	$val = ( (defined $val) ? "'$val'" : 'undef' );
	if ($val ne $old_watch[$n]) {
	  $signal = 1;
	  print $OUT <<EOP;
Watchpoint $n:\t$to_watch[$n] changed:
    old value:\t$old_watch[$n]
    new value:\t$val
EOP
	  $old_watch[$n] = $val;
	}
      }
    }
    if ($trace & 4) {		# User-installed watch
      return if watchfunction($package, $filename, $line) 
	and not $single and not $was_signal and not ($trace & ~4);
    }
    $was_signal = $signal;
    $signal = 0;
    if ($single || ($trace & 1) || $was_signal) {
	if ($slave_editor) {
	    $position = "\032\032$filename:$line:0\n";
	    print $LINEINFO $position;
	} elsif ($package eq 'DB::fake') {
	  $term || &setterm;
	  print_help(<<EOP);
Debugged program terminated.  Use B<q> to quit or B<R> to restart,
  use B<O> I<inhibit_exit> to avoid stopping after program termination,
  B<h q>, B<h R> or B<h O> to get additional info.  
EOP
	  $package = 'main';
	  $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' .
	    "package $package;";	# this won't let them modify, alas
	} else {
	    $sub =~ s/\'/::/;
	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
	    $prefix .= "$sub($filename:";
	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
	    if (length($prefix) > 30) {
	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
		$prefix = "";
		$infix = ":\t";
	    } else {
		$infix = "):\t";
		$position = "$prefix$line$infix$dbline[$line]$after";
	    }
	    if ($frame) {
		print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after";
	    } else {
		print $LINEINFO $position;
	    }
	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
		last if $signal;
		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
		$position .= $incr_pos;
		if ($frame) {
		    print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after";
		} else {
		    print $LINEINFO $incr_pos;
		}
	    }
	}
    }
    $evalarg = $action, &eval if $action;
    if ($single || $was_signal) {
	local $level = $level + 1;
	foreach $evalarg (@$pre) {
	  &eval;
	}
	print $OUT $stack_depth . " levels deep in subroutine calls!\n"
	  if $single & 4;
	$start = $line;
	$incr = -1;		# for backward motion.
	@typeahead = (@$pretype, @typeahead);
      CMD:
	while (($term || &setterm),
	       ($term_pid == $$ or &resetterm),
	       defined ($cmd=&readline("  DB" . ('<' x $level) .
				       ($#hist+1) . ('>' x $level) .
				       " "))) 
        {
		$single = 0;
		$signal = 0;
		$cmd =~ s/\\$/\n/ && do {
		    $cmd .= &readline("  cont: ");
		    redo CMD;
		};
		$cmd =~ /^$/ && ($cmd = $laststep);
		push(@hist,$cmd) if length($cmd) > 1;
	      PIPE: {
		    $cmd =~ s/^\s+//s;   # trim annoying leading whitespace
		    $cmd =~ s/\s+$//s;   # trim annoying trailing whitespace
		    ($i) = split(/\s+/,$cmd);
		    if ($alias{$i}) { 
			# squelch the sigmangler
			local $SIG{__DIE__};
			local $SIG{__WARN__};
			eval "\$cmd =~ $alias{$i}";
			if ($@) {
			    print $OUT "Couldn't evaluate `$i' alias: $@";
			    next CMD;
			} 
		    }
                   $cmd =~ /^q$/ && ($fall_off_end = 1) && exit $?;
		    $cmd =~ /^h$/ && do {
			print_help($help);
			next CMD; };
		    $cmd =~ /^h\s+h$/ && do {
			print_help($summary);
			next CMD; };
		    # support long commands; otherwise bogus errors
		    # happen when you ask for h on <CR> for example
		    $cmd =~ /^h\s+(\S.*)$/ && do {      
			my $asked = $1;			# for proper errmsg
			my $qasked = quotemeta($asked); # for searching
			# XXX: finds CR but not <CR>
			if ($help =~ /^<?(?:[IB]<)$qasked/m) {
			  while ($help =~ /^(<?(?:[IB]<)$qasked([\s\S]*?)\n)(?!\s)/mg) {
			    print_help($1);
			  }
			} else {
			    print_help("B<$asked> is not a debugger command.\n");
			}
			next CMD; };
		    $cmd =~ /^t$/ && do {
			$trace ^= 1;
			print $OUT "Trace = " .
			    (($trace & 1) ? "on" : "off" ) . "\n";
			next CMD; };
		    $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
			$Srev = defined $2; $Spatt = $3; $Snocheck = ! defined $1;
			foreach $subname (sort(keys %sub)) {
			    if ($Snocheck or $Srev^($subname =~ /$Spatt/)) {
				print $OUT $subname,"\n";
			    }
			}
			next CMD; };
		    $cmd =~ /^v$/ && do {
			list_versions(); next CMD};
		    $cmd =~ s/^X\b/V $package/;
		    $cmd =~ /^V$/ && do {
			$cmd = "V $package"; };
		    $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
			local ($savout) = select($OUT);
			$packname = $1;
			@vars = split(' ',$2);
			do 'dumpvar.pl' unless defined &main::dumpvar;
			if (defined &main::dumpvar) {
			    local $frame = 0;
			    local $doret = -2;
			    # must detect sigpipe failures
			    eval { &main::dumpvar($packname,@vars) };
			    if ($@) {
				die unless $@ =~ /dumpvar print failed/;
			    } 
			} else {
			    print $OUT "dumpvar.pl not available.\n";
			}
			select ($savout);
			next CMD; };
		    $cmd =~ s/^x\b/ / && do { # So that will be evaled
			$onetimeDump = 'dump'; };
		    $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
			methods($1); next CMD};
		    $cmd =~ s/^m\b/ / && do { # So this will be evaled
			$onetimeDump = 'methods'; };
		    $cmd =~ /^f\b\s*(.*)/ && do {
			$file = $1;
			$file =~ s/\s+$//;
			if (!$file) {
			    print $OUT "The old f command is now the r command.\n";
			    print $OUT "The new f command switches filenames.\n";
			    next CMD;
			}
			if (!defined $main::{'_<' . $file}) {
			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
					      $try = substr($try,2);
					      print $OUT "Choosing $try matching `$file':\n";
					      $file = $try;
					  }}
			}
			if (!defined $main::{'_<' . $file}) {
			    print $OUT "No file matching `$file' is loaded.\n";
			    next CMD;
			} elsif ($file ne $filename) {
			    *dbline = $main::{'_<' . $file};
			    $max = $#dbline;
			    $filename = $file;
			    $start = 1;
			    $cmd = "l";
			  } else {
			    print $OUT "Already in $file.\n";
			    next CMD;
			  }
		      };
		    $cmd =~ s/^l\s+-\s*$/-/;
		    $cmd =~ /^([lb])\b\s*(\$.*)/s && do {
			$evalarg = $2;
			my ($s) = &eval;
			print($OUT "Error: $@\n"), next CMD if $@;
			$s = CvGV_name($s);
			print($OUT "Interpreted as: $1 $s\n");
			$cmd = "$1 $s";
		    };
		    $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*(\[.*\])?)/s && do {
			$subname = $1;
			$subname =~ s/\'/::/;
			$subname = $package."::".$subname 
			  unless $subname =~ /::/;
			$subname = "main".$subname if substr($subname,0,2) eq "::";
			@pieces = split(/:/,find_sub($subname) || $sub{$subname});
			$subrange = pop @pieces;
			$file = join(':', @pieces);
			if ($file ne $filename) {
			    print $OUT "Switching to file '$file'.\n"
				unless $slave_editor;
			    *dbline = $main::{'_<' . $file};
			    $max = $#dbline;
			    $filename = $file;
			}
			if ($subrange) {
			    if (eval($subrange) < -$window) {
				$subrange =~ s/-.*/+/;
			    }
			    $cmd = "l $subrange";
			} else {
			    print $OUT "Subroutine $subname not found.\n";
			    next CMD;
			} };
		    $cmd =~ /^\.$/ && do {
			$incr = -1;		# for backward motion.
			$start = $line;
			$filename = $filename_ini;
			*dbline = $main::{'_<' . $filename};
			$max = $#dbline;
			print $LINEINFO $position;
			next CMD };
		    $cmd =~ /^w\b\s*(\d*)$/ && do {
			$incr = $window - 1;
			$start = $1 if $1;
			$start -= $preview;
			#print $OUT 'l ' . $start . '-' . ($start + $incr);
			$cmd = 'l ' . $start . '-' . ($start + $incr); };
		    $cmd =~ /^-$/ && do {
			$start -= $incr + $window + 1;
			$start = 1 if $start <= 0;
			$incr = $window - 1;
			$cmd = 'l ' . ($start) . '+'; };
		    $cmd =~ /^l$/ && do {
			$incr = $window - 1;
			$cmd = 'l ' . $start . '-' . ($start + $incr); };
		    $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do {
			$start = $1 if $1;
			$incr = $2;
			$incr = $window - 1 unless $incr;
			$cmd = 'l ' . $start . '-' . ($start + $incr); };
		    $cmd =~ /^l\b\s*((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
			$end = (!defined $2) ? $max : ($4 ? $4 : $2);
			$end = $max if $end > $max;
			$i = $2;
			$i = $line if $i eq '.';
			$i = 1 if $i < 1;
			$incr = $end - $i;
			if ($slave_editor) {
			    print $OUT "\032\032$filename:$i:0\n";
			    $i = $end;
			} else {
			    for (; $i <= $end; $i++) {
			        ($stop,$action) = split(/\0/, $dbline{$i});
			        $arrow = ($i==$line 
					  and $filename eq $filename_ini) 
				  ?  '==>' 
				    : ($dbline[$i]+0 ? ':' : ' ') ;
				$arrow .= 'b' if $stop;
				$arrow .= 'a' if $action;
				print $OUT "$i$arrow\t", $dbline[$i];
				$i++, last if $signal;
			    }
			    print $OUT "\n" unless $dbline[$i-1] =~ /\n$/;
			}
			$start = $i; # remember in case they want more
			$start = $max if $start > $max;
			next CMD; };
		    $cmd =~ /^D$/ && do {
		      print $OUT "Deleting all breakpoints...\n";
		      my $file;
		      for $file (keys %had_breakpoints) {
			local *dbline = $main::{'_<' . $file};
			my $max = $#dbline;
			my $was;
			
			for ($i = 1; $i <= $max ; $i++) {
			    if (defined $dbline{$i}) {
				$dbline{$i} =~ s/^[^\0]+//;
				if ($dbline{$i} =~ s/^\0?$//) {
				    delete $dbline{$i};
				}
			    }
			}
			
			if (not $had_breakpoints{$file} &= ~1) {
			    delete $had_breakpoints{$file};
			}
		      }
		      undef %postponed;
		      undef %postponed_file;
		      undef %break_on_load;
		      next CMD; };
		    $cmd =~ /^L$/ && do {
		      my $file;
		      for $file (keys %had_breakpoints) {
			local *dbline = $main::{'_<' . $file};
			my $max = $#dbline;
			my $was;
			
			for ($i = 1; $i <= $max; $i++) {
			    if (defined $dbline{$i}) {
			        print $OUT "$file:\n" unless $was++;
				print $OUT " $i:\t", $dbline[$i];
				($stop,$action) = split(/\0/, $dbline{$i});
				print $OUT "   break if (", $stop, ")\n"
				  if $stop;
				print $OUT "   action:  ", $action, "\n"
				  if $action;
				last if $signal;
			    }
			}
		      }
		      if (%postponed) {
			print $OUT "Postponed breakpoints in subroutines:\n";
			my $subname;
			for $subname (keys %postponed) {
			  print $OUT " $subname\t$postponed{$subname}\n";
			  last if $signal;
			}
		      }
		      my @have = map { # Combined keys
			keys %{$postponed_file{$_}}
		      } keys %postponed_file;
		      if (@have) {
			print $OUT "Postponed breakpoints in files:\n";
			my ($file, $line);
			for $file (keys %postponed_file) {
			  my $db = $postponed_file{$file};
			  print $OUT " $file:\n";
			  for $line (sort {$a <=> $b} keys %$db) {
				print $OUT "  $line:\n";
				my ($stop,$action) = split(/\0/, $$db{$line});
				print $OUT "    break if (", $stop, ")\n"
				  if $stop;
				print $OUT "    action:  ", $action, "\n"
				  if $action;
				last if $signal;
			  }
			  last if $signal;
			}
		      }
		      if (%break_on_load) {
			print $OUT "Breakpoints on load:\n";
			my $file;
			for $file (keys %break_on_load) {
			  print $OUT " $file\n";
			  last if $signal;
			}
		      }
		      if ($trace & 2) {
			print $OUT "Watch-expressions:\n";
			my $expr;
			for $expr (@to_watch) {
			  print $OUT " $expr\n";
			  last if $signal;
			}
		      }
		      next CMD; };
		    $cmd =~ /^b\b\s*load\b\s*(.*)/ && do {
			my $file = $1; $file =~ s/\s+$//;
			{
			  $break_on_load{$file} = 1;
			  $break_on_load{$::INC{$file}} = 1 if $::INC{$file};
			  $file .= '.pm', redo unless $file =~ /\./;
			}
			$had_breakpoints{$file} |= 1;
			print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
			next CMD; };
		    $cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
			my $cond = length $3 ? $3 : '1';
			my ($subname, $break) = ($2, $1 eq 'postpone');
			$subname =~ s/\'/::/g;
			$subname = "${'package'}::" . $subname
			  unless $subname =~ /::/;
			$subname = "main".$subname if substr($subname,0,2) eq "::";
			$postponed{$subname} = $break 
			  ? "break +0 if $cond" : "compile";
			next CMD; };
		    $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ && do {
			$subname = $1;
			$cond = length $2 ? $2 : '1';
			$subname =~ s/\'/::/g;
			$subname = "${'package'}::" . $subname
			  unless $subname =~ /::/;
			$subname = "main".$subname if substr($subname,0,2) eq "::";
			# Filename below can contain ':'
			($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
			$i += 0;
			if ($i) {
			    local $filename = $file;
			    local *dbline = $main::{'_<' . $filename};
			    $had_breakpoints{$filename} |= 1;
			    $max = $#dbline;
			    ++$i while $dbline[$i] == 0 && $i < $max;
			    $dbline{$i} =~ s/^[^\0]*/$cond/;
			} else {
			    print $OUT "Subroutine $subname not found.\n";
			}
			next CMD; };
		    $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
			$i = $1 || $line;
			$cond = length $2 ? $2 : '1';
			if ($dbline[$i] == 0) {
			    print $OUT "Line $i not breakable.\n";
			} else {
			    $had_breakpoints{$filename} |= 1;
			    $dbline{$i} =~ s/^[^\0]*/$cond/;
			}
			next CMD; };
		    $cmd =~ /^d\b\s*(\d*)/ && do {
			$i = $1 || $line;
                        if ($dbline[$i] == 0) {
                            print $OUT "Line $i not breakable.\n";
                        } else {
			    $dbline{$i} =~ s/^[^\0]*//;
			    delete $dbline{$i} if $dbline{$i} eq '';
                        }
			next CMD; };
		    $cmd =~ /^A$/ && do {
		      print $OUT "Deleting all actions...\n";
		      my $file;
		      for $file (keys %had_breakpoints) {
			local *dbline = $main::{'_<' . $file};
			my $max = $#dbline;
			my $was;
			
			for ($i = 1; $i <= $max ; $i++) {
			    if (defined $dbline{$i}) {
				$dbline{$i} =~ s/\0[^\0]*//;
				delete $dbline{$i} if $dbline{$i} eq '';
			    }
			}
			
			unless ($had_breakpoints{$file} &= ~2) {
			    delete $had_breakpoints{$file};
			}
		      }
		      next CMD; };
		    $cmd =~ /^O\s*$/ && do {
			for (@options) {
			    &dump_option($_);
			}
			next CMD; };
		    $cmd =~ /^O\s*(\S.*)/ && do {
			parse_options($1);
			next CMD; };
		    $cmd =~ /^\<\<\s*(.*)/ && do { # \<\< for CPerl sake: not HERE
			push @$pre, action($1);
			next CMD; };
		    $cmd =~ /^>>\s*(.*)/ && do {
			push @$post, action($1);
			next CMD; };
		    $cmd =~ /^<\s*(.*)/ && do {
			unless ($1) {
			    print $OUT "All < actions cleared.\n";
			    $pre = [];
			    next CMD;
			} 
			if ($1 eq '?') {
			    unless (@$pre) {
				print $OUT "No pre-prompt Perl actions.\n";
				next CMD;
			    } 
			    print $OUT "Perl commands run before each prompt:\n";
			    for my $action ( @$pre ) {
				print $OUT "\t< -- $action\n";
			    } 
			    next CMD;
			} 
			$pre = [action($1)];
			next CMD; };
		    $cmd =~ /^>\s*(.*)/ && do {
			unless ($1) {
			    print $OUT "All > actions cleared.\n";
			    $post = [];
			    next CMD;
			}
			if ($1 eq '?') {
			    unless (@$post) {
				print $OUT "No post-prompt Perl actions.\n";
				next CMD;
			    } 
			    print $OUT "Perl commands run after each prompt:\n";
			    for my $action ( @$post ) {
				print $OUT "\t> -- $action\n";
			    } 
			    next CMD;
			} 
			$post = [action($1)];
			next CMD; };
		    $cmd =~ /^\{\{\s*(.*)/ && do {
			if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,2))) { 
			    print $OUT "{{ is now a debugger command\n",
				"use `;{{' if you mean Perl code\n";
			    $cmd = "h {{";
			    redo CMD;
			} 
			push @$pretype, $1;
			next CMD; };
		    $cmd =~ /^\{\s*(.*)/ && do {
			unless ($1) {
			    print $OUT "All { actions cleared.\n";
			    $pretype = [];
			    next CMD;
			}
			if ($1 eq '?') {
			    unless (@$pretype) {
				print $OUT "No pre-prompt debugger actions.\n";
				next CMD;
			    } 
			    print $OUT "Debugger commands run before each prompt:\n";
			    for my $action ( @$pretype ) {
				print $OUT "\t{ -- $action\n";
			    } 
			    next CMD;
			} 
			if ($cmd =~ /^\{.*\}$/ && unbalanced(substr($cmd,1))) { 
			    print $OUT "{ is now a debugger command\n",
				"use `;{' if you mean Perl code\n";
			    $cmd = "h {";
			    redo CMD;
			} 
			$pretype = [$1];
			next CMD; };
		    $cmd =~ /^a\b\s*(\d*)\s*(.*)/ && do {
			$i = $1 || $line; $j = $2;
			if (length $j) {
			    if ($dbline[$i] == 0) {
				print $OUT "Line $i may not have an action.\n";
			    } else {
				$had_breakpoints{$filename} |= 2;
				$dbline{$i} =~ s/\0[^\0]*//;
				$dbline{$i} .= "\0" . action($j);
			    }
			} else {
			    $dbline{$i} =~ s/\0[^\0]*//;
			    delete $dbline{$i} if $dbline{$i} eq '';
			}
			next CMD; };
		    $cmd =~ /^n$/ && do {
		        end_report(), next CMD if $finished and $level <= 1;
			$single = 2;
			$laststep = $cmd;
			last CMD; };
		    $cmd =~ /^s$/ && do {
		        end_report(), next CMD if $finished and $level <= 1;
			$single = 1;
			$laststep = $cmd;
			last CMD; };
		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
		        end_report(), next CMD if $finished and $level <= 1;
			$subname = $i = $1;
			#  Probably not needed, since we finish an interactive
			#  sub-session anyway...
			# local $filename = $filename;
			# local *dbline = *dbline;	# XXX Would this work?!
			if ($i =~ /\D/) { # subroutine name
			    $subname = $package."::".$subname 
			        unless $subname =~ /::/;
			    ($file,$i) = (find_sub($subname) =~ /^(.*):(.*)$/);
			    $i += 0;
			    if ($i) {
			        $filename = $file;
				*dbline = $main::{'_<' . $filename};
				$had_breakpoints{$filename} |= 1;
				$max = $#dbline;
				++$i while $dbline[$i] == 0 && $i < $max;
			    } else {
				print $OUT "Subroutine $subname not found.\n";
				next CMD; 
			    }
			}
			if ($i) {
			    if ($dbline[$i] == 0) {
				print $OUT "Line $i not breakable.\n";
				next CMD;
			    }
			    $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
			}
			for ($i=0; $i <= $stack_depth; ) {
			    $stack[$i++] &= ~1;
			}
			last CMD; };
		    $cmd =~ /^r$/ && do {
		        end_report(), next CMD if $finished and $level <= 1;
			$stack[$stack_depth] |= 1;
			$doret = $option{PrintRet} ? $stack_depth - 1 : -2;
			last CMD; };
		    $cmd =~ /^R$/ && do {
		        print $OUT "Warning: some settings and command-line options may be lost!\n";
			my (@script, @flags, $cl);
			push @flags, '-w' if $ini_warn;
			# Put all the old includes at the start to get
			# the same debugger.
			for (@ini_INC) {
			  push @flags, '-I', $_;
			}
			# Arrange for setting the old INC:
			set_list("PERLDB_INC", @ini_INC);
			if ($0 eq '-e') {
			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
			        chomp ($cl =  ${'::_<-e'}[$_]);
			    push @script, '-e', $cl;
			  }
			} else {
			  @script = $0;
			}
			set_list("PERLDB_HIST", 
				 $term->Features->{getHistory} 
				 ? $term->GetHistory : @hist);
			my @had_breakpoints = keys %had_breakpoints;
			set_list("PERLDB_VISITED", @had_breakpoints);
			set_list("PERLDB_OPT", %option);
			set_list("PERLDB_ON_LOAD", %break_on_load);
			my @hard;
			for (0 .. $#had_breakpoints) {
			  my $file = $had_breakpoints[$_];
			  *dbline = $main::{'_<' . $file};
			  next unless %dbline or $postponed_file{$file};
			  (push @hard, $file), next 
			    if $file =~ /^\(eval \d+\)$/;
			  my @add;
			  @add = %{$postponed_file{$file}}
			    if $postponed_file{$file};
			  set_list("PERLDB_FILE_$_", %dbline, @add);
			}
			for (@hard) { # Yes, really-really...
			  # Find the subroutines in this eval
			  *dbline = $main::{'_<' . $_};
			  my ($quoted, $sub, %subs, $line) = quotemeta $_;
			  for $sub (keys %sub) {
			    next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
			    $subs{$sub} = [$1, $2];
			  }
			  unless (%subs) {
			    print $OUT
			      "No subroutines in $_, ignoring breakpoints.\n";
			    next;
			  }
			LINES: for $line (keys %dbline) {
			    # One breakpoint per sub only:
			    my ($offset, $sub, $found);
			  SUBS: for $sub (keys %subs) {
			      if ($subs{$sub}->[1] >= $line # Not after the subroutine
				  and (not defined $offset # Not caught
				       or $offset < 0 )) { # or badly caught
				$found = $sub;
				$offset = $line - $subs{$sub}->[0];
				$offset = "+$offset", last SUBS if $offset >= 0;
			      }
			    }
			    if (defined $offset) {
			      $postponed{$found} =
				"break $offset if $dbline{$line}";
			    } else {
			      print $OUT "Breakpoint in $_:$line ignored: after all the subroutines.\n";
			    }
			  }
			}
			set_list("PERLDB_POSTPONE", %postponed);
			set_list("PERLDB_PRETYPE", @$pretype);
			set_list("PERLDB_PRE", @$pre);
			set_list("PERLDB_POST", @$post);
			set_list("PERLDB_TYPEAHEAD", @typeahead);
			$ENV{PERLDB_RESTART} = 1;
			#print "$^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS";
			exec $^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS;
			print $OUT "exec failed: $!\n";
			last CMD; };
		    $cmd =~ /^T$/ && do {
			print_trace($OUT, 1); # skip DB
			next CMD; };
		    $cmd =~ /^W\s*$/ && do {
			$trace &= ~2;
			@to_watch = @old_watch = ();
			next CMD; };
		    $cmd =~ /^W\b\s*(.*)/s && do {
			push @to_watch, $1;
			$evalarg = $1;
			my ($val) = &eval;
			$val = (defined $val) ? "'$val'" : 'undef' ;
			push @old_watch, $val;
			$trace |= 2;
			next CMD; };
		    $cmd =~ /^\/(.*)$/ && do {
			$inpat = $1;
			$inpat =~ s:([^\\])/$:$1:;
			if ($inpat ne "") {
			    # squelch the sigmangler
			    local $SIG{__DIE__};
			    local $SIG{__WARN__};
			    eval '$inpat =~ m'."\a$inpat\a";	
			    if ($@ ne "") {
				print $OUT "$@";
				next CMD;
			    }
			    $pat = $inpat;
			}
			$end = $start;
			$incr = -1;
			eval '
			    for (;;) {
				++$start;
				$start = 1 if ($start > $max);
				last if ($start == $end);
				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
				    if ($slave_editor) {
					print $OUT "\032\032$filename:$start:0\n";
				    } else {
					print $OUT "$start:\t", $dbline[$start], "\n";
				    }
				    last;
				}
			    } ';
			print $OUT "/$pat/: not found\n" if ($start == $end);
			next CMD; };
		    $cmd =~ /^\?(.*)$/ && do {
			$inpat = $1;
			$inpat =~ s:([^\\])\?$:$1:;
			if ($inpat ne "") {
			    # squelch the sigmangler
			    local $SIG{__DIE__};
			    local $SIG{__WARN__};
			    eval '$inpat =~ m'."\a$inpat\a";	
			    if ($@ ne "") {
				print $OUT $@;
				next CMD;
			    }
			    $pat = $inpat;
			}
			$end = $start;
			$incr = -1;
			eval '
			    for (;;) {
				--$start;
				$start = $max if ($start <= 0);
				last if ($start == $end);
				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
				    if ($slave_editor) {
					print $OUT "\032\032$filename:$start:0\n";
				    } else {
					print $OUT "$start:\t", $dbline[$start], "\n";
				    }
				    last;
				}
			    } ';
			print $OUT "?$pat?: not found\n" if ($start == $end);
			next CMD; };
		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
			pop(@hist) if length($cmd) > 1;
			$i = $1 ? ($#hist-($2||1)) : ($2||$#hist);
			$cmd = $hist[$i];
			print $OUT $cmd, "\n";
			redo CMD; };
		    $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
			&system($1);
			next CMD; };
		    $cmd =~ /^$rc([^$rc].*)$/ && do {
			$pat = "^$1";
			pop(@hist) if length($cmd) > 1;
			for ($i = $#hist; $i; --$i) {
			    last if $hist[$i] =~ /$pat/;
			}
			if (!$i) {
			    print $OUT "No such command!\n\n";
			    next CMD;
			}
			$cmd = $hist[$i];
			print $OUT $cmd, "\n";
			redo CMD; };
		    $cmd =~ /^$sh$/ && do {
			&system($ENV{SHELL}||"/bin/sh");
			next CMD; };
		    $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
			# XXX: using csh or tcsh destroys sigint retvals!
			#&system($1);  # use this instead
			&system($ENV{SHELL}||"/bin/sh","-c",$1);
			next CMD; };
		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
			$end = $2 ? ($#hist-$2) : 0;
			$hist = 0 if $hist < 0;
			for ($i=$#hist; $i>$end; $i--) {
			    print $OUT "$i: ",$hist[$i],"\n"
			      unless $hist[$i] =~ /^.?$/;
			};
			next CMD; };
		    $cmd =~ /^(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?$/ && do {
			runman($1);
			next CMD; };
		    $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
		    $cmd =~ s/^p\b/print {\$DB::OUT} /;
		    $cmd =~ s/^=\s*// && do {
			my @keys;
			if (length $cmd == 0) {
			    @keys = sort keys %alias;
			} 
                        elsif (my($k,$v) = ($cmd =~ /^(\S+)\s+(\S.*)/)) {
			    # can't use $_ or kill //g state
			    for my $x ($k, $v) { $x =~ s/\a/\\a/g }
			    $alias{$k} = "s\a$k\a$v\a";
			    # squelch the sigmangler
			    local $SIG{__DIE__};
			    local $SIG{__WARN__};
			    unless (eval "sub { s\a$k\a$v\a }; 1") {
				print $OUT "Can't alias $k to $v: $@\n"; 
				delete $alias{$k};
				next CMD;
			    } 
			    @keys = ($k);
			} 
			else {
			    @keys = ($cmd);
			} 
			for my $k (@keys) {
			    if ((my $v = $alias{$k}) =~ ss\a$k\a(.*)\a$1) {
				print $OUT "$k\t= $1\n";
			    } 
			    elsif (defined $alias{$k}) {
				    print $OUT "$k\t$alias{$k}\n";
			    } 
			    else {
				print "No alias for $k\n";
			    } 
			}
			next CMD; };
		    $cmd =~ /^\|\|?\s*[^|]/ && do {
			if ($pager =~ /^\|/) {
			    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
			    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
			} else {
			    open(SAVEOUT,">&OUT") || &warn("Can't save DB::OUT");
			}
			fix_less();
			unless ($piped=open(OUT,$pager)) {
			    &warn("Can't pipe output to `$pager'");
			    if ($pager =~ /^\|/) {
				open(OUT,">&STDOUT") # XXX: lost message
				    || &warn("Can't restore DB::OUT");
				open(STDOUT,">&SAVEOUT")
				  || &warn("Can't restore STDOUT");
				close(SAVEOUT);
			    } else {
				open(OUT,">&STDOUT") # XXX: lost message
				    || &warn("Can't restore DB::OUT");
			    }
			    next CMD;
			}
			$SIG{PIPE}= \&DB::catch if $pager =~ /^\|/
			    && ("" eq $SIG{PIPE}  ||  "DEFAULT" eq $SIG{PIPE});
			$selected= select(OUT);
			$|= 1;
			select( $selected ), $selected= "" unless $cmd =~ /^\|\|/;
			$cmd =~ s/^\|+\s*//;
			redo PIPE; 
		    };
		    # XXX Local variants do not work!
		    $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
		}		# PIPE:
	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
	    if ($onetimeDump) {
		$onetimeDump = undef;
	    } elsif ($term_pid == $$) {
		print $OUT "\n";
	    }
	} continue {		# CMD:
	    if ($piped) {
		if ($pager =~ /^\|/) {
		    $? = 0;  
		    # we cannot warn here: the handle is missing --tchrist
		    close(OUT) || print SAVEOUT "\nCan't close DB::OUT\n";

		    # most of the $? crud was coping with broken cshisms
		    if ($?) {
			print SAVEOUT "Pager `$pager' failed: ";
			if ($? == -1) {
			    print SAVEOUT "shell returned -1\n";
			} elsif ($? >> 8) {
			    print SAVEOUT 
			      ( $? & 127 ) ? " (SIG#".($?&127).")" : "", 
			      ( $? & 128 ) ? " -- core dumped" : "", "\n";
			} else {
			    print SAVEOUT "status ", ($? >> 8), "\n";
			} 
		    } 

		    open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
		    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
		    $SIG{PIPE} = "DEFAULT" if $SIG{PIPE} eq \&DB::catch;
		    # Will stop ignoring SIGPIPE if done like nohup(1)
		    # does SIGINT but Perl doesn't give us a choice.
		} else {
		    open(OUT,">&SAVEOUT") || &warn("Can't restore DB::OUT");
		}
		close(SAVEOUT);
		select($selected), $selected= "" unless $selected eq "";
		$piped= "";
	    }
	}			# CMD:
       $fall_off_end = 1 unless defined $cmd; # Emulate `q' on EOF
	foreach $evalarg (@$post) {
	  &eval;
	}
    }				# if ($single || $signal)
    ($@, $!, $^E, $,, $/, $\, $^W) = @saved;
    ();
}

# The following code may be executed now:
# BEGIN {warn 4}

sub sub {
    my ($al, $ret, @ret) = "";
    if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
	$al = " for $$sub";
    }
    local $stack_depth = $stack_depth + 1; # Protect from non-local exits
    $#stack = $stack_depth;
    $stack[-1] = $single;
    $single &= 1;
    $single |= 4 if $stack_depth == $deep;
    ($frame & 4 
     ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in  "), 
	 # Why -1? But it works! :-(
	 print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
     : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame;
    if (wantarray) {
	@ret = &$sub;
	$single |= $stack[$stack_depth--];
	($frame & 4 
	 ? ( (print $LINEINFO ' ' x $stack_depth, "out "), 
	     print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
	 : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
	if ($doret eq $stack_depth or $frame & 16) {
            my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
	    print $fh ' ' x $stack_depth if $frame & 16;
	    print $fh "list context return from $sub:\n"; 
	    dumpit($fh, \@ret );
	    $doret = -2;
	}
	@ret;
    } else {
        if (defined wantarray) {
	    $ret = &$sub;
        } else {
            &$sub; undef $ret;
        };
	$single |= $stack[$stack_depth--];
	($frame & 4 
	 ? ( (print $LINEINFO ' ' x $stack_depth, "out "), 
	      print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
	 : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
	if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
            my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
	    print $fh (' ' x $stack_depth) if $frame & 16;
	    print $fh (defined wantarray 
			 ? "scalar context return from $sub: " 
			 : "void context return from $sub\n");
	    dumpit( $fh, $ret ) if defined wantarray;
	    $doret = -2;
	}
	$ret;
    }
}

sub save {
    @saved = ($@, $!, $^E, $,, $/, $\, $^W);
    $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
}

# The following takes its argument via $evalarg to preserve current @_

sub eval {
    # 'my' would make it visible from user code
    #    but so does local! --tchrist  
    local @res;			
    {
	local $otrace = $trace;
	local $osingle = $single;
	local $od = $^D;
	{ ($evalarg) = $evalarg =~ /(.*)/s; }
	@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
	$trace = $otrace;
	$single = $osingle;
	$^D = $od;
    }
    my $at = $@;
    local $saved[0];		# Preserve the old value of $@
    eval { &DB::save };
    if ($at) {
	print $OUT $at;
    } elsif ($onetimeDump eq 'dump') {
	dumpit($OUT, \@res);
    } elsif ($onetimeDump eq 'methods') {
	methods($res[0]);
    }
    @res;
}

sub postponed_sub {
  my $subname = shift;
  if ($postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s//) {
    my $offset = $1 || 0;
    # Filename below can contain ':'
    my ($file,$i) = (find_sub($subname) =~ /^(.*):(\d+)-.*$/);
    if ($i) {
      $i += $offset;
      local *dbline = $main::{'_<' . $file};
      local $^W = 0;		# != 0 is magical below
      $had_breakpoints{$file} |= 1;
      my $max = $#dbline;
      ++$i until $dbline[$i] != 0 or $i >= $max;
      $dbline{$i} = delete $postponed{$subname};
    } else {
      print $OUT "Subroutine $subname not found.\n";
    }
    return;
  }
  elsif ($postponed{$subname} eq 'compile') { $signal = 1 }
  #print $OUT "In postponed_sub for `$subname'.\n";
}

sub postponed {
  if ($ImmediateStop) {
    $ImmediateStop = 0;
    $signal = 1;
  }
  return &postponed_sub
    unless ref \$_[0] eq 'GLOB'; # A subroutine is compiled.
  # Cannot be done before the file is compiled
  local *dbline = shift;
  my $filename = $dbline;
  $filename =~ s/^_<//;
  $signal = 1, print $OUT "'$filename' loaded...\n"
    if $break_on_load{$filename};
  print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
  return unless $postponed_file{$filename};
  $had_breakpoints{$filename} |= 1;
  #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
  my $key;
  for $key (keys %{$postponed_file{$filename}}) {
    $dbline{$key} = ${$postponed_file{$filename}}{$key};
  }
  delete $postponed_file{$filename};
}

sub dumpit {
    local ($savout) = select(shift);
    my $osingle = $single;
    my $otrace = $trace;
    $single = $trace = 0;
    local $frame = 0;
    local $doret = -2;
    unless (defined &main::dumpValue) {
	do 'dumpvar.pl';
    }
    if (defined &main::dumpValue) {
	&main::dumpValue(shift);
    } else {
	print $OUT "dumpvar.pl not available.\n";
    }
    $single = $osingle;
    $trace = $otrace;
    select ($savout);    
}

# Tied method do not create a context, so may get wrong message:

sub print_trace {
  my $fh = shift;
  my @sub = dump_trace($_[0] + 1, $_[1]);
  my $short = $_[2];		# Print short report, next one for sub name
  my $s;
  for ($i=0; $i <= $#sub; $i++) {
    last if $signal;
    local $" = ', ';
    my $args = defined $sub[$i]{args} 
    ? "(@{ $sub[$i]{args} })"
      : '' ;
    $args = (substr $args, 0, $maxtrace - 3) . '...' 
      if length $args > $maxtrace;
    my $file = $sub[$i]{file};
    $file = $file eq '-e' ? $file : "file `$file'" unless $short;
    $s = $sub[$i]{sub};
    $s = (substr $s, 0, $maxtrace - 3) . '...' if length $s > $maxtrace;    
    if ($short) {
      my $sub = @_ >= 4 ? $_[3] : $s;
      print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
    } else {
      print $fh "$sub[$i]{context} = $s$args" .
	" called from $file" . 
	  " line $sub[$i]{line}\n";
    }
  }
}

sub dump_trace {
  my $skip = shift;
  my $count = shift || 1e9;
  $skip++;
  $count += $skip;
  my ($p,$file,$line,$sub,$h,$args,$e,$r,@a,@sub,$context);
  my $nothard = not $frame & 8;
  local $frame = 0;		# Do not want to trace this.
  my $otrace = $trace;
  $trace = 0;
  for ($i = $skip; 
       $i < $count and ($p,$file,$line,$sub,$h,$context,$e,$r) = caller($i); 
       $i++) {
    @a = ();
    for $arg (@args) {
      my $type;
      if (not defined $arg) {
	push @a, "undef";
      } elsif ($nothard and tied $arg) {
	push @a, "tied";
      } elsif ($nothard and $type = ref $arg) {
	push @a, "ref($type)";
      } else {
	local $_ = "$arg";	# Safe to stringify now - should not call f().
	s/([\'\\])/\\$1/g;
	s/(.*)/'$1'/s
	  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
	s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
	s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
	push(@a, $_);
      }
    }
    $context = $context ? '@' : (defined $context ? "\$" : '.');
    $args = $h ? [@a] : undef;
    $e =~ s/\n\s*\;\s*\Z// if $e;
    $e =~ s/([\\\'])/\\$1/g if $e;
    if ($r) {
      $sub = "require '$e'";
    } elsif (defined $r) {
      $sub = "eval '$e'";
    } elsif ($sub eq '(eval)') {
      $sub = "eval {...}";
    }
    push(@sub, {context => $context, sub => $sub, args => $args,
		file => $file, line => $line});
    last if $signal;
  }
  $trace = $otrace;
  @sub;
}

sub action {
    my $action = shift;
    while ($action =~ s/\\$//) {
	#print $OUT "+ ";
	#$action .= "\n";
	$action .= &gets;
    }
    $action;
}

sub unbalanced { 
    # i hate using globals!
    $balanced_brace_re ||= qr{ 
	^ \{
	      (?:
		 (?> [^{}] + )    	    # Non-parens without backtracking
	       |
		 (??{ $balanced_brace_re }) # Group with matching parens
	      ) *
	  \} $
   }x;
   return $_[0] !~ m/$balanced_brace_re/;
}

sub gets {
    &readline("cont: ");
}

sub system {
    # We save, change, then restore STDIN and STDOUT to avoid fork() since
    # some non-Unix systems can do system() but have problems with fork().
    open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
    open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");

    # XXX: using csh or tcsh destroys sigint retvals!
    system(@_);
    open(STDIN,"<&SAVEIN") || &warn("Can't restore STDIN");
    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
    close(SAVEIN); 
    close(SAVEOUT);


    # most of the $? crud was coping with broken cshisms
    if ($? >> 8) {
	&warn("(Command exited ", ($? >> 8), ")\n");
    } elsif ($?) { 
	&warn( "(Command died of SIG#",  ($? & 127),
	    (($? & 128) ? " -- core dumped" : "") , ")", "\n");
    } 

    return $?;

}

sub setterm {
    local $frame = 0;
    local $doret = -2;
    eval { require Term::ReadLine } or die $@;
    if ($notty) {
	if ($tty) {
	    open(IN,"<$tty") or die "Cannot open TTY `$TTY' for read: $!";
	    open(OUT,">$tty") or die "Cannot open TTY `$TTY' for write: $!";
	    $IN = \*IN;
	    $OUT = \*OUT;
	    my $sel = select($OUT);
	    $| = 1;
	    select($sel);
	} else {
	    eval "require Term::Rendezvous;" or die;
	    my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
	    my $term_rv = new Term::Rendezvous $rv;
	    $IN = $term_rv->IN;
	    $OUT = $term_rv->OUT;
	}
    }
    if (!$rl) {
	$term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
    } else {
	$term = new Term::ReadLine 'perldb', $IN, $OUT;

	$rl_attribs = $term->Attribs;
	$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}' 
	  if defined $rl_attribs->{basic_word_break_characters} 
	    and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
	$rl_attribs->{special_prefixes} = '$@&%';
	$rl_attribs->{completer_word_break_characters} .= '$@&%';
	$rl_attribs->{completion_function} = \&db_complete; 
    }
    $LINEINFO = $OUT unless defined $LINEINFO;
    $lineinfo = $console unless defined $lineinfo;
    $term->MinLine(2);
    if ($term->Features->{setHistory} and "@hist" ne "?") {
      $term->SetHistory(@hist);
    }
    ornaments($ornaments) if defined $ornaments;
    $term_pid = $$;
}

sub resetterm {			# We forked, so we need a different TTY
    $term_pid = $$;
    if (defined &get_fork_TTY) {
      &get_fork_TTY;
    } elsif (not defined $fork_TTY 
	     and defined $ENV{TERM} and $ENV{TERM} eq 'xterm' 
	     and defined $ENV{WINDOWID} and defined $ENV{DISPLAY}) { 
        # Possibly _inside_ XTERM
        open XT, q[3>&1 xterm -title 'Forked Perl debugger' -e sh -c 'tty 1>&3;\
 sleep 10000000' |];
        $fork_TTY = <XT>;
        chomp $fork_TTY;
    }
    if (defined $fork_TTY) {
      TTY($fork_TTY);
      undef $fork_TTY;
    } else {
      print_help(<<EOP);
I<#########> Forked, but do not know how to change a B<TTY>. I<#########>
  Define B<\$DB::fork_TTY> 
       - or a function B<DB::get_fork_TTY()> which will set B<\$DB::fork_TTY>.
  The value of B<\$DB::fork_TTY> should be the name of I<TTY> to use.
  On I<UNIX>-like systems one can get the name of a I<TTY> for the given window
  by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
EOP
    }
}

sub readline {
  local $.;
  if (@typeahead) {
    my $left = @typeahead;
    my $got = shift @typeahead;
    print $OUT "auto(-$left)", shift, $got, "\n";
    $term->AddHistory($got) 
      if length($got) > 1 and defined $term->Features->{addHistory};
    return $got;
  }
  local $frame = 0;
  local $doret = -2;
  if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) {
    $OUT->write(join('', @_));
    my $stuff;
    $IN->recv( $stuff, 2048 );  # XXX: what's wrong with sysread?
    $stuff;
  }
  else {
    $term->readline(@_);
  }
}

sub dump_option {
    my ($opt, $val)= @_;
    $val = option_val($opt,'N/A');
    $val =~ s/([\\\'])/\\$1/g;
    printf $OUT "%20s = '%s'\n", $opt, $val;
}

sub option_val {
    my ($opt, $default)= @_;
    my $val;
    if (defined $optionVars{$opt}
	and defined ${$optionVars{$opt}}) {
	$val = ${$optionVars{$opt}};
    } elsif (defined $optionAction{$opt}
	and defined &{$optionAction{$opt}}) {
	$val = &{$optionAction{$opt}}();
    } elsif (defined $optionAction{$opt}
	     and not defined $option{$opt}
	     or defined $optionVars{$opt}
	     and not defined ${$optionVars{$opt}}) {
	$val = $default;
    } else {
	$val = $option{$opt};
    }
    $val
}

sub parse_options {
    local($_)= @_;
    # too dangerous to let intuitive usage overwrite important things
    # defaultion should never be the default
    my %opt_needs_val = map { ( $_ => 1 ) } qw{
        arrayDepth hashDepth LineInfo maxTraceLen ornaments
        pager quote ReadLine recallCommand RemotePort ShellBang TTY
    };
    while (length) {
	my $val_defaulted;
	s/^\s+// && next;
	s/^(\w+)(\W?)// or print($OUT "Invalid option `$_'\n"), last;
	my ($opt,$sep) = ($1,$2);
	my $val;
	if ("?" eq $sep) {
	    print($OUT "Option query `$opt?' followed by non-space `$_'\n"), last
	      if /^\S/;
	    #&dump_option($opt);
	} elsif ($sep !~ /\S/) {
	    $val_defaulted = 1;
	    $val = "1";  #  this is an evil default; make 'em set it!
	} elsif ($sep eq "=") {

            if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x) { 
                my $quote = $1;
                ($val = $2) =~ s/\\([$quote\\])/$1/g;
	    } else { 
		s/^(\S*)//;
	    $val = $1;
		print OUT qq(Option better cleared using $opt=""\n)
		    unless length $val;
	    }

	} else { #{ to "let some poor schmuck bounce on the % key in B<vi>."
	    my ($end) = "\\" . substr( ")]>}$sep", index("([<{",$sep), 1 ); #}
	    s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)// or
	      print($OUT "Unclosed option value `$opt$sep$_'\n"), last;
	    ($val = $1) =~ s/\\([\\$end])/$1/g;
	}

	my $option;
	my $matches = grep( /^\Q$opt/  && ($option = $_),  @options  )
		   || grep( /^\Q$opt/i && ($option = $_),  @options  );

	print($OUT "Unknown option `$opt'\n"), next 	unless $matches;
	print($OUT "Ambiguous option `$opt'\n"), next 	if $matches > 1;

       if ($opt_needs_val{$option} && $val_defaulted) {
	    print $OUT "Option `$opt' is non-boolean.  Use `O $option=VAL' to set, `O $option?' to query\n";
	    next;
	} 

	$option{$option} = $val if defined $val;

	eval qq{
		local \$frame = 0; 
		local \$doret = -2; 
	        require '$optionRequire{$option}';
		1;
	 } || die  # XXX: shouldn't happen
	    if  defined $optionRequire{$option}	    &&
	        defined $val;

	${$optionVars{$option}} = $val 	    
	    if  defined $optionVars{$option}        &&
		defined $val;

	&{$optionAction{$option}} ($val)    
	    if defined $optionAction{$option}	    &&
               defined &{$optionAction{$option}}    &&
               defined $val;

	# Not $rcfile
	dump_option($option) 	unless $OUT eq \*STDERR; 
    }
}

sub set_list {
  my ($stem,@list) = @_;
  my $val;
  $ENV{"${stem}_n"} = @list;
  for $i (0 .. $#list) {
    $val = $list[$i];
    $val =~ s/\\/\\\\/g;
    $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
    $ENV{"${stem}_$i"} = $val;
  }
}

sub get_list {
  my $stem = shift;
  my @list;
  my $n = delete $ENV{"${stem}_n"};
  my $val;
  for $i (0 .. $n - 1) {
    $val = delete $ENV{"${stem}_$i"};
    $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
    push @list, $val;
  }
  @list;
}

sub catch {
    $signal = 1;
    return;			# Put nothing on the stack - malloc/free land!
}

sub warn {
    my($msg)= join("",@_);
    $msg .= ": $!\n" unless $msg =~ /\n$/;
    print $OUT $msg;
}

sub TTY {
    if (@_ and $term and $term->Features->{newTTY}) {
      my ($in, $out) = shift;
      if ($in =~ /,/) {
	($in, $out) = split /,/, $in, 2;
      } else {
	$out = $in;
      }
      open IN, $in or die "cannot open `$in' for read: $!";
      open OUT, ">$out" or die "cannot open `$out' for write: $!";
      $term->newTTY(\*IN, \*OUT);
      $IN	= \*IN;
      $OUT	= \*OUT;
      return $tty = $in;
    } elsif ($term and @_) {
	&warn("Too late to set TTY, enabled on next `R'!\n");
    } 
    $tty = shift if @_;
    $tty or $console;
}

sub noTTY {
    if ($term) {
	&warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
    }
    $notty = shift if @_;
    $notty;
}

sub ReadLine {
    if ($term) {
	&warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
    }
    $rl = shift if @_;
    $rl;
}

sub RemotePort {
    if ($term) {
        &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_;
    }
    $remoteport = shift if @_;
    $remoteport;
}

sub tkRunning {
    if (${$term->Features}{tkRunning}) {
        return $term->tkRunning(@_);
    } else {
	print $OUT "tkRunning not supported by current ReadLine package.\n";
	0;
    }
}

sub NonStop {
    if ($term) {
	&warn("Too late to set up NonStop mode, enabled on next `R'!\n") if @_;
    }
    $runnonstop = shift if @_;
    $runnonstop;
}

sub pager {
    if (@_) {
	$pager = shift;
	$pager="|".$pager unless $pager =~ /^(\+?\>|\|)/;
    }
    $pager;
}

sub shellBang {
    if (@_) {
	$sh = quotemeta shift;
	$sh .= "\\b" if $sh =~ /\w$/;
    }
    $psh = $sh;
    $psh =~ s/\\b$//;
    $psh =~ s/\\(.)/$1/g;
    &sethelp;
    $psh;
}

sub ornaments {
  if (defined $term) {
    local ($warnLevel,$dieLevel) = (0, 1);
    return '' unless $term->Features->{ornaments};
    eval { $term->ornaments(@_) } || '';
  } else {
    $ornaments = shift;
  }
}

sub recallCommand {
    if (@_) {
	$rc = quotemeta shift;
	$rc .= "\\b" if $rc =~ /\w$/;
    }
    $prc = $rc;
    $prc =~ s/\\b$//;
    $prc =~ s/\\(.)/$1/g;
    &sethelp;
    $prc;
}

sub LineInfo {
    return $lineinfo unless @_;
    $lineinfo = shift;
    my $stream = ($lineinfo =~ /^(\+?\>|\|)/) ? $lineinfo : ">$lineinfo";
    $slave_editor = ($stream =~ /^\|/);
    open(LINEINFO, "$stream") || &warn("Cannot open `$stream' for write");
    $LINEINFO = \*LINEINFO;
    my $save = select($LINEINFO);
    $| = 1;
    select($save);
    $lineinfo;
}

sub list_versions {
  my %version;
  my $file;
  for (keys %INC) {
    $file = $_;
    s,\.p[lm]$,,i ;
    s,/,::,g ;
    s/^perl5db$/DB/;
    s/^Term::ReadLine::readline$/readline/;
    if (defined ${ $_ . '::VERSION' }) {
      $version{$file} = "${ $_ . '::VERSION' } from ";
    } 
    $version{$file} .= $INC{$file};
  }
  dumpit($OUT,\%version);
}

sub sethelp {
    # XXX: make sure these are tabs between the command and explantion,
    #      or print_help will screw up your formatting if you have
    #      eeevil ornaments enabled.  This is an insane mess.

    $help = "
B<T>		Stack trace.
B<s> [I<expr>]	Single step [in I<expr>].
B<n> [I<expr>]	Next, steps over subroutine calls [in I<expr>].
<B<CR>>		Repeat last B<n> or B<s> command.
B<r>		Return from current subroutine.
B<c> [I<line>|I<sub>]	Continue; optionally inserts a one-time-only breakpoint
		at the specified position.
B<l> I<min>B<+>I<incr>	List I<incr>+1 lines starting at I<min>.
B<l> I<min>B<->I<max>	List lines I<min> through I<max>.
B<l> I<line>		List single I<line>.
B<l> I<subname>	List first window of lines from subroutine.
B<l> I<\$var>		List first window of lines from subroutine referenced by I<\$var>.
B<l>		List next window of lines.
B<->		List previous window of lines.
B<w> [I<line>]	List window around I<line>.
B<.>		Return to the executed line.
B<f> I<filename>	Switch to viewing I<filename>. File must be already loaded.
		I<filename> may be either the full name of the file, or a regular
		expression matching the full file name:
		B<f> I</home/me/foo.pl> and B<f> I<oo\\.> may access the same file.
		Evals (with saved bodies) are considered to be filenames:
		B<f> I<(eval 7)> and B<f> I<eval 7\\b> access the body of the 7th eval
		(in the order of execution).
B</>I<pattern>B</>	Search forwards for I<pattern>; final B</> is optional.
B<?>I<pattern>B<?>	Search backwards for I<pattern>; final B<?> is optional.
B<L>		List all breakpoints and actions.
B<S> [[B<!>]I<pattern>]	List subroutine names [not] matching I<pattern>.
B<t>		Toggle trace mode.
B<t> I<expr>		Trace through execution of I<expr>.
B<b> [I<line>] [I<condition>]
		Set breakpoint; I<line> defaults to the current execution line;
		I<condition> breaks if it evaluates to true, defaults to '1'.
B<b> I<subname> [I<condition>]
		Set breakpoint at first line of subroutine.
B<b> I<\$var>		Set breakpoint at first line of subroutine referenced by I<\$var>.
B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
B<b> B<postpone> I<subname> [I<condition>]
		Set breakpoint at first line of subroutine after 
		it is compiled.
B<b> B<compile> I<subname>
		Stop after the subroutine is compiled.
B<d> [I<line>]	Delete the breakpoint for I<line>.
B<D>		Delete all breakpoints.
B<a> [I<line>] I<command>
		Set an action to be done before the I<line> is executed;
		I<line> defaults to the current execution line.
		Sequence is: check for breakpoint/watchpoint, print line
		if necessary, do action, prompt user if necessary,
		execute line.
B<a> [I<line>]	Delete the action for I<line>.
B<A>		Delete all actions.
B<W> I<expr>		Add a global watch-expression.
B<W>		Delete all watch-expressions.
B<V> [I<pkg> [I<vars>]]	List some (default all) variables in package (default current).
		Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
B<X> [I<vars>]	Same as \"B<V> I<currentpackage> [I<vars>]\".
B<x> I<expr>		Evals expression in list context, dumps the result.
B<m> I<expr>		Evals expression in list context, prints methods callable
		on the first element of the result.
B<m> I<class>		Prints methods callable via the given class.

B<<> ?			List Perl commands to run before each prompt.
B<<> I<expr>		Define Perl command to run before each prompt.
B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
B<>> ?			List Perl commands to run after each prompt.
B<>> I<expr>		Define Perl command to run after each prompt.
B<>>B<>> I<expr>		Add to the list of Perl commands to run after each prompt.
B<{> I<db_command>	Define debugger command to run before each prompt.
B<{> ?			List debugger commands to run before each prompt.
B<<> I<expr>		Define Perl command to run before each prompt.
B<{{> I<db_command>	Add to the list of debugger commands to run before each prompt.
B<$prc> I<number>	Redo a previous command (default previous command).
B<$prc> I<-number>	Redo number'th-to-last command.
B<$prc> I<pattern>	Redo last command that started with I<pattern>.
		See 'B<O> I<recallCommand>' too.
B<$psh$psh> I<cmd>  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
  . ( $rc eq $sh ? "" : "
B<$psh> [I<cmd>] 	Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
		See 'B<O> I<shellBang>' too.
B<H> I<-number>	Display last number commands (default all).
B<p> I<expr>		Same as \"I<print {DB::OUT} expr>\" in current package.
B<|>I<dbcmd>		Run debugger command, piping DB::OUT to current pager.
B<||>I<dbcmd>		Same as B<|>I<dbcmd> but DB::OUT is temporarilly select()ed as well.
B<\=> [I<alias> I<value>]	Define a command alias, or list current aliases.
I<command>		Execute as a perl statement in current package.
B<v>		Show versions of loaded modules.
B<R>		Pure-man-restart of debugger, some of debugger state
		and command-line options may be lost.
		Currently the following setting are preserved: 
		history, breakpoints and actions, debugger B<O>ptions 
		and the following command-line options: I<-w>, I<-I>, I<-e>.

B<O> [I<opt>] ...	Set boolean option to true
B<O> [I<opt>B<?>]	Query options
B<O> [I<opt>B<=>I<val>] [I<opt>=B<\">I<val>B<\">] ... 
		Set options.  Use quotes in spaces in value.
    I<recallCommand>, I<ShellBang>	chars used to recall command or spawn shell;
    I<pager>			program for output of \"|cmd\";
    I<tkRunning>			run Tk while prompting (with ReadLine);
    I<signalLevel> I<warnLevel> I<dieLevel>	level of verbosity;
    I<inhibit_exit>		Allows stepping off the end of the script.
    I<ImmediateStop>		Debugger should stop as early as possible.
    I<RemotePort>			Remote hostname:port for remote debugging
  The following options affect what happens with B<V>, B<X>, and B<x> commands:
    I<arrayDepth>, I<hashDepth> 	print only first N elements ('' for all);
    I<compactDump>, I<veryCompact> 	change style of array and hash dump;
    I<globPrint> 			whether to print contents of globs;
    I<DumpDBFiles> 		dump arrays holding debugged files;
    I<DumpPackages> 		dump symbol tables of packages;
    I<DumpReused> 			dump contents of \"reused\" addresses;
    I<quote>, I<HighBit>, I<undefPrint> 	change style of string dump;
    I<bareStringify> 		Do not print the overload-stringified value;
  Other options include:
    I<PrintRet>		affects printing of return value after B<r> command,
    I<frame>		affects printing messages on entry and exit from subroutines.
    I<AutoTrace>	affects printing messages on every possible breaking point.
    I<maxTraceLen>	gives maximal length of evals/args listed in stack trace.
    I<ornaments> 	affects screen appearance of the command line.
	During startup options are initialized from \$ENV{PERLDB_OPTS}.
	You can put additional initialization options I<TTY>, I<noTTY>,
	I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
	`B<R>' after you set them).

B<q> or B<^D>		Quit. Set B<\$DB::finished = 0> to debug global destruction.
B<h> [I<db_command>]	Get help [on a specific debugger command], enter B<|h> to page.
B<h h>		Summary of debugger commands.
B<$doccmd> I<manpage>	Runs the external doc viewer B<$doccmd> command on the 
		named Perl I<manpage>, or on B<$doccmd> itself if omitted.
		Set B<\$DB::doccmd> to change viewer.

Type `|h' for a paged display if this was too hard to read.

"; # Fix balance of vi % matching: } }}

    $summary = <<"END_SUM";
I<List/search source lines:>               I<Control script execution:>
  B<l> [I<ln>|I<sub>]  List source code            B<T>           Stack trace
  B<-> or B<.>      List previous/current line  B<s> [I<expr>]    Single step [in expr]
  B<w> [I<line>]    List around line            B<n> [I<expr>]    Next, steps over subs
  B<f> I<filename>  View source in file         <B<CR>/B<Enter>>  Repeat last B<n> or B<s>
  B</>I<pattern>B</> B<?>I<patt>B<?>   Search forw/backw    B<r>           Return from subroutine
  B<v>	      Show versions of modules    B<c> [I<ln>|I<sub>]  Continue until position
I<Debugger controls:>                        B<L>           List break/watch/actions
  B<O> [...]     Set debugger options        B<t> [I<expr>]    Toggle trace [trace expr]
  B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
  B<$prc> [I<N>|I<pat>]   Redo a previous command     B<d> [I<ln>] or B<D> Delete a/all breakpoints
  B<H> [I<-num>]    Display last num commands   B<a> [I<ln>] I<cmd>  Do cmd before line
  B<=> [I<a> I<val>]   Define/list an alias        B<W> I<expr>      Add a watch expression
  B<h> [I<db_cmd>]  Get help on command         B<A> or B<W>      Delete all actions/watch
  B<|>[B<|>]I<db_cmd>  Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
  B<q> or B<^D>     Quit			  B<R>	      Attempt a restart
I<Data Examination:>	      B<expr>     Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
  B<x>|B<m> I<expr>	Evals expr in list context, dumps the result or lists methods.
  B<p> I<expr>	Print expression (uses script's current package).
  B<S> [[B<!>]I<pat>]	List subroutine names [not] matching pattern
  B<V> [I<Pk> [I<Vars>]]	List Variables in Package.  Vars can be ~pattern or !pattern.
  B<X> [I<Vars>]	Same as \"B<V> I<current_package> [I<Vars>]\".
For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
END_SUM
				# ')}}; # Fix balance of vi % matching
}

sub print_help {
    local $_ = shift;

    # Restore proper alignment destroyed by eeevil I<> and B<>
    # ornaments: A pox on both their houses!
    #
    # A help command will have everything up to and including
    # the first tab sequence paddeed into a field 16 (or if indented 20)
    # wide.  If it's wide than that, an extra space will be added.
    s{
	^ 		    	# only matters at start of line
	  ( \040{4} | \t )*	# some subcommands are indented
	  ( < ? 		# so <CR> works
	    [BI] < [^\t\n] + )  # find an eeevil ornament
	  ( \t+ )		# original separation, discarded
	  ( .* )		# this will now start (no earlier) than 
				# column 16
    } {
	my($leadwhite, $command, $midwhite, $text) = ($1, $2, $3, $4);
	my $clean = $command;
	$clean =~ s/[BI]<([^>]*)>/$1/g;  
    # replace with this whole string:
	(length($leadwhite) ? " " x 4 : "")
      . $command
      . ((" " x (16 + (length($leadwhite) ? 4 : 0) - length($clean))) || " ")
      . $text;

    }mgex;

    s{				# handle bold ornaments
	B < ( [^>] + | > ) >
    } {
	  $Term::ReadLine::TermCap::rl_term_set[2] 
	. $1
	. $Term::ReadLine::TermCap::rl_term_set[3]
    }gex;

    s{				# handle italic ornaments
	I < ( [^>] + | > ) >
    } {
	  $Term::ReadLine::TermCap::rl_term_set[0] 
	. $1
	. $Term::ReadLine::TermCap::rl_term_set[1]
    }gex;

    print $OUT $_;
}

sub fix_less {
    return if defined $ENV{LESS} && $ENV{LESS} =~ /r/;
    my $is_less = $pager =~ /\bless\b/;
    if ($pager =~ /\bmore\b/) { 
	my @st_more = stat('/usr/bin/more');
	my @st_less = stat('/usr/bin/less');
	$is_less = @st_more    && @st_less 
		&& $st_more[0] == $st_less[0] 
		&& $st_more[1] == $st_less[1];
    }
    # changes environment!
    $ENV{LESS} .= 'r' 	if $is_less;
}

sub diesignal {
    local $frame = 0;
    local $doret = -2;
    $SIG{'ABRT'} = 'DEFAULT';
    kill 'ABRT', $$ if $panic++;
    if (defined &Carp::longmess) {
	local $SIG{__WARN__} = '';
	local $Carp::CarpLevel = 2;		# mydie + confess
	&warn(Carp::longmess("Signal @_"));
    }
    else {
	print $DB::OUT "Got signal @_\n";
    }
    kill 'ABRT', $$;
}

sub dbwarn { 
  local $frame = 0;
  local $doret = -2;
  local $SIG{__WARN__} = '';
  local $SIG{__DIE__} = '';
  eval { require Carp } if defined $^S;	# If error/warning during compilation,
                                        # require may be broken.
  warn(@_, "\nCannot print stack trace, load with -MCarp option to see stack"),
    return unless defined &Carp::longmess;
  my ($mysingle,$mytrace) = ($single,$trace);
  $single = 0; $trace = 0;
  my $mess = Carp::longmess(@_);
  ($single,$trace) = ($mysingle,$mytrace);
  &warn($mess); 
}

sub dbdie {
  local $frame = 0;
  local $doret = -2;
  local $SIG{__DIE__} = '';
  local $SIG{__WARN__} = '';
  my $i = 0; my $ineval = 0; my $sub;
  if ($dieLevel > 2) {
      local $SIG{__WARN__} = \&dbwarn;
      &warn(@_);		# Yell no matter what
      return;
  }
  if ($dieLevel < 2) {
    die @_ if $^S;		# in eval propagate
  }
  eval { require Carp } if defined $^S;	# If error/warning during compilation,
                                	# require may be broken.

  die(@_, "\nCannot print stack trace, load with -MCarp option to see stack")
    unless defined &Carp::longmess;

  # We do not want to debug this chunk (automatic disabling works
  # inside DB::DB, but not in Carp).
  my ($mysingle,$mytrace) = ($single,$trace);
  $single = 0; $trace = 0;
  my $mess = Carp::longmess(@_);
  ($single,$trace) = ($mysingle,$mytrace);
  die $mess;
}

sub warnLevel {
  if (@_) {
    $prevwarn = $SIG{__WARN__} unless $warnLevel;
    $warnLevel = shift;
    if ($warnLevel) {
      $SIG{__WARN__} = \&DB::dbwarn;
    } else {
      $SIG{__WARN__} = $prevwarn;
    }
  }
  $warnLevel;
}

sub dieLevel {
  if (@_) {
    $prevdie = $SIG{__DIE__} unless $dieLevel;
    $dieLevel = shift;
    if ($dieLevel) {
      $SIG{__DIE__} = \&DB::dbdie; # if $dieLevel < 2;
      #$SIG{__DIE__} = \&DB::diehard if $dieLevel >= 2;
      print $OUT "Stack dump during die enabled", 
        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n"
	  if $I_m_init;
      print $OUT "Dump printed too.\n" if $dieLevel > 2;
    } else {
      $SIG{__DIE__} = $prevdie;
      print $OUT "Default die handler restored.\n";
    }
  }
  $dieLevel;
}

sub signalLevel {
  if (@_) {
    $prevsegv = $SIG{SEGV} unless $signalLevel;
    $prevbus = $SIG{BUS} unless $signalLevel;
    $signalLevel = shift;
    if ($signalLevel) {
      $SIG{SEGV} = \&DB::diesignal;
      $SIG{BUS} = \&DB::diesignal;
    } else {
      $SIG{SEGV} = $prevsegv;
      $SIG{BUS} = $prevbus;
    }
  }
  $signalLevel;
}

sub CvGV_name {
  my $in = shift;
  my $name = CvGV_name_or_bust($in);
  defined $name ? $name : $in;
}

sub CvGV_name_or_bust {
  my $in = shift;
  return if $skipCvGV;		# Backdoor to avoid problems if XS broken...
  $in = \&$in;			# Hard reference...
  eval {require Devel::Peek; 1} or return;
  my $gv = Devel::Peek::CvGV($in) or return;
  *$gv{PACKAGE} . '::' . *$gv{NAME};
}

sub find_sub {
  my $subr = shift;
  $sub{$subr} or do {
    return unless defined &$subr;
    my $name = CvGV_name_or_bust($subr);
    my $data;
    $data = $sub{$name} if defined $name;
    return $data if defined $data;

    # Old stupid way...
    $subr = \&$subr;		# Hard reference
    my $s;
    for (keys %sub) {
      $s = $_, last if $subr eq \&$_;
    }
    $sub{$s} if $s;
  }
}

sub methods {
  my $class = shift;
  $class = ref $class if ref $class;
  local %seen;
  local %packs;
  methods_via($class, '', 1);
  methods_via('UNIVERSAL', 'UNIVERSAL', 0);
}

sub methods_via {
  my $class = shift;
  return if $packs{$class}++;
  my $prefix = shift;
  my $prepend = $prefix ? "via $prefix: " : '';
  my $name;
  for $name (grep {defined &{${"${class}::"}{$_}}} 
	     sort keys %{"${class}::"}) {
    next if $seen{ $name }++;
    print $DB::OUT "$prepend$name\n";
  }
  return unless shift;		# Recurse?
  for $name (@{"${class}::ISA"}) {
    $prepend = $prefix ? $prefix . " -> $name" : $name;
    methods_via($name, $prepend, 1);
  }
}

sub setman { 
    $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS)\z/s
		? "man"             # O Happy Day!
		: "perldoc";        # Alas, poor unfortunates
}

sub runman {
    my $page = shift;
    unless ($page) {
	&system("$doccmd $doccmd");
	return;
    } 
    # this way user can override, like with $doccmd="man -Mwhatever"
    # or even just "man " to disable the path check.
    unless ($doccmd eq 'man') {
	&system("$doccmd $page");
	return;
    } 

    $page = 'perl' if lc($page) eq 'help';

    require Config;
    my $man1dir = $Config::Config{'man1dir'};
    my $man3dir = $Config::Config{'man3dir'};
    for ($man1dir, $man3dir) { s#/[^/]*\z## if /\S/ } 
    my $manpath = '';
    $manpath .= "$man1dir:" if $man1dir =~ /\S/;
    $manpath .= "$man3dir:" if $man3dir =~ /\S/ && $man1dir ne $man3dir;
    chop $manpath if $manpath;
    # harmless if missing, I figure
    my $oldpath = $ENV{MANPATH};
    $ENV{MANPATH} = $manpath if $manpath;
    my $nopathopt = $^O =~ /dunno what goes here/;
    if (system($doccmd, 
		# I just *know* there are men without -M
		(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),  
	    split ' ', $page) )
    {
	unless ($page =~ /^perl\w/) {
	    if (grep { $page eq $_ } qw{ 
		5004delta 5005delta amiga api apio book boot bot call compile
		cygwin data dbmfilter debug debguts delta diag doc dos dsc embed
		faq faq1 faq2 faq3 faq4 faq5 faq6 faq7 faq8 faq9 filter fork
		form func guts hack hist hpux intern ipc lexwarn locale lol mod
		modinstall modlib number obj op opentut os2 os390 pod port 
		ref reftut run sec style sub syn thrtut tie toc todo toot tootc
		trap unicode var vms win32 xs xstut
	      }) 
	    {
		$page =~ s/^/perl/;
		system($doccmd, 
			(($manpath && !$nopathopt) ? ("-M", $manpath) : ()),  
			$page);
	    }
	}
    } 
    if (defined $oldpath) {
	$ENV{MANPATH} = $manpath;
    } else {
	delete $ENV{MANPATH};
    } 
} 

# The following BEGIN is very handy if debugger goes havoc, debugging debugger?

BEGIN {			# This does not compile, alas.
  $IN = \*STDIN;		# For bugs before DB::OUT has been opened
  $OUT = \*STDERR;		# For errors before DB::OUT has been opened
  $sh = '!';
  $rc = ',';
  @hist = ('?');
  $deep = 100;			# warning if stack gets this deep
  $window = 10;
  $preview = 3;
  $sub = '';
  $SIG{INT} = \&DB::catch;
  # This may be enabled to debug debugger:
  #$warnLevel = 1 unless defined $warnLevel;
  #$dieLevel = 1 unless defined $dieLevel;
  #$signalLevel = 1 unless defined $signalLevel;

  $db_stop = 0;			# Compiler warning
  $db_stop = 1 << 30;
  $level = 0;			# Level of recursive debugging
  # @stack and $doret are needed in sub sub, which is called for DB::postponed.
  # Triggers bug (?) in perl is we postpone this until runtime:
  @postponed = @stack = (0);
  $stack_depth = 0;		# Localized $#stack
  $doret = -2;
  $frame = 0;
}

BEGIN {$^W = $ini_warn;}	# Switch warnings back

#use Carp;			# This did break, left for debuggin

sub db_complete {
  # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
  my($text, $line, $start) = @_;
  my ($itext, $search, $prefix, $pack) =
    ($text, "^\Q${'package'}::\E([^:]+)\$");
  
  return sort grep /^\Q$text/, (keys %sub), qw(postpone load compile), # subroutines
                               (map { /$search/ ? ($1) : () } keys %sub)
    if (substr $line, 0, $start) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
  return sort grep /^\Q$text/, values %INC # files
    if (substr $line, 0, $start) =~ /^\|*b\s+load\s+$/;
  return sort map {($_, db_complete($_ . "::", "V ", 2))}
    grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : ()} keys %:: # top-packages
      if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ and $text =~ /^\w*$/;
  return sort map {($_, db_complete($_ . "::", "V ", 2))}
    grep !/^main::/,
      grep /^\Q$text/, map { /^(.*)::$/ ? ($prefix . "::$1") : ()} keys %{$prefix . '::'}
				 # packages
	if (substr $line, 0, $start) =~ /^\|*[Vm]\s+$/ 
	  and $text =~ /^(.*[^:])::?(\w*)$/  and $prefix = $1;
  if ( $line =~ /^\|*f\s+(.*)/ ) { # Loaded files
    # We may want to complete to (eval 9), so $text may be wrong
    $prefix = length($1) - length($text);
    $text = $1;
    return sort 
	map {substr $_, 2 + $prefix} grep /^_<\Q$text/, (keys %main::), $0
  }
  if ((substr $text, 0, 1) eq '&') { # subroutines
    $text = substr $text, 1;
    $prefix = "&";
    return sort map "$prefix$_", 
               grep /^\Q$text/, 
                 (keys %sub),
                 (map { /$search/ ? ($1) : () } 
		    keys %sub);
  }
  if ($text =~ /^[\$@%](.*)::(.*)/) { # symbols in a package
    $pack = ($1 eq 'main' ? '' : $1) . '::';
    $prefix = (substr $text, 0, 1) . $1 . '::';
    $text = $2;
    my @out 
      = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/, keys %$pack ;
    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
      return db_complete($out[0], $line, $start);
    }
    return sort @out;
  }
  if ($text =~ /^[\$@%]/) { # symbols (in $package + packages in main)
    $pack = ($package eq 'main' ? '' : $package) . '::';
    $prefix = substr $text, 0, 1;
    $text = substr $text, 1;
    my @out = map "$prefix$_", grep /^\Q$text/, 
       (grep /^_?[a-zA-Z]/, keys %$pack), 
       ( $pack eq '::' ? () : (grep /::$/, keys %::) ) ;
    if (@out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext) {
      return db_complete($out[0], $line, $start);
    }
    return sort @out;
  }
  if ((substr $line, 0, $start) =~ /^\|*O\b.*\s$/) { # Options after a space
    my @out = grep /^\Q$text/, @options;
    my $val = option_val($out[0], undef);
    my $out = '? ';
    if (not defined $val or $val =~ /[\n\r]/) {
      # Can do nothing better
    } elsif ($val =~ /\s/) {
      my $found;
      foreach $l (split //, qq/\"\'\#\|/) {
	$out = "$l$val$l ", last if (index $val, $l) == -1;
      }
    } else {
      $out = "=$val ";
    }
    # Default to value if one completion, to question if many
    $rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
    return sort @out;
  }
  return $term->filename_list($text); # filenames
}

sub end_report {
  print $OUT "Use `q' to quit or `R' to restart.  `h q' for details.\n"
}

END {
  $finished = 1 if $inhibit_exit;      # So that some keys may be disabled.
  $fall_off_end = 1 unless $inhibit_exit;
  # Do not stop in at_exit() and destructors on exit:
  $DB::single = !$fall_off_end && !$runnonstop;
  DB::fake::at_exit() unless $fall_off_end or $runnonstop;
}

package DB::fake;

sub at_exit {
  "Debugged program terminated.  Use `q' to quit or `R' to restart.";
}

package DB;			# Do not trace this 1; below!

1;
mething to get a list of users;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################
# Pod/Checker.pm -- check pod documents for syntax errors
#
# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Checker;

use vars qw($VERSION);
$VERSION = 1.2;  ## Current version of this package
require  5.005;    ## requires this Perl version or later

use Pod::ParseUtils; ## for hyperlinks and lists

=head1 NAME

Pod::Checker, podchecker() - check pod documents for syntax errors

=head1 SYNOPSIS

  use Pod::Checker;

  $syntax_okay = podchecker($filepath, $outputpath, %options);

  my $checker = new Pod::Checker %options;
  $checker->parse_from_file($filepath, \*STDERR);

=head1 OPTIONS/ARGUMENTS

C<$filepath> is the input POD to read and C<$outputpath> is
where to write POD syntax error messages. Either argument may be a scalar
indicating a file-path, or else a reference to an open filehandle.
If unspecified, the input-file it defaults to C<\*STDIN>, and
the output-file defaults to C<\*STDERR>.

=head2 podchecker()

This function can take a hash of options:

=over 4

=item B<-warnings> =E<gt> I<val>

Turn warnings on/off. I<val> is usually 1 for on, but higher values
trigger additional warnings. See L<"Warnings">.

=back

=head1 DESCRIPTION

B<podchecker> will perform syntax checking of Perl5 POD format documentation.

I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!>

It is hoped that curious/ambitious user will help flesh out and add the
additional features they wish to see in B<Pod::Checker> and B<podchecker>
and verify that the checks are consistent with L<perlpod>.

The following checks are currently preformed:

=over 4

=item *

Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,
and unterminated interior sequences.

=item *

Check for proper balancing of C<=begin> and C<=end>. The contents of such
a block are generally ignored, i.e. no syntax checks are performed.

=item *

Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.

=item *

Check for same nested interior-sequences (e.g. 
C<LE<lt>...LE<lt>...E<gt>...E<gt>>).

=item *

Check for malformed or nonexisting entities C<EE<lt>...E<gt>>.

=item *

Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod>
for details.

=item *

Check for unresolved document-internal links. This check may also reveal
misspelled links that seem to be internal links but should be links
to something else.

=back

=head1 DIAGNOSTICS

=head2 Errors

=over 4

=item * empty =headn

A heading (C<=head1> or C<=head2>) without any text? That ain't no
heading!

=item * =over on line I<N> without closing =back

The C<=over> command does not have a corresponding C<=back> before the
next heading (C<=head1> or C<=head2>) or the end of the file.

=item * =item without previous =over

=item * =back without previous =over

An C<=item> or C<=back> command has been found outside a
C<=over>/C<=back> block.

=item * No argument for =begin

A C<=begin> command was found that is not followed by the formatter
specification.

=item * =end without =begin

A standalone C<=end> command was found.

=item * Nested =begin's

There were at least two consecutive C<=begin> commands without
the corresponding C<=end>. Only one C<=begin> may be active at
a time.

=item * =for without formatter specification

There is no specification of the formatter after the C<=for> command.

=item * unresolved internal link I<NAME>

The given link to I<NAME> does not have a matching node in the current
POD. This also happend when a single word node name is not enclosed in
C<"">.

=item * Unknown command "I<CMD>"

An invalid POD command has been found. Valid are C<=head1>, C<=head2>,
C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>,
C<=cut>

=item * Unknown interior-sequence "I<SEQ>"

An invalid markup command has been encountered. Valid are:
C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, 
C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, 
C<ZE<lt>E<gt>>

=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>

Two nested identical markup commands have been found. Generally this
does not make sense.

=item * garbled entity I<STRING>

The I<STRING> found cannot be interpreted as a character entity.

=item * Entity number out of range

An entity specified by number (dec, hex, oct) is out of range (1-255).

=item * malformed link LE<lt>E<gt>

The link found cannot be parsed because it does not conform to the
syntax described in L<perlpod>.

=item * nonempty ZE<lt>E<gt>

The C<ZE<lt>E<gt>> sequence is supposed to be empty.

=item * empty XE<lt>E<gt>

The index entry specified contains nothing but whitespace.

=item * Spurious text after =pod / =cut

The commands C<=pod> and C<=cut> do not take any arguments.

=item * Spurious character(s) after =back

The C<=back> command does not take any arguments.

=back

=head2 Warnings

These may not necessarily cause trouble, but indicate mediocre style.

=over 4

=item * multiple occurence of link target I<name>

The POD file has some C<=item> and/or C<=head> commands that have
the same text. Potential hyperlinks to such a text cannot be unique then.

=item * line containing nothing but whitespace in paragraph

There is some whitespace on a seemingly empty line. POD is very sensitive
to such things, so this is flagged. B<vi> users switch on the B<list>
option to avoid this problem.

=begin _disabled_

=item * file does not start with =head

The file starts with a different POD directive than head.
This is most probably something you do not want.

=end _disabled_

=item * previous =item has no contents

There is a list C<=item> right above the flagged line that has no
text contents. You probably want to delete empty items.

=item * preceding non-item paragraph(s)

A list introduced by C<=over> starts with a text or verbatim paragraph,
but continues with C<=item>s. Move the non-item paragraph out of the
C<=over>/C<=back> block.

=item * =item type mismatch (I<one> vs. I<two>)

A list started with e.g. a bulletted C<=item> and continued with a
numbered one. This is obviously inconsistent. For most translators the
type of the I<first> C<=item> determines the type of the list.

=item * I<N> unescaped C<E<lt>E<gt>> in paragraph

Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>
can potentially cause errors as they could be misinterpreted as
markup commands. This is only printed when the -warnings level is
greater than 1.

=item * Unknown entity

A character entity was found that does not belong to the standard
ISO set or the POD specials C<verbar> and C<sol>.

=item * No items in =over

The list opened with C<=over> does not contain any items.

=item * No argument for =item

C<=item> without any parameters is deprecated. It should either be followed
by C<*> to indicate an unordered list, by a number (optionally followed
by a dot) to indicate an ordered (numbered) list or simple text for a
definition list.

=item * empty section in previous paragraph

The previous section (introduced by a C<=head> command) does not contain
any text. This usually indicates that something is missing. Note: A 
C<=head1> followed immediately by C<=head2> does not trigger this warning.

=item * Verbatim paragraph in NAME section

The NAME section (C<=head1 NAME>) should consist of a single paragraph
with the script/module name, followed by a dash `-' and a very short
description of what the thing is good for.

=back

=head2 Hyperlinks

There are some warnings wrt. malformed hyperlinks.

=over 4

=item * ignoring leading/trailing whitespace in link

There is whitespace at the beginning or the end of the contents of 
LE<lt>...E<gt>.

=item * (section) in '$page' deprecated

There is a section detected in the page name of LE<lt>...E<gt>, e.g.
C<LE<gt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.
Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able
to expand this to appropriate code. For links to (builtin) functions,
please say C<LE<lt>perlfunc/mkdirE<gt>>, without ().

=item * alternative text/node '%s' contains non-escaped | or /

The characters C<|> and C</> are special in the LE<lt>...E<gt> context.
Although the hyperlink parser does its best to determine which "/" is
text and which is a delimiter in case of doubt, one ought to escape
these literal characters like this:

  /     E<sol>
  |     E<verbar>

=back

=head1 RETURN VALUE

B<podchecker> returns the number of POD syntax errors found or -1 if
there were no POD commands at all found in the file.

=head1 EXAMPLES

I<[T.B.D.]>

=head1 INTERFACE

While checking, this module collects document properties, e.g. the nodes
for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).
POD translators can use this feature to syntax-check and get the nodes in
a first pass before actually starting to convert. This is expensive in terms
of execution time, but allows for very robust conversions.

=cut

#############################################################################

use strict;
#use diagnostics;
use Carp;
use Exporter;
use Pod::Parser;

use vars qw(@ISA @EXPORT);
@ISA = qw(Pod::Parser);
@EXPORT = qw(&podchecker);

use vars qw(%VALID_COMMANDS %VALID_SEQUENCES);

my %VALID_COMMANDS = (
    'pod'    =>  1,
    'cut'    =>  1,
    'head1'  =>  1,
    'head2'  =>  1,
    'over'   =>  1,
    'back'   =>  1,
    'item'   =>  1,
    'for'    =>  1,
    'begin'  =>  1,
    'end'    =>  1,
);

my %VALID_SEQUENCES = (
    'I'  =>  1,
    'B'  =>  1,
    'S'  =>  1,
    'C'  =>  1,
    'L'  =>  1,
    'F'  =>  1,
    'X'  =>  1,
    'Z'  =>  1,
    'E'  =>  1,
);

# stolen from HTML::Entities
my %ENTITIES = (
 # Some normal chars that have special meaning in SGML context
 amp    => '&',  # ampersand 
'gt'    => '>',  # greater than
'lt'    => '<',  # less than
 quot   => '"',  # double quote

 # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
 AElig	=> '',  # capital AE diphthong (ligature)
 Aacute	=> '',  # capital A, acute accent
 Acirc	=> '',  # capital A, circumflex accent
 Agrave	=> '',  # capital A, grave accent
 Aring	=> '',  # capital A, ring
 Atilde	=> '',  # capital A, tilde
 Auml	=> '',  # capital A, dieresis or umlaut mark
 Ccedil	=> '',  # capital C, cedilla
 ETH	=> '',  # capital Eth, Icelandic
 Eacute	=> '',  # capital E, acute accent
 Ecirc	=> '',  # capital E, circumflex accent
 Egrave	=> '',  # capital E, grave accent
 Euml	=> '',  # capital E, dieresis or umlaut mark
 Iacute	=> '',  # capital I, acute accent
 Icirc	=> '',  # capital I, circumflex accent
 Igrave	=> '',  # capital I, grave accent
 Iuml	=> '',  # capital I, dieresis or umlaut mark
 Ntilde	=> '',  # capital N, tilde
 Oacute	=> '',  # capital O, acute accent
 Ocirc	=> '',  # capital O, circumflex accent
 Ograve	=> '',  # capital O, grave accent
 Oslash	=> '',  # capital O, slash
 Otilde	=> '',  # capital O, tilde
 Ouml	=> '',  # capital O, dieresis or umlaut mark
 THORN	=> '',  # capital THORN, Icelandic
 Uacute	=> '',  # capital U, acute accent
 Ucirc	=> '',  # capital U, circumflex accent
 Ugrave	=> '',  # capital U, grave accent
 Uuml	=> '',  # capital U, dieresis or umlaut mark
 Yacute	=> '',  # capital Y, acute accent
 aacute	=> '',  # small a, acute accent
 acirc	=> '',  # small a, circumflex accent
 aelig	=> '',  # small ae diphthong (ligature)
 agrave	=> '',  # small a, grave accent
 aring	=> '',  # small a, ring
 atilde	=> '',  # small a, tilde
 auml	=> '',  # small a, dieresis or umlaut mark
 ccedil	=> '',  # small c, cedilla
 eacute	=> '',  # small e, acute accent
 ecirc	=> '',  # small e, circumflex accent
 egrave	=> '',  # small e, grave accent
 eth	=> '',  # small eth, Icelandic
 euml	=> '',  # small e, dieresis or umlaut mark
 iacute	=> '',  # small i, acute accent
 icirc	=> '',  # small i, circumflex accent
 igrave	=> '',  # small i, grave accent
 iuml	=> '',  # small i, dieresis or umlaut mark
 ntilde	=> '',  # small n, tilde
 oacute	=> '',  # small o, acute accent
 ocirc	=> '',  # small o, circumflex accent
 ograve	=> '',  # small o, grave accent
 oslash	=> '',  # small o, slash
 otilde	=> '',  # small o, tilde
 ouml	=> '',  # small o, dieresis or umlaut mark
 szlig	=> '',  # small sharp s, German (sz ligature)
 thorn	=> '',  # small thorn, Icelandic
 uacute	=> '',  # small u, acute accent
 ucirc	=> '',  # small u, circumflex accent
 ugrave	=> '',  # small u, grave accent
 uuml	=> '',  # small u, dieresis or umlaut mark
 yacute	=> '',  # small y, acute accent
 yuml	=> '',  # small y, dieresis or umlaut mark

 # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
 copy   => '',  # copyright sign
 reg    => '',  # registered sign
 nbsp   => "\240", # non breaking space

 # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
 iexcl  => '',
 cent   => '',
 pound  => '',
 curren => '',
 yen    => '',
 brvbar => '',
 sect   => '',
 uml    => '',
 ordf   => '',
 laquo  => '',
'not'   => '',    # not is a keyword in perl
 shy    => '',
 macr   => '',
 deg    => '',
 plusmn => '',
 sup1   => '',
 sup2   => '',
 sup3   => '',
 acute  => '',
 micro  => '',
 para   => '',
 middot => '',
 cedil  => '',
 ordm   => '',
 raquo  => '',
 frac14 => '',
 frac12 => '',
 frac34 => '',
 iquest => '',
'times' => '',    # times is a keyword in perl
 divide => '',

# some POD special entities
 verbar => '|',
 sol => '/'
);

##---------------------------------------------------------------------------

##---------------------------------
## Function definitions begin here
##---------------------------------

sub podchecker( $ ; $ % ) {
    my ($infile, $outfile, %options) = @_;
    local $_;

    ## Set defaults
    $infile  ||= \*STDIN;
    $outfile ||= \*STDERR;

    ## Now create a pod checker
    my $checker = new Pod::Checker(%options);

    ## Now check the pod document for errors
    $checker->parse_from_file($infile, $outfile);

    ## Return the number of errors found
    return $checker->num_errors();
}

##---------------------------------------------------------------------------

##-------------------------------
## Method definitions begin here
##-------------------------------

##################################

=over 4

=item C<Pod::Checker-E<gt>new( %options )>

Return a reference to a new Pod::Checker object that inherits from
Pod::Parser and is used for calling the required methods later. The
following options are recognized:

C<-warnings =E<gt> num>
  Print warnings if C<num> is true. The higher the value of C<num>,
the more warnings are printed. Currently there are only levels 1 and 2.

C<-quiet =E<gt> num>
  If C<num> is true, do not print any errors/warnings. This is useful
when Pod::Checker is used to munge POD code into plain text from within
POD formatters.

=cut

## sub new {
##     my $this = shift;
##     my $class = ref($this) || $this;
##     my %params = @_;
##     my $self = {%params};
##     bless $self, $class;
##     $self->initialize();
##     return $self;
## }

sub initialize {
    my $self = shift;
    ## Initialize number of errors, and setup an error function to
    ## increment this number and then print to the designated output.
    $self->{_NUM_ERRORS} = 0;
    $self->{-quiet} ||= 0;
    # set the error handling subroutine
    $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');
    $self->{_commands} = 0; # total number of POD commands encountered
    $self->{_list_stack} = []; # stack for nested lists
    $self->{_have_begin} = ''; # stores =begin
    $self->{_links} = []; # stack for internal hyperlinks
    $self->{_nodes} = []; # stack for =head/=item nodes
    $self->{_index} = []; # text in X<>
    # print warnings?
    $self->{-warnings} = 1 unless(defined $self->{-warnings});
    $self->{_current_head1} = ''; # the current =head1 block
    $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings});
}

##################################

=item C<$checker-E<gt>poderror( @args )>

=item C<$checker-E<gt>poderror( {%opts}, @args )>

Internal method for printing errors and warnings. If no options are
given, simply prints "@_". The following options are recognized and used
to form the output:

  -msg

A message to print prior to C<@args>.

  -line

The line number the error occurred in.

  -file

The file (name) the error occurred in.

  -severity

The error level, should be 'WARNING' or 'ERROR'.

=cut

# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
sub poderror {
    my $self = shift;
    my %opts = (ref $_[0]) ? %{shift()} : ();

    ## Retrieve options
    chomp( my $msg  = ($opts{-msg} || "")."@_" );
    my $line = (exists $opts{-line}) ? " at line $opts{-line}" : "";
    my $file = (exists $opts{-file}) ? " in file $opts{-file}" : "";
    unless (exists $opts{-severity}) {
       ## See if can find severity in message prefix
       $opts{-severity} = $1  if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );
    }
    my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : "";

    ## Increment error count and print message "
    ++($self->{_NUM_ERRORS}) 
        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
    my $out_fh = $self->output_handle() || \*STDERR;
    print $out_fh ($severity, $msg, $line, $file, "\n")
      if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
}

##################################

=item C<$checker-E<gt>num_errors()>

Set (if argument specified) and retrieve the number of errors found.

=cut

sub num_errors {
   return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
}

##################################

=item C<$checker-E<gt>name()>

Set (if argument specified) and retrieve the canonical name of POD as
found in the C<=head1 NAME> section.

=cut

sub name {
    return (@_ > 1 && $_[1]) ?
        ($_[0]->{-name} = $_[1]) : $_[0]->{-name};  
}

##################################

=item C<$checker-E<gt>node()>

Add (if argument specified) and retrieve the nodes (as defined by C<=headX>
and C<=item>) of the current POD. The nodes are returned in the order of
their occurence. They consist of plain text, each piece of whitespace is
collapsed to a single blank.

=cut

sub node {
    my ($self,$text) = @_;
    if(defined $text) {
        $text =~ s/\s+$//s; # strip trailing whitespace
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self->{_nodes}}, $text);
        # keep also a uniqueness counter
        $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self->{_nodes}};
}

##################################

=item C<$checker-E<gt>idx()>

Add (if argument specified) and retrieve the index entries (as defined by
C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece
of whitespace is collapsed to a single blank.

=cut

# set/return index entries of current POD
sub idx {
    my ($self,$text) = @_;
    if(defined $text) {
        $text =~ s/\s+$//s; # strip trailing whitespace
        $text =~ s/\s+/ /gs; # collapse whitespace
        # add node, order important!
        push(@{$self->{_index}}, $text);
        # keep also a uniqueness counter
        $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
        return $text;
    }
    @{$self->{_index}};
}

##################################

=item C<$checker-E<gt>hyperlink()>

Add (if argument specified) and retrieve the hyperlinks (as defined by
C<LE<lt>E<gt>>) of the current POD. They consist of an 2-item array: line
number and C<Pod::Hyperlink> object.

=back

=cut

# set/return hyperlinks of the current POD
sub hyperlink {
    my $self = shift;
    if($_[0]) {
        push(@{$self->{_links}}, $_[0]);
        return $_[0];
    }
    @{$self->{_links}};
}

## overrides for Pod::Parser

sub end_pod {
    ## Do some final checks and
    ## print the number of errors found
    my $self   = shift;
    my $infile = $self->input_file();
    my $out_fh = $self->output_handle();

    if(@{$self->{_list_stack}}) {
        # _TODO_ display, but don't count them for now
        my $list;
        while(($list = $self->_close_list('EOF',$infile)) &&
          $list->indent() ne 'auto') {
            $self->poderror({ -line => 'EOF', -file => $infile,
                -severity => 'ERROR', -msg => "=over on line " .
                $list->start() . " without closing =back" }); #"
        }
    }

    # check validity of document internal hyperlinks
    # first build the node names from the paragraph text
    my %nodes;
    foreach($self->node()) {
        $nodes{$_} = 1;
        if(/^(\S+)\s+\S/) {
            # we have more than one word. Use the first as a node, too.
            # This is used heavily in perlfunc.pod
            $nodes{$1} ||= 2; # derived node
        }
    }
    foreach($self->idx()) {
        $nodes{$_} = 3; # index node
    }
    foreach($self->hyperlink()) {
        my ($line,$link) = @$_;
        # _TODO_ what if there is a link to the page itself by the name,
        # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
        if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {
            my $node = $self->_check_ptree($self->parse_text($link->node(),
                $line), $line, $infile, 'L');
            if($node && !$nodes{$node}) {
                $self->poderror({ -line => $line || '', -file => $infile,
                    -severity => 'ERROR',
                    -msg => "unresolved internal link '$node'"});
            }
        }
    }

    # check the internal nodes for uniqueness. This pertains to
    # =headX, =item and X<...>
    foreach(grep($self->{_unique_nodes}->{$_} > 1,
      keys %{$self->{_unique_nodes}})) {
        $self->poderror({ -line => '-', -file => $infile,
            -severity => 'WARNING',
            -msg => "multiple occurence of link target '$_'"});
    }

    ## Print the number of errors found
    my $num_errors = $self->num_errors();
    if ($num_errors > 0) {
        printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
                      ($num_errors == 1) ? "error" : "errors");
    }
    elsif($self->{_commands} == 0) {
        print $out_fh "$infile does not contain any pod commands.\n";
        $self->num_errors(-1);
    }
    else {
        print $out_fh "$infile pod syntax OK.\n";
    }
}

# check a POD command directive
sub command { 
    my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
    my ($file, $line) = $pod_para->file_line;
    ## Check the command syntax
    my $arg; # this will hold the command argument
    if (! $VALID_COMMANDS{$cmd}) {
       $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
                         -msg => "Unknown command '$cmd'" });
    }
    else { # found a valid command
        $self->{_commands}++; # delete this line if below is enabled again

        ##### following check disabled due to strong request
        #if(!$self->{_commands}++ && $cmd !~ /^head/) {
        #    $self->poderror({ -line => $line, -file => $file,
        #         -severity => 'WARNING', 
        #         -msg => "file does not start with =head" });
        #}

        # check syntax of particular command
        if($cmd eq 'over') {
            # check for argument
            $arg = $self->interpolate_and_check($paragraph, $line,$file);
            my $indent = 4; # default
            if($arg && $arg =~ /^\s*(\d+)\s*$/) {
                $indent = $1;
            }
            # start a new list
            $self->_open_list($indent,$line,$file);
        }
        elsif($cmd eq 'item') {
            # are we in a list?
            unless(@{$self->{_list_stack}}) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                     -msg => "=item without previous =over" });
                # auto-open in case we encounter many more
                $self->_open_list('auto',$line,$file);
            }
            my $list = $self->{_list_stack}->[0];
            # check whether the previous item had some contents
            if(defined $self->{_list_item_contents} &&
              $self->{_list_item_contents} == 0) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'WARNING', 
                     -msg => "previous =item has no contents" });
            }
            if($list->{_has_par}) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'WARNING', 
                     -msg => "preceding non-item paragraph(s)" });
                delete $list->{_has_par};
            }
            # check for argument
            $arg = $self->interpolate_and_check($paragraph, $line, $file);
            if($arg && $arg =~ /(\S+)/) {
                $arg =~ s/[\s\n]+$//;
                my $type;
                if($arg =~ /^[*]\s*(\S*.*)/) {
                  $type = 'bullet';
                  $self->{_list_item_contents} = $1 ? 1 : 0;
                  $arg = $1;
                }
                elsif($arg =~ /^\d+\.?\s*(\S*)/) {
                  $type = 'number';
                  $self->{_list_item_contents} = $1 ? 1 : 0;
                  $arg = $1;
                }
                else {
                  $type = 'definition';
                  $self->{_list_item_contents} = 1;
                }
                my $first = $list->type();
                if($first && $first ne $type) {
                    $self->poderror({ -line => $line, -file => $file,
                       -severity => 'WARNING', 
                       -msg => "=item type mismatch ('$first' vs. '$type')"});
                }
                else { # first item
                    $list->type($type);
                }
            }
            else {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'WARNING', 
                     -msg => "No argument for =item" });
		$arg = ' '; # empty
                $self->{_list_item_contents} = 0;
            }
            # add this item
            $list->item($arg);
            # remember this node
            $self->node($arg);
        }
        elsif($cmd eq 'back') {
            # check if we have an open list
            unless(@{$self->{_list_stack}}) {
                $self->poderror({ -line => $line, -file => $file,
                         -severity => 'ERROR', 
                         -msg => "=back without previous =over" });
            }
            else {
                # check for spurious characters
                $arg = $self->interpolate_and_check($paragraph, $line,$file);
                if($arg && $arg =~ /\S/) {
                    $self->poderror({ -line => $line, -file => $file,
                         -severity => 'ERROR', 
                         -msg => "Spurious character(s) after =back" });
                }
                # close list
                my $list = $self->_close_list($line,$file);
                # check for empty lists
                if(!$list->item() && $self->{-warnings}) {
                    $self->poderror({ -line => $line, -file => $file,
                         -severity => 'WARNING', 
                         -msg => "No items in =over (at line " .
                         $list->start() . ") / =back list"}); #"
                }
            }
        }
        elsif($cmd =~ /^head(\d+)/) {
            # check whether the previous =head section had some contents
            if(defined $self->{_commands_in_head} &&
              $self->{_commands_in_head} == 0 &&
              defined $self->{_last_head} &&
              $self->{_last_head} >= $1) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'WARNING', 
                     -msg => "empty section in previous paragraph"});
            }
            $self->{_commands_in_head} = -1;
            $self->{_last_head} = $1;
            # check if there is an open list
            if(@{$self->{_list_stack}}) {
                my $list;
                while(($list = $self->_close_list($line,$file)) &&
                  $list->indent() ne 'auto') {
                    $self->poderror({ -line => $line, -file => $file,
                         -severity => 'ERROR', 
                         -msg => "=over on line ". $list->start() .
                         " without closing =back (at $cmd)" });
                }
            }
            # remember this node
            $arg = $self->interpolate_and_check($paragraph, $line,$file);
            $arg =~ s/[\s\n]+$//s;
            $self->node($arg);
            unless(length($arg)) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                     -msg => "empty =$cmd"});
            }
            if($cmd eq 'head1') {
                $self->{_current_head1} = $arg;
            } else {
                $self->{_current_head1} = '';
            }
        }
        elsif($cmd eq 'begin') {
            if($self->{_have_begin}) {
                # already have a begin
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                     -msg => "Nested =begin's (first at line " .
                     $self->{_have_begin} . ")"});
            }
            else {
                # check for argument
                $arg = $self->interpolate_and_check($paragraph, $line,$file);
                unless($arg && $arg =~ /(\S+)/) {
                    $self->poderror({ -line => $line, -file => $file,
                         -severity => 'ERROR', 
                         -msg => "No argument for =begin"});
                }
                # remember the =begin
                $self->{_have_begin} = "$line:$1";
            }
        }
        elsif($cmd eq 'end') {
            if($self->{_have_begin}) {
                # close the existing =begin
                $self->{_have_begin} = '';
                # check for spurious characters
                $arg = $self->interpolate_and_check($paragraph, $line,$file);
                # the closing argument is optional
                #if($arg && $arg =~ /\S/) {
                #    $self->poderror({ -line => $line, -file => $file,
                #         -severity => 'WARNING', 
                #         -msg => "Spurious character(s) after =end" });
                #}
            }
            else {
                # don't have a matching =begin
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                     -msg => "=end without =begin" });
            }
        }
        elsif($cmd eq 'for') {
            unless($paragraph =~ /\s*(\S+)\s*/) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                     -msg => "=for without formatter specification" });
            }
            $arg = ''; # do not expand paragraph below
        }
        elsif($cmd =~ /^(pod|cut)$/) {
            # check for argument
            $arg = $self->interpolate_and_check($paragraph, $line,$file);
            if($arg && $arg =~ /(\S+)/) {
                $self->poderror({ -line => $line, -file => $file,
                      -severity => 'ERROR', 
                      -msg => "Spurious text after =$cmd"});
            }
        }
    $self->{_commands_in_head}++;
    ## Check the interior sequences in the command-text
    $self->interpolate_and_check($paragraph, $line,$file)
        unless(defined $arg);
    }
}

sub _open_list
{
    my ($self,$indent,$line,$file) = @_;
    my $list = Pod::List->new(
           -indent => $indent,
           -start => $line,
           -file => $file);
    unshift(@{$self->{_list_stack}}, $list);
    undef $self->{_list_item_contents};
    $list;
}

sub _close_list
{
    my ($self,$line,$file) = @_;
    my $list = shift(@{$self->{_list_stack}});
    if(defined $self->{_list_item_contents} &&
      $self->{_list_item_contents} == 0) {
        $self->poderror({ -line => $line, -file => $file,
            -severity => 'WARNING', 
            -msg => "previous =item has no contents" });
    }
    undef $self->{_list_item_contents};
    $list;
}

# process a block of some text
sub interpolate_and_check {
    my ($self, $paragraph, $line, $file) = @_;
    ## Check the interior sequences in the command-text
    # and return the text
    $self->_check_ptree(
        $self->parse_text($paragraph,$line), $line, $file, '');
}

sub _check_ptree {
    my ($self,$ptree,$line,$file,$nestlist) = @_;
    local($_);
    my $text = '';
    # process each node in the parse tree
    foreach(@$ptree) {
        # regular text chunk
        unless(ref) {
            my $count;
            # count the unescaped angle brackets
            # complain only when warning level is greater than 1
            my $i = $_;
            if($count = $i =~ tr/<>/<>/) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'WARNING', 
                     -msg => "$count unescaped <> in paragraph" })
                if($self->{-warnings} && $self->{-warnings}>1);
            }
            $text .= $i;
            next;
        }
        # have an interior sequence
        my $cmd = $_->cmd_name();
        my $contents = $_->parse_tree();
        ($file,$line) = $_->file_line();
        # check for valid tag
        if (! $VALID_SEQUENCES{$cmd}) {
            $self->poderror({ -line => $line, -file => $file,
                 -severity => 'ERROR', 
                 -msg => qq(Unknown interior-sequence '$cmd')});
            # expand it anyway
            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
            next;
        }
        if($nestlist =~ /$cmd/) {
            $self->poderror({ -line => $line, -file => $file,
                 -severity => 'ERROR', 
                 -msg => "nested commands $cmd<...$cmd<...>...>"});
            # _TODO_ should we add the contents anyway?
            # expand it anyway, see below
        }
        if($cmd eq 'E') {
            # preserve entities
            if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
                $self->poderror({ -line => $line, -file => $file,
                    -severity => 'ERROR', 
                    -msg => "garbled entity " . $_->raw_text()});
                next;
            }
            my $ent = $$contents[0];
            my $val;
            if($ent =~ /^0x[0-9a-f]+$/i) {
                # hexadec entity
                $val = hex($ent);
            }
            elsif($ent =~ /^0\d+$/) {
                # octal
                $val = oct($ent);
            }
            elsif($ent =~ /^\d+$/) {
                # numeric entity
                $val = $ent;
            }
            if(defined $val) {
                if($val>0 && $val<256) {
                    $text .= chr($val);
                }
                else {
                    $self->poderror({ -line => $line, -file => $file,
                        -severity => 'ERROR', 
                        -msg => "Entity number out of range " . $_->raw_text()});
                }
            }
            elsif($ENTITIES{$ent}) {
                # known ISO entity
                $text .= $ENTITIES{$ent};
            }
            else {
                $self->poderror({ -line => $line, -file => $file,
                    -severity => 'WARNING', 
                    -msg => "Unknown entity " . $_->raw_text()});
                $text .= "E<$ent>";
            }
        }
        elsif($cmd eq 'L') {
            # try to parse the hyperlink
            my $link = Pod::Hyperlink->new($contents->raw_text());
            unless(defined $link) {
                $self->poderror({ -line => $line, -file => $file,
                    -severity => 'ERROR', 
                    -msg => "malformed link " . $_->raw_text() ." : $@"});
                next;
            }
            $link->line($line); # remember line
            if($self->{-warnings}) {
                foreach my $w ($link->warning()) {
                    $self->poderror({ -line => $line, -file => $file,
                        -severity => 'WARNING', 
                        -msg => $w });
                }
            }
            # check the link text
            $text .= $self->_check_ptree($self->parse_text($link->text(),
                $line), $line, $file, "$nestlist$cmd");
            # remember link
            $self->hyperlink([$line,$link]);
        }
        elsif($cmd =~ /[BCFIS]/) {
            # add the guts
            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
        }
        elsif($cmd eq 'Z') {
            if(length($contents->raw_text())) {
                $self->poderror({ -line => $line, -file => $file,
                    -severity => 'ERROR', 
                    -msg => "Nonempty Z<>"});
            }
        }
        elsif($cmd eq 'X') {
            my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
            if($idx =~ /^\s*$/s) {
                $self->poderror({ -line => $line, -file => $file,
                    -severity => 'ERROR', 
                    -msg => "Empty X<>"});
            }
            else {
                # remember this node
                $self->idx($idx);
            }
        }
        else {
            # not reached
            die "internal error";
        }
    }
    $text;
}

# process a block of verbatim text
sub verbatim { 
    ## Nothing particular to check
    my ($self, $paragraph, $line_num, $pod_para) = @_;

    $self->_preproc_par($paragraph);

    if($self->{_current_head1} eq 'NAME') {
        my ($file, $line) = $pod_para->file_line;
        $self->poderror({ -line => $line, -file => $file,
            -severity => 'WARNING',
            -msg => 'Verbatim paragraph in NAME section' });
    }
}

# process a block of regular text
sub textblock { 
    my ($self, $paragraph, $line_num, $pod_para) = @_;
    my ($file, $line) = $pod_para->file_line;

    $self->_preproc_par($paragraph);

    # skip this paragraph if in a =begin block
    unless($self->{_have_begin}) {
        my $block = $self->interpolate_and_check($paragraph, $line,$file);
        if($self->{_current_head1} eq 'NAME') {
            if($block =~ /^\s*(\S+?)\s*[,-]/) {
                # this is the canonical name
                $self->{-name} = $1 unless(defined $self->{-name});
            }
        }
    }
}

sub _preproc_par
{
    my $self = shift;
    $_[0] =~ s/[\s\n]+$//;
    if($_[0]) {
        $self->{_commands_in_head}++;
        $self->{_list_item_contents}++ if(defined $self->{_list_item_contents});
        if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) {
            $self->{_list_stack}->[0]->{_has_par} = 1;
        }
    }
}

1;

__END__

=head1 AUTHOR

Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>

Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>

=cut

ii($_[0])
    : $_[0];
}

sub _print_isa
{
 no strict qw(refs);

 my $pkg = shift;
 my $cmd = $pkg;

 $debug{$pkg} ||= 0;

 my %done = ();
 my @do   = ($pkg);
 my %spc = ( $pkg , "");

 print STDERR "\n";
 while ($pkg = shift @do)
  {
   next if defined $done{$pkg};

   $done{$pkg} = 1                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################  
# Pod/Find.pm -- finds files containing POD documentation
#
# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
# 
# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
# from Nick Ing-Simmon's PodToHtml). All rights reserved.
# This file is part of "PodParser". Pod::Find is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Find;

use vars qw($VERSION);
$VERSION = 0.21;   ## Current version of this package
require  5.005;   ## requires this Perl version or later
use Carp;

#############################################################################

=head1 NAME

Pod::Find - find POD documents in directory trees

=head1 SYNOPSIS

  use Pod::Find qw(pod_find simplify_name);
  my %pods = pod_find({ -verbose => 1, -inc => 1 });
  foreach(keys %pods) {
     print "found library POD `$pods{$_}' in $_\n";
  }

  print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";

  $location = pod_where( { -inc => 1 }, "Pod::Find" );

=head1 DESCRIPTION

B<Pod::Find> provides a set of functions to locate POD files.  Note that
no function is exported by default to avoid pollution of your namespace,
so be sure to specify them in the B<use> statement if you need them:

  use Pod::Find qw(pod_find);

=cut

use strict;
#use diagnostics;
use Exporter;
use File::Spec;
use File::Find;
use Cwd;

use vars qw(@ISA @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);

# package global variables
my $SIMPLIFY_RX;

=head2 C<pod_find( { %opts } , @directories )>

The function B<pod_find> searches for POD documents in a given set of
files and/or directories. It returns a hash with the file names as keys
and the POD name as value. The POD name is derived from the file name
and its position in the directory tree.

E.g. when searching in F<$HOME/perl5lib>, the file
F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
I<Myclass::Subclass>. The name information can be used for POD
translators.

Only text files containing at least one valid POD command are found.

A warning is printed if more than one POD file with the same POD name
is found, e.g. F<CPAN.pm> in different directories. This usually
indicates duplicate occurrences of modules in the I<@INC> search path.

B<OPTIONS> The first argument for B<pod_find> may be a hash reference
with options. The rest are either directories that are searched
recursively or files.  The POD names of files are the plain basenames
with any Perl-like extension (.pm, .pl, .pod) stripped.

=over 4

=item C<-verbose =E<gt> 1>

Print progress information while scanning.

=item C<-perl =E<gt> 1>

Apply Perl-specific heuristics to find the correct PODs. This includes
stripping Perl-like extensions, omitting subdirectories that are numeric
but do I<not> match the current Perl interpreter's version id, suppressing
F<site_perl> as a module hierarchy name etc.

=item C<-script =E<gt> 1>

Search for PODs in the current Perl interpreter's installation 
B<scriptdir>. This is taken from the local L<Config|Config> module.

=item C<-inc =E<gt> 1>

Search for PODs in the current Perl interpreter's I<@INC> paths. This
automatically considers paths specified in the C<PERL5LIB> environment
as this is prepended to I<@INC> by the Perl interpreter itself.

=back

=cut

# return a hash of the POD files found
# first argument may be a hashref (options),
# rest is a list of directories to search recursively
sub pod_find
{
    my %opts;
    if(ref $_[0]) {
        %opts = %{shift()};
    }

    $opts{-verbose} ||= 0;
    $opts{-perl}    ||= 0;

    my (@search) = @_;

    if($opts{-script}) {
        require Config;
        push(@search, $Config::Config{scriptdir})
            if -d $Config::Config{scriptdir};
        $opts{-perl} = 1;
    }

    if($opts{-inc}) {
        if ($^O eq 'MacOS') {
            # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
            my @new_INC = @INC;
            for (@new_INC) {
                if ( $_ eq '.' ) {
                    $_ = ':';
                } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
                    $_ = ':'. $_;
                } else {
                    $_ =~ s|^\./|:|;
                }
            }
            push(@search, grep($_ ne File::Spec->curdir, @new_INC));
        } else {
            push(@search, grep($_ ne File::Spec->curdir, @INC));
        }

        $opts{-perl} = 1;
    }

    if($opts{-perl}) {
        require Config;
        # this code simplifies the POD name for Perl modules:
        # * remove "site_perl"
        # * remove e.g. "i586-linux" (from 'archname')
        # * remove e.g. 5.00503
        # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)

        # Mac OS:
        # * remove ":?site_perl:"
        # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)

        if ($^O eq 'MacOS') {
            $SIMPLIFY_RX =
              qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
        } else {
            $SIMPLIFY_RX =
              qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
        }
    }

    my %dirs_visited;
    my %pods;
    my %names;
    my $pwd = cwd();

    foreach my $try (@search) {
        unless(File::Spec->file_name_is_absolute($try)) {
            # make path absolute
            $try = File::Spec->catfile($pwd,$try);
        }
        # simplify path
        # on VMS canonpath will vmsify:[the.path], but File::Find::find
        # wants /unixy/paths
        $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
        my $name;
        if(-f $try) {
            if($name = _check_and_extract_name($try, $opts{-verbose})) {
                _check_for_duplicates($try, $name, \%names, \%pods);
            }
            next;
        }
        my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
        File::Find::find( sub {
            my $item = $File::Find::name;
            if(-d) {
                if($dirs_visited{$item}) {
                    warn "Directory '$item' already seen, skipping.\n"
                        if($opts{-verbose});
                    $File::Find::prune = 1;
                    return;
                }
                else {
                    $dirs_visited{$item} = 1;
                }
                if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
                    $File::Find::prune = 1;
                    warn "Perl $] version mismatch on $_, skipping.\n"
                        if($opts{-verbose});
                }
                return;
            }
            if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
                _check_for_duplicates($item, $name, \%names, \%pods);
            }
        }, $try); # end of File::Find::find
    }
    chdir $pwd;
    %pods;
}

sub _check_for_duplicates {
    my ($file, $name, $names_ref, $pods_ref) = @_;
    if($$names_ref{$name}) {
        warn "Duplicate POD found (shadowing?): $name ($file)\n";
        warn "    Already seen in ",
            join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
    }
    else {
        $$names_ref{$name} = 1;
    }
    $$pods_ref{$file} = $name;
}

sub _check_and_extract_name {
    my ($file, $verbose, $root_rx) = @_;

    # check extension or executable flag
    # this involves testing the .bat extension on Win32!
    unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
      return undef;
    }

    return undef unless contains_pod($file,$verbose);

    # strip non-significant path components
    # TODO what happens on e.g. Win32?
    my $name = $file;
    if(defined $root_rx) {
        $name =~ s!$root_rx!!s;
        $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
    }
    else {
        if ($^O eq 'MacOS') {
            $name =~ s/^.*://s;
        } else {
            $name =~ s:^.*/::s;
        }
    }
    _simplify($name);
    $name =~ s!/+!::!g; #/
    if ($^O eq 'MacOS') {
        $name =~ s!:+!::!g; # : -> ::
    } else {
        $name =~ s!/+!::!g; # / -> ::
    }
    $name;
}

=head2 C<simplify_name( $str )>

The function B<simplify_name> is equivalent to B<basename>, but also
strips Perl-like extensions (.pm, .pl, .pod) and extensions like
F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.

=cut

# basic simplification of the POD name:
# basename & strip extension
sub simplify_name {
    my ($str) = @_;
    # remove all path components
    if ($^O eq 'MacOS') {
        $str =~ s/^.*://s;
    } else {
        $str =~ s:^.*/::s;
    }
    _simplify($str);
    $str;
}

# internal sub only
sub _simplify {
    # strip Perl's own extensions
    $_[0] =~ s/\.(pod|pm|plx?)\z//i;
    # strip meaningless extensions on Win32 and OS/2
    $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
    # strip meaningless extensions on VMS
    $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
}

# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>

=head2 C<pod_where( { %opts }, $pod )>

Returns the location of a pod document given a search directory
and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.

Options:

=over 4

=item C<-inc =E<gt> 1>

Search @INC for the pod and also the C<scriptdir> defined in the
L<Config|Config> module.

=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>

Reference to an array of search directories. These are searched in order
before looking in C<@INC> (if B<-inc>). Current directory is used if
none are specified.

=item C<-verbose =E<gt> 1>

List directories as they are searched

=back

Returns the full path of the first occurence to the file.
Package names (eg 'A::B') are automatically converted to directory
names in the selected directory. (eg on unix 'A::B' is converted to
'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
search automatically if required.

A subdirectory F<pod/> is also checked if it exists in any of the given
search directories. This ensures that e.g. L<perlfunc|perlfunc> is
found.

It is assumed that if a module name is supplied, that that name
matches the file name. Pods are not opened to check for the 'NAME'
entry.

A check is made to make sure that the file that is found does 
contain some pod documentation.

=cut

sub pod_where {

  # default options
  my %options = (
         '-inc' => 0,
         '-verbose' => 0,
         '-dirs' => [ File::Spec->curdir ],
        );

  # Check for an options hash as first argument
  if (defined $_[0] && ref($_[0]) eq 'HASH') {
    my $opt = shift;

    # Merge default options with supplied options
    %options = (%options, %$opt);
  }

  # Check usage
  carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));

  # Read argument
  my $pod = shift;

  # Split on :: and then join the name together using File::Spec
  my @parts = split (/::/, $pod);

  # Get full directory list
  my @search_dirs = @{ $options{'-dirs'} };

  if ($options{'-inc'}) {

    require Config;

    # Add @INC
    if ($^O eq 'MacOS' && $options{'-inc'}) {
        # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
        my @new_INC = @INC;
        for (@new_INC) {
            if ( $_ eq '.' ) {
                $_ = ':';
            } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
                $_ = ':'. $_;
            } else {
                $_ =~ s|^\./|:|;
            }
        }
        push (@search_dirs, @new_INC);
    } elsif ($options{'-inc'}) {
        push (@search_dirs, @INC);
    }
    push (@search_dirs, @INC) if $options{'-inc'};

    # Add location of pod documentation for perl man pages (eg perlfunc)
    # This is a pod directory in the private install tree
    #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
    #					'pod');
    #push (@search_dirs, $perlpoddir)
    #  if -d $perlpoddir;

    # Add location of binaries such as pod2text
    push (@search_dirs, $Config::Config{'scriptdir'})
      if -d $Config::Config{'scriptdir'};
  }

  # Loop over directories
  Dir: foreach my $dir ( @search_dirs ) {

    # Don't bother if can't find the directory
    if (-d $dir) {
      warn "Looking in directory $dir\n" 
        if $options{'-verbose'};

      # Now concatenate this directory with the pod we are searching for
      my $fullname = File::Spec->catfile($dir, @parts);
      warn "Filename is now $fullname\n"
        if $options{'-verbose'};

      # Loop over possible extensions
      foreach my $ext ('', '.pod', '.pm', '.pl') {
        my $fullext = $fullname . $ext;
        if (-f $fullext && 
         contains_pod($fullext, $options{'-verbose'}) ) {
          warn "FOUND: $fullext\n" if $options{'-verbose'};
          return $fullext;
        }
      }
    } else {
      warn "Directory $dir does not exist\n"
        if $options{'-verbose'};
      next Dir;
    }
    if(-d File::Spec->catdir($dir,'pod')) {
      $dir = File::Spec->catdir($dir,'pod');
      redo Dir;
    }
  }
  # No match;
  return undef;
}

=head2 C<contains_pod( $file , $verbose )>

Returns true if the supplied filename (not POD module) contains some pod
information.

=cut

sub contains_pod {
  my $file = shift;
  my $verbose = 0;
  $verbose = shift if @_;

  # check for one line of POD
  unless(open(POD,"<$file")) {
    warn "Error: $file is unreadable: $!\n";
    return undef;
  }
  
  local $/ = undef;
  my $pod = <POD>;
  close(POD) || die "Error closing $file: $!\n";
  unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
    warn "No POD in $file, skipping.\n"
      if($verbose);
    return 0;
  }

  return 1;
}

=head1 AUTHOR

Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
heavily borrowing code from Nick Ing-Simmons' PodToHtml.

Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
C<pod_where> and C<contains_pod>.

=head1 SEE ALSO

L<Pod::Parser>, L<Pod::Checker>, L<perldoc>

=cut

1;

$file = $home . "/.libnetrc";
	$ref = eval { local $SIG{__DIE__}; do $file } if -f $file;
	%NetConfig = (%NetConfig, %{ $ref })
	    if ref($ref) eq 'HASH';	
    }
}
my ($k,$v);
wh                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Pod::Functions;

#:vi:set ts=20

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(%Kinds %Type %Flavor %Type_Description @Type_Order);

%Type_Description = (
    'ARRAY'	=> 'Functions for real @ARRAYs',
    'Binary'	=> 'Functions for fixed length data or records',
    'File'	=> 'Functions for filehandles, files, or directories',
    'Flow'	=> 'Keywords related to control flow of your perl program',
    'HASH'	=> 'Functions for real %HASHes',
    'I/O'	=> 'Input and output functions',
    'LIST'	=> 'Functions for list data',
    'Math'	=> 'Numeric functions',
    'Misc'	=> 'Miscellaneous functions',
    'Modules'	=> 'Keywords related to perl modules',
    'Network'	=> 'Fetching network info',
    'Objects'	=> 'Keywords related to classes and object-orientedness',
    'Process'	=> 'Functions for processes and process groups',
    'Regexp'	=> 'Regular expressions and pattern matching',
    'Socket'	=> 'Low-level socket functions',
    'String'	=> 'Functions for SCALARs or strings',
    'SysV'	=> 'System V interprocess communication functions',
    'Time'	=> 'Time-related functions',
    'User'	=> 'Fetching user and group info',
    'Namespace'	=> 'Keywords altering or affecting scoping of identifiers',
);

@Type_Order = qw{
    String
    Regexp
    Math
    ARRAY
    LIST
    HASH
    I/O
    Binary
    File
    Flow
    Namespace
    Misc
    Process
    Modules
    Objects
    Socket
    SysV
    User
    Network
    Time
};

while (<DATA>) {
    chomp;
    s/#.*//;
    next unless $_;
    ($name, $type, $text) = split " ", $_, 3;
    $Type{$name} = $type;
    $Flavor{$name} = $text;
    for $type ( split /[,\s]+/, $type ) {
	push @{$Kinds{$type}}, $name;
    }
} 

close DATA;

unless (caller) { 
    foreach $type ( @Type_Order ) {
	$list = join(", ", sort @{$Kinds{$type}});
	$typedesc = $Type_Description{$type} . ":";
	write;
    } 
}

format = 

^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $typedesc 
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $typedesc 
 ~~  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
	$list
.

1

__DATA__
-X	File	a file test (-r, -x, etc)
abs	Math	absolute value function
accept	Socket	accept an incoming socket connect
alarm	Process	schedule a SIGALRM 
atan2	Math	arctangent of Y/X in the range -PI to PI
bind	Socket	binds an address to a socket
binmode	I/O	prepare binary files for I/O
bless	Objects	create an object 
caller	Flow,Namespace	get context of the current subroutine call
chdir	File	change your current working directory
chmod	File	changes the permissions on a list of files
chomp	String 	remove a trailing record separator from a string
chop	String 	remove the last character from a string
chown	File	change the owership on a list of files
chr	String 	get character this number represents
chroot	File	make directory new root for path lookups
close	I/O	close file (or pipe or socket) handle
closedir	I/O	close directory handle
connect	Socket	connect to a remote socket
continue	Flow	optional trailing block in a while or foreach 
cos	Math	cosine function
crypt	String	one-way passwd-style encryption
dbmclose	Objects,I/O	breaks binding on a tied dbm file
dbmopen	Objects,I/O	create binding on a tied dbm file
defined	Misc	test whether a value, variable, or function is defined
delete	HASH	deletes a value from a hash
die	I/O,Flow	raise an exception or bail out
do	Flow,Modules	turn a BLOCK into a TERM
dump	Misc,Flow	create an immediate core dump
each	HASH	retrieve the next key/value pair from a hash
endgrent	User	be done using group file
endhostent	User	be done using hosts file
endnetent	User	be done using networks file
endprotoent	Network	be done using protocols file
endpwent	User	be done using passwd file
endservent	Network	be done using services file
eof	I/O	test a filehandle for its end
eval	Flow,Misc	catch exceptions or compile and run code
exec	Process	abandon this program to run another
exists	HASH	test whether a hash key is present
exit	Flow	terminate this program
exp	Math	raise I<e> to a power
fcntl	File	file control system call
fileno	I/O	return file descriptor from filehandle
flock	I/O	lock an entire file with an advisory lock
fork	Process	create a new process just like this one
format	I/O	declare a picture format with use by the write() function
formline	Misc	internal function used for formats
getc	I/O	get	the next character from the filehandle
getgrent	User	get next group record 
getgrgid	User	get group record given group user ID
getgrnam	User	get group record given group name
gethostbyaddr	Network	get host record given its address
gethostbyname	Network	get host record given name
gethostent	Network	get next hosts record 
getlogin	User	return who logged in at this tty
getnetbyaddr	Network	get network record given its address
getnetbyname	Network	get networks record given name
getnetent	Network	get next networks record 
getpeername	Socket	find the other end of a socket connection
getpgrp	Process	get process group
getppid	Process	get parent process ID
getpriority	Process	get current nice value
getprotobyname	Network	get protocol record given name
getprotobynumber	Network	get protocol record numeric protocol
getprotoent	Network	get next protocols record
getpwent	User	get next passwd record
getpwnam	User	get passwd record given user login name
getpwuid	User	get passwd record given user ID
getservbyname	Network	get services record given its name
getservbyport	Network	get services record given numeric port
getservent	Network	get next services record 
getsockname	Socket	retrieve the sockaddr for a given socket
getsockopt	Socket	get socket options on a given socket
glob	File		expand filenames using wildcards
gmtime	Time	convert UNIX time into record or string using Greenwich time
goto	Flow	create spaghetti code
grep	LIST	locate elements in a list test true against a given criterion
hex	Math,String	convert a string to a hexadecimal number
import	Modules,Namespace	patch a module's namespace into your own
index	String	find a substring within a string
int	Math	get the integer portion of a number
ioctl	File	system-dependent device control system call
join	LIST	join a list into a string using a separator
keys	HASH	retrieve list of indices from a hash
kill	Process	send a signal to a process or process group
last	Flow	exit a block prematurely
lc	String	return lower-case version of a string
lcfirst	String	return a string with just the next letter in lower case
length	String	return the number of bytes in a string
link	File	create a hard link in the filesytem
listen	Socket	register your socket as a server 
local	Misc,Namespace	create a temporary value for a global variable (dynamic scoping)
localtime	Time	convert UNIX time into record or string using local time
lock	Threads	get a thread lock on a variable, subroutine, or method
log	Math	retrieve the natural logarithm for a number
lstat	File	stat a symbolic link
m//	Regexp	match a string with a regular expression pattern
map	LIST	apply a change to a list to get back a new list with the changes
mkdir	File	create a directory
msgctl	SysV	SysV IPC message control operations
msgget	SysV	get SysV IPC message queue
msgrcv	SysV	receive a SysV IPC message from a message queue
msgsnd	SysV	send a SysV IPC message to a message queue
my	Misc,Namespace	declare and assign a local variable (lexical scoping)
next	Flow	iterate a block prematurely
no	Modules	unimport some module symbols or semantics at compile time
package	Modules,Objects,Namespace	declare a separate global namespace
prototype	Flow,Misc	get the prototype (if any) of a subroutine
oct	String,Math	convert a string to an octal number
open	File	open a file, pipe, or descriptor
opendir	File	open a directory
ord	String	find a character's numeric representation
pack	Binary,String	convert a list into a binary representation
pipe	Process	open a pair of connected filehandles
pop	ARRAY	remove the last element from an array and return it
pos	Regexp	find or set the offset for the last/next m//g search
print	I/O	output a list to a filehandle
printf	I/O  	output a formatted list to a filehandle
push	ARRAY	append one or more elements to an array
q/STRING/	String	singly quote a string
qq/STRING/	String	doubly quote a string
quotemeta	Regexp	quote regular expression magic characters
qw/STRING/	LIST	quote a list of words
qx/STRING/	Process	backquote quote a string
qr/PATTERN/	Regexp	Compile pattern 
rand	Math	retrieve the next pseudorandom number 
read	I/O,Binary	fixed-length buffered input from a filehandle
readdir	I/O	get a directory from a directory handle
readline	I/O	fetch a record from a file
readlink	File	determine where a symbolic link is pointing
recv	Socket	receive a message over a Socket
redo	Flow	start this loop iteration over again
ref	Objects	find out the type of thing being referenced
rename	File	change a filename
require	Modules	load in external functions from a library at runtime
reset	Misc	clear all variables of a given name
return	Flow	get out of a function early
reverse	String,LIST	flip a string or a list
rewinddir	I/O	reset directory handle
rindex	String	right-to-left substring search
rmdir	File	remove a directory
s///	Regexp	replace a pattern with a string
scalar	Misc	force a scalar context
seek	I/O	reposition file pointer for random-access I/O
seekdir	I/O	reposition directory pointer 
select	I/O	reset default output or do I/O multiplexing
semctl	SysV	SysV semaphore control operations
semget	SysV	get set of SysV semaphores
semop	SysV	SysV semaphore operations
send	Socket	send a message over a socket
setgrent	User	prepare group file for use
sethostent	Network	prepare hosts file for use
setnetent	Network	prepare networks file for use
setpgrp	Process	set the process group of a process
setpriority	Process	set a process's nice value
setprotoent	Network	prepare protocols file for use
setpwent	User	prepare passwd file for use
setservent	Network	prepare services file for use
setsockopt	Socket	set some socket options
shift	ARRAY	remove the first element of an array, and return it
shmctl	SysV	SysV shared memory operations
shmget	SysV	get SysV shared memory segment identifier
shmread	SysV	read SysV shared memory 
shmwrite	SysV	write SysV shared memory 
shutdown	Socket	close down just half of a socket connection
sin	Math	return the sine of a number
sleep	Process	block for some number of seconds
socket	Socket	create a socket
socketpair	Socket	create a pair of sockets
sort	LIST	sort a list of values 
splice	ARRAY	add or remove elements anywhere in an array
split	Regexp	split up a string using a regexp delimiter
sprintf	String	formatted print into a string	
sqrt	Math	square root function
srand	Math	seed the random number generator
stat	File	get a file's status information
study	Regexp	optimize input data for repeated searches
sub	Flow	declare a subroutine, possibly anonymously
substr	String	get or alter a portion of a stirng
symlink	File	create a symbolic link to a file
syscall	I/O,Binary	execute an arbitrary system call
sysread	I/O,Binary	fixed-length unbuffered input from a filehandle
sysseek	I/O,Binary	position I/O pointer on handle used with sysread and syswrite
system	Process	run a separate program 
syswrite	I/O,Binary	fixed-length unbuffered output to a filehandle
tell	I/O	get current seekpointer on a filehandle
telldir	I/O	get current seekpointer on a directory handle
tie	Objects	bind a variable to an object class 
time	Time	return number of seconds since 1970
times	Process,Time	return elapsed time for self and child processes
tr///	String	transliterate a string
truncate	I/O	shorten a file
uc	String	return upper-case version of a string
ucfirst	String	return a string with just the next letter in upper case
umask	File	set file creation mode mask
undef	Misc	remove a variable or function definition
unlink	File	remove one link to a file
unpack	Binary,LIST	convert binary structure into normal perl variables
unshift	ARRAY	prepend more elements to the beginning of a list
untie	Objects	break a tie binding to a variable
use	Modules,Namespace	load a module and import its namespace
use 	Objects	load in a module at compile time
utime	File	set a file's last access and modify times
values	HASH	return a list of the values in a hash
vec	Binary	test or set particular bits in a string
wait	Process	wait for any child process to die
waitpid	Process	wait for  a particular child process to die
wantarray	Misc,Flow	get void vs scalar vs list context of current subroutine call
warn	I/O	print debugging info
write	I/O	print a picture record
y///	String	transliterate a string
tml <hr>

I<$Id: //depot/libnet/Net/Domain.pm#19 $>

=cut
 c  H CA   8`  H CA c  H C݀A   8  8`    T:H CA c  H CɀA   8`  H CmA c  H CA c  |P|cP|cp|c| p| ,  ; A  8`  H C-A c  8%H CŀA                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 package Pod::Html;
use strict;
require Exporter;

use vars qw($VERSION @ISA @EXPORT);
$VERSION = 1.03;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);

use Carp;
use Config;
use Cwd;
use File::Spec;
use File::Spec::Unix;
use Getopt::Long;
use Pod::Functions;

use locale;	# make \w work right in non-ASCII lands

=head1 NAME

Pod::Html - module to convert pod files to HTML

=head1 SYNOPSIS

    use Pod::Html;
    pod2html([options]);

=head1 DESCRIPTION

Converts files from pod format (see L<perlpod>) to HTML format.  It
can automatically generate indexes and cross-references, and it keeps
a cache of things it knows how to cross-reference.

=head1 ARGUMENTS

Pod::Html takes the following arguments:

=over 4

=item backlink

    --backlink="Back to Top"

Adds "Back to Top" links in front of every HEAD1 heading (except for
the first).  By default, no backlink are being generated.

=item css

    --css=stylesheet

Specify the URL of a cascading style sheet.

=item flush

    --flush

Flushes the item and directory caches.

=item header

    --header
    --noheader

Creates header and footer blocks containing the text of the NAME
section.  By default, no headers are being generated.

=item help

    --help

Displays the usage message.

=item htmldir

    --htmldir=name

Sets the directory in which the resulting HTML file is placed.  This
is used to generate relative links to other files. Not passing this
causes all links to be absolute, since this is the value that tells
Pod::Html the root of the documentation tree.

=item htmlroot

    --htmlroot=name

Sets the base URL for the HTML files.  When cross-references are made,
the HTML root is prepended to the URL.

=item index

    --index
    --noindex

Generate an index at the top of the HTML file.  This is the default
behaviour.

=item infile

    --infile=name

Specify the pod file to convert.  Input is taken from STDIN if no
infile is specified.

=item libpods

    --libpods=name:...:name

List of page names (eg, "perlfunc") which contain linkable C<=item>s.

=item netscape

    --netscape
    --nonetscape

Use Netscape HTML directives when applicable.  By default, they will
B<not> be used.

=item outfile

    --outfile=name

Specify the HTML file to create.  Output goes to STDOUT if no outfile
is specified.

=item podpath

    --podpath=name:...:name

Specify which subdirectories of the podroot contain pod files whose
HTML converted forms can be linked-to in cross-references.

=item podroot

    --podroot=name

Specify the base directory for finding library pods.

=item quiet

    --quiet
    --noquiet

Don't display I<mostly harmless> warning messages.  These messages
will be displayed by default.  But this is not the same as C<verbose>
mode.

=item recurse

    --recurse
    --norecurse

Recurse into subdirectories specified in podpath (default behaviour).

=item title

    --title=title

Specify the title of the resulting HTML file.

=item verbose

    --verbose
    --noverbose

Display progress messages.  By default, they won't be displayed.

=back

=head1 EXAMPLE

    pod2html("pod2html",
	     "--podpath=lib:ext:pod:vms", 
	     "--podroot=/usr/src/perl",
	     "--htmlroot=/perl/nmanual",
	     "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
	     "--recurse",
	     "--infile=foo.pod",
	     "--outfile=/perl/nmanual/foo.html");

=head1 ENVIRONMENT

Uses $Config{pod2html} to setup default options.

=head1 AUTHOR

Tom Christiansen, E<lt>tchrist@perl.comE<gt>.

=head1 SEE ALSO

L<perlpod>

=head1 COPYRIGHT

This program is distributed under the Artistic License.

=cut

my $cache_ext = $^O eq 'VMS' ? ".tmp" : ".x~~";
my $dircache = "pod2htmd$cache_ext";
my $itemcache = "pod2htmi$cache_ext";

my @begin_stack = ();		# begin/end stack

my @libpods = ();	    	# files to search for links from C<> directives
my $htmlroot = "/";	    	# http-server base directory from which all
				#   relative paths in $podpath stem.
my $htmldir = "";		# The directory to which the html pages
				# will (eventually) be written.
my $htmlfile = "";		# write to stdout by default
my $htmlfileurl = "" ;		# The url that other files would use to
				# refer to this file.  This is only used
				# to make relative urls that point to
				# other files.
my $podfile = "";		# read from stdin by default
my @podpath = ();		# list of directories containing library pods.
my $podroot = File::Spec->curdir;		# filesystem base directory from which all
				#   relative paths in $podpath stem.
my $css = '';                   # Cascading style sheet
my $recurse = 1;		# recurse on subdirectories in $podpath.
my $quiet = 0;			# not quiet by default
my $verbose = 0;		# not verbose by default
my $doindex = 1;   	    	# non-zero if we should generate an index
my $backlink = '';              # text for "back to top" links
my $listlevel = 0;		# current list depth
my @listend = ();		# the text to use to end the list.
my $after_lpar = 0;             # set to true after a par in an =item
my $ignore = 1;			# whether or not to format text.  we don't
				#   format text until we hit our first pod
				#   directive.

my %items_named = ();		# for the multiples of the same item in perlfunc
my @items_seen = ();
my $netscape = 0;		# whether or not to use netscape directives.
my $title;			# title to give the pod(s)
my $header = 0;			# produce block header/footer
my $top = 1;			# true if we are at the top of the doc.  used
				#   to prevent the first <HR> directive.
my $paragraph;			# which paragraph we're processing (used
				#   for error messages)
my $ptQuote = 0;                # status of double-quote conversion
my %pages = ();			# associative array used to find the location
				#   of pages referenced by L<> links.
my %sections = ();		# sections within this page
my %items = ();			# associative array used to find the location
				#   of =item directives referenced by C<> links
my %local_items = ();           # local items - avoid destruction of %items
my $Is83;                       # is dos with short filenames (8.3)

sub init_globals {
$dircache = "pod2htmd$cache_ext";
$itemcache = "pod2htmi$cache_ext";

@begin_stack = ();		# begin/end stack

@libpods = ();	    	# files to search for links from C<> directives
$htmlroot = "/";	    	# http-server base directory from which all
				#   relative paths in $podpath stem.
$htmldir = "";	    	# The directory to which the html pages
				# will (eventually) be written.
$htmlfile = "";		# write to stdout by default
$podfile = "";		# read from stdin by default
@podpath = ();		# list of directories containing library pods.
$podroot = File::Spec->curdir;		# filesystem base directory from which all
				#   relative paths in $podpath stem.
$css = '';                   # Cascading style sheet
$recurse = 1;		# recurse on subdirectories in $podpath.
$quiet = 0;		# not quiet by default
$verbose = 0;		# not verbose by default
$doindex = 1;   	    	# non-zero if we should generate an index
$backlink = '';		# text for "back to top" links
$listlevel = 0;		# current list depth
@listend = ();		# the text to use to end the list.
$after_lpar = 0;        # set to true after a par in an =item
$ignore = 1;			# whether or not to format text.  we don't
				#   format text until we hit our first pod
				#   directive.

@items_seen = ();
%items_named = ();
$netscape = 0;		# whether or not to use netscape directives.
$header = 0;			# produce block header/footer
$title = '';			# title to give the pod(s)
$top = 1;			# true if we are at the top of the doc.  used
				#   to prevent the first <HR> directive.
$paragraph = '';			# which paragraph we're processing (used
				#   for error messages)
%sections = ();		# sections within this page

# These are not reinitialised here but are kept as a cache.
# See get_cache and related cache management code.
#%pages = ();			# associative array used to find the location
				#   of pages referenced by L<> links.
#%items = ();			# associative array used to find the location
				#   of =item directives referenced by C<> links
%local_items = ();
$Is83=$^O eq 'dos';
}

#
# clean_data: global clean-up of pod data
#
sub clean_data($){
    my( $dataref ) = @_;
    my $i;
    for( $i = 0; $i <= $#$dataref; $i++ ){
	${$dataref}[$i] =~ s/\s+\Z//;

        # have a look for all-space lines
	if( ${$dataref}[$i] =~ /^\s+$/m ){
	    my @chunks = split( /^\s+$/m, ${$dataref}[$i] );
	    splice( @$dataref, $i, 1, @chunks );
	}
    }
}


sub pod2html {
    local(@ARGV) = @_;
    local($/);
    local $_;

    init_globals();

    $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());

    # cache of %pages and %items from last time we ran pod2html

    #undef $opt_help if defined $opt_help;

    # parse the command-line parameters
    parse_command_line();

    # set some variables to their default values if necessary
    local *POD;
    unless (@ARGV && $ARGV[0]) { 
	$podfile  = "-" unless $podfile;	# stdin
	open(POD, "<$podfile")
		|| die "$0: cannot open $podfile file for input: $!\n";
    } else {
	$podfile = $ARGV[0];  # XXX: might be more filenames
	*POD = *ARGV;
    } 
    $htmlfile = "-" unless $htmlfile;	# stdout
    $htmlroot = "" if $htmlroot eq "/";	# so we don't get a //
    $htmldir =~ s#/\z## ;               # so we don't get a //
    if (  $htmlroot eq ''
       && defined( $htmldir ) 
       && $htmldir ne ''
       && substr( $htmlfile, 0, length( $htmldir ) ) eq $htmldir 
       ) 
    {
	# Set the 'base' url for this file, so that we can use it
	# as the location from which to calculate relative links 
	# to other files. If this is '', then absolute links will
	# be used throughout.
        $htmlfileurl= "$htmldir/" . substr( $htmlfile, length( $htmldir ) + 1);
    }

    # read the pod a paragraph at a time
    warn "Scanning for sections in input file(s)\n" if $verbose;
    $/ = "";
    my @poddata  = <POD>;
    close(POD);
    clean_data( \@poddata );

    # scan the pod for =head[1-6] directives and build an index
    my $index = scan_headings(\%sections, @poddata);

    unless($index) {
	warn "No headings in $podfile\n" if $verbose;
    }

    # open the output file
    open(HTML, ">$htmlfile")
	    || die "$0: cannot open $htmlfile file for output: $!\n";

    # put a title in the HTML file if one wasn't specified
    if ($title eq '') {
	TITLE_SEARCH: {
	    for (my $i = 0; $i < @poddata; $i++) { 
		if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
		    for my $para ( @poddata[$i, $i+1] ) { 
			last TITLE_SEARCH
			    if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
		    }
		} 

	    } 
	}
    }
    if (!$title and $podfile =~ /\.pod\z/) {
	# probably a split pod so take first =head[12] as title
	for (my $i = 0; $i < @poddata; $i++) { 
	    last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
	} 
	warn "adopted '$title' as title for $podfile\n"
	    if $verbose and $title;
    } 
    if ($title) {
	$title =~ s/\s*\(.*\)//;
    } else {
	warn "$0: no title for $podfile" unless $quiet;
	$podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
	$title = ($podfile eq "-" ? 'No Title' : $1);
	warn "using $title" if $verbose;
    }
    my $csslink = $css ? qq(\n<LINK REL="stylesheet" HREF="$css" TYPE="text/css">) : '';
    $csslink =~ s,\\,/,g;
    $csslink =~ s,(/.):,$1|,;

    my $block = $header ? <<END_OF_BLOCK : '';
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=100%>
<TR><TD CLASS=block VALIGN=MIDDLE WIDTH=100% BGCOLOR="#cccccc">
<FONT SIZE=+1><STRONG><P CLASS=block>&nbsp;$title</P></STRONG></FONT>
</TD></TR>
</TABLE>
END_OF_BLOCK

    print HTML <<END_OF_HEAD;
<HTML>
<HEAD>
<TITLE>$title</TITLE>$csslink
<LINK REV="made" HREF="mailto:$Config{perladmin}">
</HEAD>

<BODY>
$block
END_OF_HEAD

    # load/reload/validate/cache %pages and %items
    get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);

    # scan the pod for =item directives
    scan_items( \%local_items, "", @poddata);

    # put an index at the top of the file.  note, if $doindex is 0 we
    # still generate an index, but surround it with an html comment.
    # that way some other program can extract it if desired.
    $index =~ s/--+/-/g;
    print HTML "<A NAME=\"__index__\"></A>\n";
    print HTML "<!-- INDEX BEGIN -->\n";
    print HTML "<!--\n" unless $doindex;
    print HTML $index;
    print HTML "-->\n" unless $doindex;
    print HTML "<!-- INDEX END -->\n\n";
    print HTML "<HR>\n" if $doindex and $index;

    # now convert this file
    my $after_item;             # set to true after an =item
    warn "Converting input file $podfile\n" if $verbose;
    foreach my $i (0..$#poddata){
        $ptQuote = 0; # status of quote conversion

	$_ = $poddata[$i];
	$paragraph = $i+1;
	if (/^(=.*)/s) {	# is it a pod directive?
	    $ignore = 0;
	    $after_item = 0;
	    $_ = $1;
	    if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
		process_begin($1, $2);
	    } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
		process_end($1, $2);
	    } elsif (/^=cut/) {			# =cut
		process_cut();
	    } elsif (/^=pod/) {			# =pod
		process_pod();
	    } else {
		next if @begin_stack && $begin_stack[-1] ne 'html';

		if (/^=(head[1-6])\s+(.*\S)/s) {	# =head[1-6] heading
		    process_head( $1, $2, $doindex && $index );
		} elsif (/^=item\s*(.*\S)?/sm) {	# =item text
		    warn "$0: $podfile: =item without bullet, number or text"
		       . " in paragraph $paragraph.\n" if !defined($1) or $1 eq '';
		    process_item( $1 );
		    $after_item = 1;
		} elsif (/^=over\s*(.*)/) {		# =over N
		    process_over();
		} elsif (/^=back/) {		# =back
		    process_back();
		} elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
		    process_for($1,$2);
		} else {
		    /^=(\S*)\s*/;
		    warn "$0: $podfile: unknown pod directive '$1' in "
		       . "paragraph $paragraph.  ignoring.\n";
		}
	    }
	    $top = 0;
	}
	else {
	    next if $ignore;
	    next if @begin_stack && $begin_stack[-1] ne 'html';
	    my $text = $_;
	    if( $text =~ /\A\s+/ ){
		process_pre( \$text );
	        print HTML "<PRE>\n$text</PRE>\n";

	    } else {
		process_text( \$text );

		# experimental: check for a paragraph where all lines
		# have some ...\t...\t...\n pattern
		if( $text =~ /\t/ ){
		    my @lines = split( "\n", $text );
		    if( @lines > 1 ){
			my $all = 2;
			foreach my $line ( @lines ){
			    if( $line =~ /\S/ && $line !~ /\t/ ){
				$all--;
				last if $all == 0;
			    }
			}
			if( $all > 0 ){
			    $text =~ s/\t+/<TD>/g;
			    $text =~ s/^/<TR><TD>/gm;
			    $text = '<TABLE CELLSPACING=0 CELLPADDING=0>' .
                                    $text . '</TABLE>';
			}
		    }
		}
		## end of experimental

		if( $after_item ){
		    print HTML "$text\n";
		    $after_lpar = 1;
		} else {
		    print HTML "<P>$text</P>\n";
		}
	    }
	    $after_item = 0;
	}
    }

    # finish off any pending directives
    finish_list();

    # link to page index
    print HTML "<P><A HREF=\"#__index__\"><SMALL>$backlink</SMALL></A></P>\n"
	if $doindex and $index and $backlink;

    print HTML <<END_OF_TAIL;
$block
</BODY>

</HTML>
END_OF_TAIL

    # close the html file
    close(HTML);

    warn "Finished\n" if $verbose;
}

##############################################################################

my $usage;			# see below
sub usage {
    my $podfile = shift;
    warn "$0: $podfile: @_\n" if @_;
    die $usage;
}

$usage =<<END_OF_USAGE;
Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
           --podpath=<name>:...:<name> --podroot=<name>
           --libpods=<name>:...:<name> --recurse --verbose --index
           --netscape --norecurse --noindex

  --backlink     - set text for "back to top" links (default: none).
  --css          - stylesheet URL
  --flush        - flushes the item and directory caches.
  --[no]header   - produce block header/footer (default is no headers).
  --help         - prints this message.
  --htmldir      - directory for resulting HTML files.
  --htmlroot     - http-server base directory from which all relative paths
                   in podpath stem (default is /).
  --[no]index    - generate an index at the top of the resulting html
                   (default behaviour).
  --infile       - filename for the pod to convert (input taken from stdin
                   by default).
  --libpods      - colon-separated list of pages to search for =item pod
                   directives in as targets of C<> and implicit links (empty
                   by default).  note, these are not filenames, but rather
                   page names like those that appear in L<> links.
  --[no]netscape - will use netscape html directives when applicable.
                   (default is not to use them).
  --outfile      - filename for the resulting html file (output sent to
                   stdout by default).
  --podpath      - colon-separated list of directories containing library
                   pods (empty by default).
  --podroot      - filesystem base directory from which all relative paths
                   in podpath stem (default is .).
  --[no]quiet    - supress some benign warning messages (default is off).
  --[no]recurse  - recurse on those subdirectories listed in podpath
                   (default behaviour).
  --title        - title that will appear in resulting html file.
  --[no]verbose  - self-explanatory (off by default).

END_OF_USAGE

sub parse_command_line {
    my ($opt_backlink,$opt_css,$opt_flush,$opt_header,$opt_help,$opt_htmldir,
	$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,
	$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,$opt_recurse,
	$opt_title,$opt_verbose);

    unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
    my $result = GetOptions(
			    'backlink=s' => \$opt_backlink,
			    'css=s'      => \$opt_css,
			    'flush'      => \$opt_flush,
			    'header!'    => \$opt_header,
			    'help'       => \$opt_help,
			    'htmldir=s'  => \$opt_htmldir,
			    'htmlroot=s' => \$opt_htmlroot,
			    'index!'     => \$opt_index,
			    'infile=s'   => \$opt_infile,
			    'libpods=s'  => \$opt_libpods,
			    'netscape!'  => \$opt_netscape,
			    'outfile=s'  => \$opt_outfile,
			    'podpath=s'  => \$opt_podpath,
			    'podroot=s'  => \$opt_podroot,
			    'quiet!'     => \$opt_quiet,
			    'recurse!'   => \$opt_recurse,
			    'title=s'    => \$opt_title,
			    'verbose!'   => \$opt_verbose,
			   );
    usage("-", "invalid parameters") if not $result;

    usage("-") if defined $opt_help;	# see if the user asked for help
    $opt_help = "";			# just to make -w shut-up.

    @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
    @libpods  = split(":", $opt_libpods) if defined $opt_libpods;

    $backlink = $opt_backlink if defined $opt_backlink;
    $css      = $opt_css      if defined $opt_css;
    $header   = $opt_header   if defined $opt_header;
    $htmldir  = $opt_htmldir  if defined $opt_htmldir;
    $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
    $doindex  = $opt_index    if defined $opt_index;
    $podfile  = $opt_infile   if defined $opt_infile;
    $netscape = $opt_netscape if defined $opt_netscape;
    $htmlfile = $opt_outfile  if defined $opt_outfile;
    $podroot  = $opt_podroot  if defined $opt_podroot;
    $quiet    = $opt_quiet    if defined $opt_quiet;
    $recurse  = $opt_recurse  if defined $opt_recurse;
    $title    = $opt_title    if defined $opt_title;
    $verbose  = $opt_verbose  if defined $opt_verbose;

    warn "Flushing item and directory caches\n"
	if $opt_verbose && defined $opt_flush;
    unlink($dircache, $itemcache) if defined $opt_flush;
}


my $saved_cache_key;

sub get_cache {
    my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
    my @cache_key_args = @_;

    # A first-level cache:
    # Don't bother reading the cache files if they still apply
    # and haven't changed since we last read them.

    my $this_cache_key = cache_key(@cache_key_args);

    return if $saved_cache_key and $this_cache_key eq $saved_cache_key;

    # load the cache of %pages and %items if possible.  $tests will be
    # non-zero if successful.
    my $tests = 0;
    if (-f $dircache && -f $itemcache) {
	warn "scanning for item cache\n" if $verbose;
	$tests = load_cache($dircache, $itemcache, $podpath, $podroot);
    }

    # if we didn't succeed in loading the cache then we must (re)build
    #  %pages and %items.
    if (!$tests) {
	warn "scanning directories in pod-path\n" if $verbose;
	scan_podpath($podroot, $recurse, 0);
    }
    $saved_cache_key = cache_key(@cache_key_args);
}

sub cache_key {
    my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
    return join('!', $dircache, $itemcache, $recurse,
	@$podpath, $podroot, stat($dircache), stat($itemcache));
}

#
# load_cache - tries to find if the caches stored in $dircache and $itemcache
#  are valid caches of %pages and %items.  if they are valid then it loads
#  them and returns a non-zero value.
#
sub load_cache {
    my($dircache, $itemcache, $podpath, $podroot) = @_;
    my($tests);
    local $_;

    $tests = 0;

    open(CACHE, "<$itemcache") ||
	die "$0: error opening $itemcache for reading: $!\n";
    $/ = "\n";

    # is it the same podpath?
    $_ = <CACHE>;
    chomp($_);
    $tests++ if (join(":", @$podpath) eq $_);

    # is it the same podroot?
    $_ = <CACHE>;
    chomp($_);
    $tests++ if ($podroot eq $_);

    # load the cache if its good
    if ($tests != 2) {
	close(CACHE);
	return 0;
    }

    warn "loading item cache\n" if $verbose;
    while (<CACHE>) {
	/(.*?) (.*)$/;
	$items{$1} = $2;
    }
    close(CACHE);

    warn "scanning for directory cache\n" if $verbose;
    open(CACHE, "<$dircache") ||
	die "$0: error opening $dircache for reading: $!\n";
    $/ = "\n";
    $tests = 0;

    # is it the same podpath?
    $_ = <CACHE>;
    chomp($_);
    $tests++ if (join(":", @$podpath) eq $_);

    # is it the same podroot?
    $_ = <CACHE>;
    chomp($_);
    $tests++ if ($podroot eq $_);

    # load the cache if its good
    if ($tests != 2) {
	close(CACHE);
	return 0;
    }

    warn "loading directory cache\n" if $verbose;
    while (<CACHE>) {
	/(.*?) (.*)$/;
	$pages{$1} = $2;
    }

    close(CACHE);

    return 1;
}

#
# scan_podpath - scans the directories specified in @podpath for directories,
#  .pod files, and .pm files.  it also scans the pod files specified in
#  @libpods for =item directives.
#
sub scan_podpath {
    my($podroot, $recurse, $append) = @_;
    my($pwd, $dir);
    my($libpod, $dirname, $pod, @files, @poddata);

    unless($append) {
	%items = ();
	%pages = ();
    }

    # scan each directory listed in @podpath
    $pwd = getcwd();
    chdir($podroot)
	|| die "$0: error changing to directory $podroot: $!\n";
    foreach $dir (@podpath) {
	scan_dir($dir, $recurse);
    }

    # scan the pods listed in @libpods for =item directives
    foreach $libpod (@libpods) {
	# if the page isn't defined then we won't know where to find it
	# on the system.
	next unless defined $pages{$libpod} && $pages{$libpod};

	# if there is a directory then use the .pod and .pm files within it.
	# NOTE: Only finds the first so-named directory in the tree.
#	if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
	if ($pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
	    #  find all the .pod and .pm files within the directory
	    $dirname = $1;
	    opendir(DIR, $dirname) ||
		die "$0: error opening directory $dirname: $!\n";
	    @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR));
	    closedir(DIR);

	    # scan each .pod and .pm file for =item directives
	    foreach $pod (@files) {
		open(POD, "<$dirname/$pod") ||
		    die "$0: error opening $dirname/$pod for input: $!\n";
		@poddata = <POD>;
		close(POD);
		clean_data( \@poddata );

		scan_items( \%items, "$dirname/$pod", @poddata);
	    }

	    # use the names of files as =item directives too.
### Don't think this should be done this way - confuses issues.(WL)
###	    foreach $pod (@files) {
###		$pod =~ /^(.*)(\.pod|\.pm)$/;
###		$items{$1} = "$dirname/$1.html" if $1;
###	    }
	} elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
		 $pages{$libpod} =~ /([^:]*\.pm):/) {
	    # scan the .pod or .pm file for =item directives
	    $pod = $1;
	    open(POD, "<$pod") ||
		die "$0: error opening $pod for input: $!\n";
	    @poddata = <POD>;
	    close(POD);
	    clean_data( \@poddata );

	    scan_items( \%items, "$pod", @poddata);
	} else {
	    warn "$0: shouldn't be here (line ".__LINE__."\n";
	}
    }
    @poddata = ();	# clean-up a bit

    chdir($pwd)
	|| die "$0: error changing to directory $pwd: $!\n";

    # cache the item list for later use
    warn "caching items for later use\n" if $verbose;
    open(CACHE, ">$itemcache") ||
	die "$0: error open $itemcache for writing: $!\n";

    print CACHE join(":", @podpath) . "\n$podroot\n";
    foreach my $key (keys %items) {
	print CACHE "$key $items{$key}\n";
    }

    close(CACHE);

    # cache the directory list for later use
    warn "caching directories for later use\n" if $verbose;
    open(CACHE, ">$dircache") ||
	die "$0: error open $dircache for writing: $!\n";

    print CACHE join(":", @podpath) . "\n$podroot\n";
    foreach my $key (keys %pages) {
	print CACHE "$key $pages{$key}\n";
    }

    close(CACHE);
}

#
# scan_dir - scans the directory specified in $dir for subdirectories, .pod
#  files, and .pm files.  notes those that it finds.  this information will
#  be used later in order to figure out where the pages specified in L<>
#  links are on the filesystem.
#
sub scan_dir {
    my($dir, $recurse) = @_;
    my($t, @subdirs, @pods, $pod, $dirname, @dirs);
    local $_;

    @subdirs = ();
    @pods = ();

    opendir(DIR, $dir) ||
	die "$0: error opening directory $dir: $!\n";
    while (defined($_ = readdir(DIR))) {
	if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {	    # directory
	    $pages{$_}  = "" unless defined $pages{$_};
	    $pages{$_} .= "$dir/$_:";
	    push(@subdirs, $_);
	} elsif (/\.pod\z/) {	    	    	    	    # .pod
	    s/\.pod\z//;
	    $pages{$_}  = "" unless defined $pages{$_};
	    $pages{$_} .= "$dir/$_.pod:";
	    push(@pods, "$dir/$_.pod");
	} elsif (/\.html\z/) { 	    	    	    	    # .html
	    s/\.html\z//;
	    $pages{$_}  = "" unless defined $pages{$_};
	    $pages{$_} .= "$dir/$_.pod:";
	} elsif (/\.pm\z/) { 	    	    	    	    # .pm
	    s/\.pm\z//;
	    $pages{$_}  = "" unless defined $pages{$_};
	    $pages{$_} .= "$dir/$_.pm:";
	    push(@pods, "$dir/$_.pm");
	}
    }
    closedir(DIR);

    # recurse on the subdirectories if necessary
    if ($recurse) {
	foreach my $subdir (@subdirs) {
	    scan_dir("$dir/$subdir", $recurse);
	}
    }
}

#
# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
#  build an index.
#
sub scan_headings {
    my($sections, @data) = @_;
    my($tag, $which_head, $otitle, $listdepth, $index);

    # here we need	local $ignore = 0;
    #  unfortunately, we can't have it, because $ignore is lexical
    $ignore = 0;

    $listdepth = 0;
    $index = "";

    # scan for =head directives, note their name, and build an index
    #  pointing to each of them.
    foreach my $line (@data) {
	if ($line =~ /^=(head)([1-6])\s+(.*)/) {
	    ($tag, $which_head, $otitle) = ($1,$2,$3);

            my $title = depod( $otitle );
            my $name = htmlify( $title );
	    $$sections{$name} = 1;
	    $title = process_text( \$otitle );

	    while ($which_head != $listdepth) {
		if ($which_head > $listdepth) {
		    $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
		    $listdepth++;
		} elsif ($which_head < $listdepth) {
		    $listdepth--;
		    $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
		}
	    }

	    $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
	              "<A HREF=\"#" . $name . "\">" .
		      $title . "</A></LI>";
	}
    }

    # finish off the lists
    while ($listdepth--) {
	$index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
    }

    # get rid of bogus lists
    $index =~ s,\t*<UL>\s*</UL>\n,,g;

    $ignore = 1;	# restore old value;

    return $index;
}

#
# scan_items - scans the pod specified by $pod for =item directives.  we
#  will use this information later on in resolving C<> links.
#
sub scan_items {
    my( $itemref, $pod, @poddata ) = @_;
    my($i, $item);
    local $_;

    $pod =~ s/\.pod\z//;
    $pod .= ".html" if $pod;

    foreach $i (0..$#poddata) {
	my $txt = depod( $poddata[$i] );

	# figure out what kind of item it is.
	# Build string for referencing this item.
	if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
	    next unless $1;
	    $item = $1;
        } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
	    $item = $1;
	} elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
	    $item = $1;
	} else {
	    next;
	}
	my $fid = fragment_id( $item );
	$$itemref{$fid} = "$pod" if $fid;
    }
}

#
# process_head - convert a pod head[1-6] tag and convert it to HTML format.
#
sub process_head {
    my($tag, $heading, $hasindex) = @_;

    # figure out the level of the =head
    $tag =~ /head([1-6])/;
    my $level = $1;

    if( $listlevel ){
	warn "$0: $podfile: unterminated list at =head in paragraph $paragraph.  ignoring.\n";
        while( $listlevel ){
            process_back();
        }
    }

    print HTML "<P>\n";
    if( $level == 1 && ! $top ){
	print HTML "<A HREF=\"#__index__\"><SMALL>$backlink</SMALL></A>\n"
	    if $hasindex and $backlink;
	print HTML "<HR>\n"
    }

    my $name = htmlify( depod( $heading ) );
    my $convert = process_text( \$heading );
    print HTML "<H$level><A NAME=\"$name\">$convert</A></H$level>\n";
}


#
# emit_item_tag - print an =item's text
# Note: The global $EmittedItem is used for inhibiting self-references.
#
my $EmittedItem;

sub emit_item_tag($$$){
    my( $otext, $text, $compact ) = @_;
    my $item = fragment_id( $text );

    $EmittedItem = $item;
    ### print STDERR "emit_item_tag=$item ($text)\n";

    print HTML '<STRONG>';
    if ($items_named{$item}++) {
	print HTML process_text( \$otext );
    } else {
	my $name = 'item_' . $item;
	print HTML qq{<A NAME="$name">}, process_text( \$otext ), '</A>';
    }
    print HTML "</STRONG><BR>\n";
    undef( $EmittedItem );
}

sub emit_li {
    my( $tag ) = @_;
    if( $items_seen[$listlevel]++ == 0 ){
	push( @listend, "</$tag>" );
	print HTML "<$tag>\n";
    }
    print HTML $tag eq 'DL' ? '<DT>' : '<LI>';
}

#
# process_item - convert a pod item tag and convert it to HTML format.
#
sub process_item {
    my( $otext ) = @_;

    # lots of documents start a list without doing an =over.  this is
    # bad!  but, the proper thing to do seems to be to just assume
    # they did do an =over.  so warn them once and then continue.
    if( $listlevel == 0 ){
	warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n";
	process_over();
    }

    # formatting: insert a paragraph if preceding item has >1 paragraph
    if( $after_lpar ){
	print HTML "<P></P>\n";
	$after_lpar = 0;
    }

    # remove formatting instructions from the text
    my $text = depod( $otext );

    # all the list variants:
    if( $text =~ /\A\*/ ){ # bullet
        emit_li( 'UL' );
	if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
	    my $tag = $1;
	    $otext =~ s/\A\*\s+//;
	    emit_item_tag( $otext, $tag, 1 );
	}

    } elsif( $text =~ /\A\d+/ ){ # numbered list
	emit_li( 'OL' );
	if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
	    my $tag = $1;
	    $otext =~ s/\A\d+\.?\s*//;
	    emit_item_tag( $otext, $tag, 1 );
	}

    } else {			# definition list
	emit_li( 'DL' );
	if ($text =~ /\A(.+)\Z/s ){ # should have text
	    emit_item_tag( $otext, $text, 1 );
	}
       print HTML '<DD>';
    }
    print HTML "\n";
}

#
# process_over - process a pod over tag and start a corresponding HTML list.
#
sub process_over {
    # start a new list
    $listlevel++;
    push( @items_seen, 0 );
    $after_lpar = 0;
}

#
# process_back - process a pod back tag and convert it to HTML format.
#
sub process_back {
    if( $listlevel == 0 ){
	warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignoring.\n";
	return;
    }

    # close off the list.  note, I check to see if $listend[$listlevel] is
    # defined because an =item directive may have never appeared and thus
    # $listend[$listlevel] may have never been initialized.
    $listlevel--;
    if( defined $listend[$listlevel] ){
	print HTML '<P></P>' if $after_lpar;
	print HTML $listend[$listlevel];
        print HTML "\n";
        pop( @listend );
    }
    $after_lpar = 0;

    # clean up item count
    pop( @items_seen );
}

#
# process_cut - process a pod cut tag, thus start ignoring pod directives.
#
sub process_cut {
    $ignore = 1;
}

#
# process_pod - process a pod pod tag, thus stop ignoring pod directives
# until we see a corresponding cut.
#
sub process_pod {
    # no need to set $ignore to 0 cause the main loop did it
}

#
# process_for - process a =for pod tag.  if it's for html, spit
# it out verbatim, if illustration, center it, otherwise ignore it.
#
sub process_for {
    my($whom, $text) = @_;
    if ( $whom =~ /^(pod2)?html$/i) {
	print HTML $text;
    } elsif ($whom =~ /^illustration$/i) {
        1 while chomp $text;
	for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
	  $text .= $ext, last if -r "$text$ext";
	}
        print HTML qq{<p align = "center"><img src = "$text" alt = "$text illustration"></p>};
    }
}

#
# process_begin - process a =begin pod tag.  this pushes
# whom we're beginning on the begin stack.  if there's a
# begin stack, we only print if it us.
#
sub process_begin {
    my($whom, $text) = @_;
    $whom = lc($whom);
    push (@begin_stack, $whom);
    if ( $whom =~ /^(pod2)?html$/) {
	print HTML $text if $text;
    }
}

#
# process_end - process a =end pod tag.  pop the
# begin stack.  die if we're mismatched.
#
sub process_end {
    my($whom, $text) = @_;
    $whom = lc($whom);
    if ($begin_stack[-1] ne $whom ) {
	die "Unmatched begin/end at chunk $paragraph\n"
    } 
    pop( @begin_stack );
}

#
# process_pre - indented paragraph, made into <PRE></PRE>
#
sub process_pre {
    my( $text ) = @_;
    my( $rest );
    return if $ignore;

    $rest = $$text;

    # insert spaces in place of tabs
    $rest =~ s#.*#
	    my $line = $&;
	    1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
	    $line;
	#eg;

    # convert some special chars to HTML escapes
    $rest =~ s/&/&amp;/g;
    $rest =~ s/</&lt;/g;
    $rest =~ s/>/&gt;/g;
    $rest =~ s/"/&quot;/g;

    # try and create links for all occurrences of perl.* within
    # the preformatted text.
    $rest =~ s{
	         (\s*)(perl\w+)
	      }{
		 if ( defined $pages{$2} ){	# is a link
		     qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
		 } elsif (defined $pages{dosify($2)}) {	# is a link
		     qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
		 } else {
		     "$1$2";
		 }
	      }xeg;
     $rest =~ s{
		 (<A\ HREF="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
               }{
                  my $url ;
                  if ( $htmlfileurl ne '' ){
		     # Here, we take advantage of the knowledge 
		     # that $htmlfileurl ne '' implies $htmlroot eq ''.
		     # Since $htmlroot eq '', we need to prepend $htmldir
		     # on the fron of the link to get the absolute path
		     # of the link's target. We check for a leading '/'
		     # to avoid corrupting links that are #, file:, etc.
		     my $old_url = $3 ;
		     $old_url = "$htmldir$old_url" if $old_url =~ m{^\/};
 		     $url = relativize_url( "$old_url.html", $htmlfileurl );
	          } else {
		     $url = "$3.html" ;
		  }
		  "$1$url" ;
	       }xeg;

    # Look for embedded URLs and make them into links.  We don't
    # relativize them since they are best left as the author intended.

    my $urls = '(' . join ('|', qw{
                http
                telnet
		mailto
		news
                gopher
                file
                wais
                ftp
            } ) 
        . ')';
  
    my $ltrs = '\w';
    my $gunk = '/#~:.?+=&%@!\-';
    my $punc = '.:?\-';
    my $any  = "${ltrs}${gunk}${punc}";

    $rest =~ s{
        \b                          # start at word boundary
        (                           # begin $1  {
          $urls     :               # need resource and a colon
	  (?!:)                     # Ignore File::, among others.
          [$any] +?                 # followed by on or more
                                    #  of any valid character, but
                                    #  be conservative and take only
                                    #  what you need to....
        )                           # end   $1  }
        (?=                         # look-ahead non-consumptive assertion
                [$punc]*            # either 0 or more puntuation
                [^$any]             #   followed by a non-url char
            |                       # or else
                $                   #   then end of the string
        )
      }{<A HREF="$1">$1</A>}igox;

    # text should be as it is (verbatim)
    $$text = $rest;
}


#
# pure text processing
#
# pure_text/inIS_text: differ with respect to automatic C<> recognition.
# we don't want this to happen within IS
#
sub pure_text($){
    my $text = shift();
    process_puretext( $text, \$ptQuote, 1 );
}

sub inIS_text($){
    my $text = shift();
    process_puretext( $text, \$ptQuote, 0 );
}

#
# process_puretext - process pure text (without pod-escapes) converting
#  double-quotes and handling implicit C<> links.
#
sub process_puretext {
    my($text, $quote, $notinIS) = @_;

    ## Guessing at func() or [$@%&]*var references in plain text is destined
    ## to produce some strange looking ref's. uncomment to disable:
    ## $notinIS = 0;

    my(@words, $lead, $trail);

    # convert double-quotes to single-quotes
    if( $$quote && $text =~ s/"/''/s ){
        $$quote = 0;
    }
    while ($text =~ s/"([^"]*)"/``$1''/sg) {};
    $$quote = 1 if $text =~ s/"/``/s;

    # keep track of leading and trailing white-space
    $lead  = ($text =~ s/\A(\s+)//s ? $1 : "");
    $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");

    # split at space/non-space boundaries
    @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );

    # process each word individually
    foreach my $word (@words) {
	# skip space runs
 	next if $word =~ /^\s*$/;
	# see if we can infer a link
	if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
	    # has parenthesis so should have been a C<> ref
            ## try for a pagename (perlXXX(1))?
            my( $func, $args ) = ( $1, $2 );
            if( $args =~ /^\d+$/ ){
                my $url = page_sect( $word, '' );
                if( defined $url ){
                    $word = "<A HREF=\"$url\">the $word manpage</A>";
                    next;
                }
            }
            ## try function name for a link, append tt'ed argument list
            $word = emit_C( $func, '', "($args)");

#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
##      } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
##	    # perl variables, should be a C<> ref
##	    $word = emit_C( $word );

	} elsif ($word =~ m,^\w+://\w,) {
	    # looks like a URL
            # Don't relativize it: leave it as the author intended
	    $word = qq(<A HREF="$word">$word</A>);
	} elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
	    # looks like an e-mail address
	    my ($w1, $w2, $w3) = ("", $word, "");
	    ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
	    ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
	    $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
	} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) {  # all uppercase?
	    $word = html_escape($word) if $word =~ /["&<>]/;
	    $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
	} else { 
	    $word = html_escape($word) if $word =~ /["&<>]/;
	}
    }

    # put everything back together
    return $lead . join( '', @words ) . $trail;
}


#
# process_text - handles plaintext that appears in the input pod file.
# there may be pod commands embedded within the text so those must be
# converted to html commands.
#

sub process_text1($$;$$);
sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }

sub process_text {
    return if $ignore;
    my( $tref ) = @_;
    my $res = process_text1( 0, $tref );
    $$tref = $res;
}

sub process_text1($$;$$){
    my( $lev, $rstr, $func, $closing ) = @_;
    my $res = '';

    unless (defined $func) {
	$func = '';
	$lev++;
    }

    if( $func eq 'B' ){
	# B<text> - boldface
	$res = '<STRONG>' . process_text1( $lev, $rstr ) . '</STRONG>';

    } elsif( $func eq 'C' ){
	# C<code> - can be a ref or <CODE></CODE>
	# need to extract text
	my $par = go_ahead( $rstr, 'C', $closing );

	## clean-up of the link target
        my $text = depod( $par );

	### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
        ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n"; 

	$res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );

    } elsif( $func eq 'E' ){
	# E<x> - convert to character
	$$rstr =~ s/^([^>]*)>//;
	my $escape = $1;
	$escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
	$res = "&$escape;";

    } elsif( $func eq 'F' ){
	# F<filename> - italizice
	$res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';

    } elsif( $func eq 'I' ){
	# I<text> - italizice
	$res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';

    } elsif( $func eq 'L' ){
	# L<link> - link
	## L<text|cross-ref> => produce text, use cross-ref for linking 
	## L<cross-ref> => make text from cross-ref
	## need to extract text
	my $par = go_ahead( $rstr, 'L', $closing );

        # some L<>'s that shouldn't be:
	# a) full-blown URL's are emitted as-is
        if( $par =~ m{^\w+://}s ){
	    return make_URL_href( $par );
	}
        # b) C<...> is stripped and treated as C<>
        if( $par =~ /^C<(.*)>$/ ){
	    my $text = depod( $1 );
 	    return emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
	}

	# analyze the contents
	$par =~ s/\n/ /g;   # undo word-wrapped tags
        my $opar = $par;
	my $linktext;
	if( $par =~ s{^([^|]+)\|}{} ){
	    $linktext = $1;
	}
    
	# make sure sections start with a /
	$par =~ s{^"}{/"};

	my( $page, $section, $ident );

	# check for link patterns
	if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){     # name/ident
            # we've got a name/ident (no quotes) 
            ( $page, $ident ) = ( $1, $2 );
            ### print STDERR "--> L<$par> to page $page, ident $ident\n";

	} elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section"
            # even though this should be a "section", we go for ident first
	    ( $page, $ident ) = ( $1, $2 );
            ### print STDERR "--> L<$par> to page $page, section $section\n";

	} elsif( $par =~ /\s/ ){  # this must be a section with missing quotes
	    ( $page, $section ) = ( '', $par );
            ### print STDERR "--> L<$par> to void page, section $section\n";

        } else {
	    ( $page, $section ) = ( $par, '' );
            ### print STDERR "--> L<$par> to page $par, void section\n";
	}

        # now, either $section or $ident is defined. the convoluted logic
        # below tries to resolve L<> according to what the user specified.
        # failing this, we try to find the next best thing...
        my( $url, $ltext, $fid );

        RESOLVE: {
            if( defined $ident ){
                ## try to resolve $ident as an item
	        ( $url, $fid ) = coderef( $page, $ident );
                if( $url ){
                    if( ! defined( $linktext ) ){
                        $linktext = $ident;
                        $linktext .= " in " if $ident && $page;
                        $linktext .= "the $page manpage" if $page;
                    }
                    ###  print STDERR "got coderef url=$url\n";
                    last RESOLVE;
                }
                ## no luck: go for a section (auto-quoting!)
                $section = $ident;
            }
            ## now go for a section
            my $htmlsection = htmlify( $section );
 	    $url = page_sect( $page, $htmlsection );
            if( $url ){
                if( ! defined( $linktext ) ){
                    $linktext = $section;
                    $linktext .= " in " if $section && $page;
                    $linktext .= "the $page manpage" if $page;
                }
                ### print STDERR "got page/section url=$url\n";
                last RESOLVE;
            }
            ## no luck: go for an ident 
            if( $section ){
                $ident = $section;
            } else {
                $ident = $page;
                $page  = undef();
            }
            ( $url, $fid ) = coderef( $page, $ident );
            if( $url ){
                if( ! defined( $linktext ) ){
                    $linktext = $ident;
                    $linktext .= " in " if $ident && $page;
                    $linktext .= "the $page manpage" if $page;
                }
                ### print STDERR "got section=>coderef url=$url\n";
                last RESOLVE;
            }

            # warning; show some text.
            $linktext = $opar unless defined $linktext;
            warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.";
        }

        # now we have an URL or just plain code
        $$rstr = $linktext . '>' . $$rstr;
        if( defined( $url ) ){
            $res = "<A HREF=\"$url\">" . process_text1( $lev, $rstr ) . '</A>';
        } else {
	    $res = '<EM>' . process_text1( $lev, $rstr ) . '</EM>';
        }

    } elsif( $func eq 'S' ){
	# S<text> - non-breaking spaces
	$res = process_text1( $lev, $rstr );
	$res =~ s/ /&nbsp;/g;

    } elsif( $func eq 'X' ){
	# X<> - ignore
	$$rstr =~ s/^[^>]*>//;

    } elsif( $func eq 'Z' ){
	# Z<> - empty 
	warn "$0: $podfile: invalid X<> in paragraph $paragraph."
	    unless $$rstr =~ s/^>//;

    } else {
        my $term = pattern $closing;
	while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
	    # all others: either recurse into new function or
	    # terminate at closing angle bracket(s)
	    my $pt = $1;
            $pt .= $2 if !$3 &&  $lev == 1;
	    $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt );
	    return $res if !$3 && $lev > 1;
            if( $3 ){
		$res .= process_text1( $lev, $rstr, $3, closing $4 );
 	    }
	}
	if( $lev == 1 ){
	    $res .= pure_text( $$rstr );
	} else {
	    warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.";
	}
    }
    return $res;
}

#
# go_ahead: extract text of an IS (can be nested)
#
sub go_ahead($$$){
    my( $rstr, $func, $closing ) = @_;
    my $res = '';
    my @closing = ($closing);
    while( $$rstr =~
      s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
	$res .= $1;
	unless( $3 ){
	    shift @closing;
	    return $res unless @closing;
	} else {
	    unshift @closing, closing $4;
	}
	$res .= $2;
    }
    warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.";
    return $res;
}

#
# emit_C - output result of C<text>
#    $text is the depod-ed text
#
sub emit_C($;$$){
    my( $text, $nocode, $args ) = @_;
    $args = '' unless defined $args;
    my $res;
    my( $url, $fid ) = coderef( undef(), $text );

    # need HTML-safe text
    my $linktext = html_escape( "$text$args" );

    if( defined( $url ) &&
        (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
	$res = "<A HREF=\"$url\"><CODE>$linktext</CODE></A>";
    } elsif( 0 && $nocode ){
	$res = $linktext;
    } else {
	$res = "<CODE>$linktext</CODE>";
    }
    return $res;
}

#
# html_escape: make text safe for HTML
#
sub html_escape {
    my $rest = $_[0];
    $rest   =~ s/&/&amp;/g;
    $rest   =~ s/</&lt;/g;
    $rest   =~ s/>/&gt;/g;
    $rest   =~ s/"/&quot;/g;
    return $rest;
} 


#
# dosify - convert filenames to 8.3
#
sub dosify {
    my($str) = @_;
    return lc($str) if $^O eq 'VMS';     # VMS just needs casing
    if ($Is83) {
        $str = lc $str;
        $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
        $str =~ s/(\w+)/substr ($1,0,8)/ge;
    }
    return $str;
}

#
# page_sect - make an URL from the text of a L<>
#
sub page_sect($$) {
    my( $page, $section ) = @_;
    my( $linktext, $page83, $link);	# work strings

    # check if we know that this is a section in this page
    if (!defined $pages{$page} && defined $sections{$page}) {
	$section = $page;
	$page = "";
        ### print STDERR "reset page='', section=$section\n";
    }

    $page83=dosify($page);
    $page=$page83 if (defined $pages{$page83});
    if ($page eq "") {
	$link = "#" . htmlify( $section );
    } elsif ( $page =~ /::/ ) {
	$page =~ s,::,/,g;
	# Search page cache for an entry keyed under the html page name,
	# then look to see what directory that page might be in.  NOTE:
	# this will only find one page. A better solution might be to produce
	# an intermediate page that is an index to all such pages.
	my $page_name = $page ;
	$page_name =~ s,^.*/,,s ;
	if ( defined( $pages{ $page_name } ) && 
	     $pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/ 
	   ) {
	    $page = $1 ;
	}
	else {
	    # NOTE: This branch assumes that all A::B pages are located in
	    # $htmlroot/A/B.html . This is often incorrect, since they are
	    # often in $htmlroot/lib/A/B.html or such like. Perhaps we could
	    # analyze the contents of %pages and figure out where any
	    # cousins of A::B are, then assume that.  So, if A::B isn't found,
	    # but A::C is found in lib/A/C.pm, then A::B is assumed to be in
	    # lib/A/B.pm. This is also limited, but it's an improvement.
	    # Maybe a hints file so that the links point to the correct places
	    # nonetheless?

	}
	$link = "$htmlroot/$page.html";
	$link .= "#" . htmlify( $section ) if ($section);
    } elsif (!defined $pages{$page}) {
	$link = "";
    } else {
	$section = htmlify( $section ) if $section ne "";
        ### print STDERR "...section=$section\n";

	# if there is a directory by the name of the page, then assume that an
	# appropriate section will exist in the subdirectory
#	if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
	if ($section ne "" && $pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
	    $link = "$htmlroot/$1/$section.html";
            ### print STDERR "...link=$link\n";

	# since there is no directory by the name of the page, the section will
	# have to exist within a .html of the same name.  thus, make sure there
	# is a .pod or .pm that might become that .html
	} else {
	    $section = "#$section" if $section;
            ### print STDERR "...section=$section\n";

	    # check if there is a .pod with the page name
	    if ($pages{$page} =~ /([^:]*)\.pod:/) {
		$link = "$htmlroot/$1.html$section";
	    } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
		$link = "$htmlroot/$1.html$section";
	    } else {
		$link = "";
	    }
	}
    }

    if ($link) {
	# Here, we take advantage of the knowledge that $htmlfileurl ne ''
	# implies $htmlroot eq ''. This means that the link in question
	# needs a prefix of $htmldir if it begins with '/'. The test for
	# the initial '/' is done to avoid '#'-only links, and to allow
	# for other kinds of links, like file:, ftp:, etc.
        my $url ;
        if (  $htmlfileurl ne '' ) {
            $link = "$htmldir$link" if $link =~ m{^/}s;
            $url = relativize_url( $link, $htmlfileurl );
# print( "  b: [$link,$htmlfileurl,$url]\n" );
	}
	else {
            $url = $link ;
	}
	return $url;

    } else {
	return undef();
    }
}

#
# relativize_url - convert an absolute URL to one relative to a base URL.
# Assumes both end in a filename.
#
sub relativize_url {
    my ($dest,$source) = @_ ;

    my ($dest_volume,$dest_directory,$dest_file) = 
        File::Spec::Unix->splitpath( $dest ) ;
    $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ) ;

    my ($source_volume,$source_directory,$source_file) = 
        File::Spec::Unix->splitpath( $source ) ;
    $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ;

    my $rel_path = '' ;
    if ( $dest ne '' ) {
       $rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ;
    }

    if ( $rel_path ne ''                && 
         substr( $rel_path, -1 ) ne '/' &&
         substr( $dest_file, 0, 1 ) ne '#' 
        ) {
        $rel_path .= "/$dest_file" ;
    }
    else {
        $rel_path .= "$dest_file" ;
    }

    return $rel_path ;
}


#
# coderef - make URL from the text of a C<>
#
sub coderef($$){
    my( $page, $item ) = @_;
    my( $url );

    my $fid = fragment_id( $item );
    if( defined( $page ) ){
	# we have been given a $page...
	$page =~ s{::}{/}g;

	# Do we take it? Item could be a section!
	my $base = $items{$fid} || "";
	$base =~ s{[^/]*/}{};
	if( $base ne "$page.html" ){
            ###   print STDERR "coderef( $page, $item ): items{$fid} = $items{$fid} = $base => discard page!\n";
	    $page = undef();
	}

    } else {
        # no page - local items precede cached items
	if( defined( $fid ) ){
	    if(  exists $local_items{$fid} ){
		$page = $local_items{$fid};
	    } else {
		$page = $items{$fid};
	    }
	}
    }

    # if there was a pod file that we found earlier with an appropriate
    # =item directive, then create a link to that page.
    if( defined $page ){
	if( $page ){
            if( exists $pages{$page} and $pages{$page} =~ /([^:.]*)\.[^:]*:/){
		$page = $1 . '.html';
	    }
	    my $link = "$htmlroot/$page#item_$fid";

	    # Here, we take advantage of the knowledge that $htmlfileurl
	    # ne '' implies $htmlroot eq ''.
	    if (  $htmlfileurl ne '' ) {
		$link = "$htmldir$link" ;
		$url = relativize_url( $link, $htmlfileurl ) ;
	    } else {
		$url = $link ;
	    }
	} else {
	    $url = "#item_" . $fid;
	}

	confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
    }       
    return( $url, $fid );
}



#
# Adapted from Nick Ing-Simmons' PodToHtml package.
sub relative_url {
    my $source_file = shift ;
    my $destination_file = shift;

    my $source = URI::file->new_abs($source_file);
    my $uo = URI::file->new($destination_file,$source)->abs;
    return $uo->rel->as_string;
}


#
# finish_list - finish off any pending HTML lists.  this should be called
# after the entire pod file has been read and converted.
#
sub finish_list {
    while ($listlevel > 0) {
	print HTML "</DL>\n";
	$listlevel--;
    }
}

#
# htmlify - converts a pod section specification to a suitable section
# specification for HTML. Note that we keep spaces and special characters
# except ", ? (Netscape problem) and the hyphen (writer's problem...).
#
sub htmlify {
    my( $heading) = @_;
    $heading =~ s/(\s+)/ /g;
    $heading =~ s/\s+\Z//;
    $heading =~ s/\A\s+//;
    # The hyphen is a disgrace to the English language.
    $heading =~ s/[-"?]//g;
    $heading = lc( $heading );
    return $heading;
}

#
# depod - convert text by eliminating all interior sequences
# Note: can be called with copy or modify semantics
#
my %E2c;
$E2c{lt}     = '<';
$E2c{gt}     = '>';
$E2c{sol}    = '/';
$E2c{verbar} = '|';
$E2c{amp}    = '&'; # in Tk's pods

sub depod1($;$$);

sub depod($){
    my $string;
    if( ref( $_[0] ) ){
	$string =  ${$_[0]};
        ${$_[0]} = depod1( \$string );
    } else {
	$string =  $_[0];
        depod1( \$string );
    }    
}

sub depod1($;$$){
  my( $rstr, $func, $closing ) = @_;
  my $res = '';
  return $res unless defined $$rstr;
  if( ! defined( $func ) ){
      # skip to next begin of an interior sequence
      while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
         # recurse into its text
	  $res .= $1 . depod1( $rstr, $2, closing $3);
      }
      $res .= $$rstr;
  } elsif( $func eq 'E' ){
      # E<x> - convert to character
      $$rstr =~ s/^([^>]*)>//;
      $res .= $E2c{$1} || "";
  } elsif( $func eq 'X' ){
      # X<> - ignore
      $$rstr =~ s/^[^>]*>//;
  } elsif( $func eq 'Z' ){
      # Z<> - empty 
      $$rstr =~ s/^>//;
  } else {
      # all others: either recurse into new function or
      # terminate at closing angle bracket
      my $term = pattern $closing;
      while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
	  $res .= $1;
	  last unless $3;
          $res .= depod1( $rstr, $3, closing $4 );
      }
      ## If we're here and $2 ne '>': undelimited interior sequence.
      ## Ignored, as this is called without proper indication of where we are.
      ## Rely on process_text to produce diagnostics.
  }
  return $res;
}

#
# fragment_id - construct a fragment identifier from:
#   a) =item text
#   b) contents of C<...>
#
my @hc;
sub fragment_id {
    my $text = shift();
    $text =~ s/\s+\Z//s;
    if( $text ){
	# a method or function?
	return $1 if $text =~ /(\w+)\s*\(/;
	return $1 if $text =~ /->\s*(\w+)\s*\(?/;

	# a variable name?
	return $1 if $text =~ /^([$@%*]\S+)/;

	# some pattern matching operator?
	return $1 if $text =~ m|^(\w+/).*/\w*$|;

	# fancy stuff... like "do { }"
	return $1 if $text =~ m|^(\w+)\s*{.*}$|;

	# honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
	# and some funnies with ... Module ...
	return $1 if $text =~ m{^([a-z\d]+)(\s+[A-Z\d,/& ]+)?$};
	return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};

	# text? normalize!
	$text =~ s/\s+/_/sg;
	$text =~ s{(\W)}{
         defined( $hc[ord($1)] ) ? $hc[ord($1)]
                 : ( $hc[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
        $text = substr( $text, 0, 50 );
    } else {
	return undef();
    }
}

#
# make_URL_href - generate HTML href from URL
# Special treatment for CGI queries.
#
sub make_URL_href($){
    my( $url ) = @_;
    if( $url !~ 
        s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<A HREF="$1$2">$1</A>}i ){
        $url = "<A HREF=\"$url\">$url</A>";
    }
    return $url;
}

1;
&& length($_[0]);
    $self->print(hex(length($_[0])) . $CRLF . $_[0] . $CRLF);
}

sub format_chunk_eof {
    my $self = shift;
    my @h;
    while (@_) {
	push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2));
    }
    return join("", "0$CRLF", @h, $CRLF);
}

sub write_chunk_eof {
    my $self = shift;
    $self->print($self->format_chunk_eof(@_));
}


sub my_read {
    die if @_ > 3;
    my $self = shift;
    my $len = $_[1];
    for (${*$self}{'http_buf'}) {
	if (length) {
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################
# Pod/InputObjects.pm -- package which defines objects for input streams
# and paragraphs and commands when parsing POD docs.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::InputObjects;

use vars qw($VERSION);
$VERSION = 1.13;  ## Current version of this package
require  5.005;    ## requires this Perl version or later

#############################################################################

=head1 NAME

Pod::InputObjects - objects representing POD input paragraphs, commands, etc.

=head1 SYNOPSIS

    use Pod::InputObjects;

=head1 REQUIRES

perl5.004, Carp

=head1 EXPORTS

Nothing.

=head1 DESCRIPTION

This module defines some basic input objects used by B<Pod::Parser> when
reading and parsing POD text from an input source. The following objects
are defined:

=over 4

=begin __PRIVATE__

=item package B<Pod::InputSource>

An object corresponding to a source of POD input text. It is mostly a
wrapper around a filehandle or C<IO::Handle>-type object (or anything
that implements the C<getline()> method) which keeps track of some
additional information relevant to the parsing of PODs.

=end __PRIVATE__

=item package B<Pod::Paragraph>

An object corresponding to a paragraph of POD input text. It may be a
plain paragraph, a verbatim paragraph, or a command paragraph (see
L<perlpod>).

=item package B<Pod::InteriorSequence>

An object corresponding to an interior sequence command from the POD
input text (see L<perlpod>).

=item package B<Pod::ParseTree>

An object corresponding to a tree of parsed POD text. Each "node" in
a parse-tree (or I<ptree>) is either a text-string or a reference to
a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
in the order in which they were parsed from left-to-right.

=back

Each of these input objects are described in further detail in the
sections which follow.

=cut

#############################################################################

use strict;
#use diagnostics;
#use Carp;

#############################################################################

package Pod::InputSource;

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head1 B<Pod::InputSource>

This object corresponds to an input source or stream of POD
documentation. When parsing PODs, it is necessary to associate and store
certain context information with each input source. All of this
information is kept together with the stream itself in one of these
C<Pod::InputSource> objects. Each such object is merely a wrapper around
an C<IO::Handle> object of some kind (or at least something that
implements the C<getline()> method). They have the following
methods/attributes:

=end __PRIVATE__

=cut

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head2 B<new()>

        my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
        my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
                                              -name   => $name);
        my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
        my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
                                               -name => "(STDIN)");

This is a class method that constructs a C<Pod::InputSource> object and
returns a reference to the new input source object. It takes one or more
keyword arguments in the form of a hash. The keyword C<-handle> is
required and designates the corresponding input handle. The keyword
C<-name> is optional and specifies the name associated with the input
handle (typically a file name).

=end __PRIVATE__

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;

    ## Any remaining arguments are treated as initial values for the
    ## hash that is used to represent this object. Note that we default
    ## certain values by specifying them *before* the arguments passed.
    ## If they are in the argument list, they will override the defaults.
    my $self = { -name        => '(unknown)',
                 -handle      => undef,
                 -was_cutting => 0,
                 @_ };

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head2 B<name()>

        my $filename = $pod_input->name();
        $pod_input->name($new_filename_to_use);

This method gets/sets the name of the input source (usually a filename).
If no argument is given, it returns a string containing the name of
the input source; otherwise it sets the name of the input source to the
contents of the given argument.

=end __PRIVATE__

=cut

sub name {
   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
   return $_[0]->{'-name'};
}

## allow 'filename' as an alias for 'name'
*filename = \&name;

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head2 B<handle()>

        my $handle = $pod_input->handle();

Returns a reference to the handle object from which input is read (the
one used to contructed this input source object).

=end __PRIVATE__

=cut

sub handle {
   return $_[0]->{'-handle'};
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head2 B<was_cutting()>

        print "Yes.\n" if ($pod_input->was_cutting());

The value of the C<cutting> state (that the B<cutting()> method would
have returned) immediately before any input was read from this input
stream. After all input from this stream has been read, the C<cutting>
state is restored to this value.

=end __PRIVATE__

=cut

sub was_cutting {
   (@_ > 1)  and  $_[0]->{-was_cutting} = $_[1];
   return $_[0]->{-was_cutting};
}

##---------------------------------------------------------------------------

#############################################################################

package Pod::Paragraph;

##---------------------------------------------------------------------------

=head1 B<Pod::Paragraph>

An object representing a paragraph of POD input text.
It has the following methods/attributes:

=cut

##---------------------------------------------------------------------------

=head2 Pod::Paragraph-E<gt>B<new()>

        my $pod_para1 = Pod::Paragraph->new(-text => $text);
        my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
                                            -text => $text);
        my $pod_para3 = new Pod::Paragraph(-text => $text);
        my $pod_para4 = new Pod::Paragraph(-name => $cmd,
                                           -text => $text);
        my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
                                            -text => $text,
                                            -file => $filename,
                                            -line => $line_number);

This is a class method that constructs a C<Pod::Paragraph> object and
returns a reference to the new paragraph object. It may be given one or
two keyword arguments. The C<-text> keyword indicates the corresponding
text of the POD paragraph. The C<-name> keyword indicates the name of
the corresponding POD command, such as C<head1> or C<item> (it should
I<not> contain the C<=> prefix); this is needed only if the POD
paragraph corresponds to a command paragraph. The C<-file> and C<-line>
keywords indicate the filename and line number corresponding to the
beginning of the paragraph 

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;

    ## Any remaining arguments are treated as initial values for the
    ## hash that is used to represent this object. Note that we default
    ## certain values by specifying them *before* the arguments passed.
    ## If they are in the argument list, they will override the defaults.
    my $self = {
          -name       => undef,
          -text       => (@_ == 1) ? $_[0] : undef,
          -file       => '<unknown-file>',
          -line       => 0,
          -prefix     => '=',
          -separator  => ' ',
          -ptree => [],
          @_
    };

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<cmd_name()>

        my $para_cmd = $pod_para->cmd_name();

If this paragraph is a command paragraph, then this method will return 
the name of the command (I<without> any leading C<=> prefix).

=cut

sub cmd_name {
   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
   return $_[0]->{'-name'};
}

## let name() be an alias for cmd_name()
*name = \&cmd_name;

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<text()>

        my $para_text = $pod_para->text();

This method will return the corresponding text of the paragraph.

=cut

sub text {
   (@_ > 1)  and  $_[0]->{'-text'} = $_[1];
   return $_[0]->{'-text'};
}       

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<raw_text()>

        my $raw_pod_para = $pod_para->raw_text();

This method will return the I<raw> text of the POD paragraph, exactly
as it appeared in the input.

=cut

sub raw_text {
   return $_[0]->{'-text'}  unless (defined $_[0]->{'-name'});
   return $_[0]->{'-prefix'} . $_[0]->{'-name'} . 
          $_[0]->{'-separator'} . $_[0]->{'-text'};
}

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<cmd_prefix()>

        my $prefix = $pod_para->cmd_prefix();

If this paragraph is a command paragraph, then this method will return 
the prefix used to denote the command (which should be the string "="
or "==").

=cut

sub cmd_prefix {
   return $_[0]->{'-prefix'};
}

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<cmd_separator()>

        my $separator = $pod_para->cmd_separator();

If this paragraph is a command paragraph, then this method will return
the text used to separate the command name from the rest of the
paragraph (if any).

=cut

sub cmd_separator {
   return $_[0]->{'-separator'};
}

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<parse_tree()>

        my $ptree = $pod_parser->parse_text( $pod_para->text() );
        $pod_para->parse_tree( $ptree );
        $ptree = $pod_para->parse_tree();

This method will get/set the corresponding parse-tree of the paragraph's text.

=cut

sub parse_tree {
   (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
   return $_[0]->{'-ptree'};
}       

## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;

##---------------------------------------------------------------------------

=head2 $pod_para-E<gt>B<file_line()>

        my ($filename, $line_number) = $pod_para->file_line();
        my $position = $pod_para->file_line();

Returns the current filename and line number for the paragraph
object.  If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.

=cut

sub file_line {
   my @loc = ($_[0]->{'-file'} || '<unknown-file>',
              $_[0]->{'-line'} || 0);
   return (wantarray) ? @loc : join(':', @loc);
}

##---------------------------------------------------------------------------

#############################################################################

package Pod::InteriorSequence;

##---------------------------------------------------------------------------

=head1 B<Pod::InteriorSequence>

An object representing a POD interior sequence command.
It has the following methods/attributes:

=cut

##---------------------------------------------------------------------------

=head2 Pod::InteriorSequence-E<gt>B<new()>

        my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
                                                  -ldelim => $delimiter);
        my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
                                                 -ldelim => $delimiter);
        my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
                                                 -ldelim => $delimiter,
                                                 -file => $filename,
                                                 -line => $line_number);

        my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
        my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);

This is a class method that constructs a C<Pod::InteriorSequence> object
and returns a reference to the new interior sequence object. It should
be given two keyword arguments.  The C<-ldelim> keyword indicates the
corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
The C<-name> keyword indicates the name of the corresponding interior
sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
C<-line> keywords indicate the filename and line number corresponding
to the beginning of the interior sequence. If the C<$ptree> argument is
given, it must be the last argument, and it must be either string, or
else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
it may be a reference to an Pod::ParseTree object).

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;

    ## See if first argument has no keyword
    if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
       ## Yup - need an implicit '-name' before first parameter
       unshift @_, '-name';
    }

    ## See if odd number of args
    if ((@_ % 2) != 0) {
       ## Yup - need an implicit '-ptree' before the last parameter
       splice @_, $#_, 0, '-ptree';
    }

    ## Any remaining arguments are treated as initial values for the
    ## hash that is used to represent this object. Note that we default
    ## certain values by specifying them *before* the arguments passed.
    ## If they are in the argument list, they will override the defaults.
    my $self = {
          -name       => (@_ == 1) ? $_[0] : undef,
          -file       => '<unknown-file>',
          -line       => 0,
          -ldelim     => '<',
          -rdelim     => '>',
          @_
    };

    ## Initialize contents if they havent been already
    my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
    if ( ref $ptree =~ /^(ARRAY)?$/ ) {
        ## We have an array-ref, or a normal scalar. Pass it as an
        ## an argument to the ptree-constructor
        $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
    }
    $self->{'-ptree'} = $ptree;

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<cmd_name()>

        my $seq_cmd = $pod_seq->cmd_name();

The name of the interior sequence command.

=cut

sub cmd_name {
   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];
   return $_[0]->{'-name'};
}

## let name() be an alias for cmd_name()
*name = \&cmd_name;

##---------------------------------------------------------------------------

## Private subroutine to set the parent pointer of all the given
## children that are interior-sequences to be $self

sub _set_child2parent_links {
   my ($self, @children) = @_;
   ## Make sure any sequences know who their parent is
   for (@children) {
      next  unless (length  and  ref  and  ref ne 'SCALAR');
      if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
          UNIVERSAL::can($_, 'nested'))
      {
          $_->nested($self);
      }
   }
}

## Private subroutine to unset child->parent links

sub _unset_child2parent_links {
   my $self = shift;
   $self->{'-parent_sequence'} = undef;
   my $ptree = $self->{'-ptree'};
   for (@$ptree) {
      next  unless (length  and  ref  and  ref ne 'SCALAR');
      $_->_unset_child2parent_links()
          if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
   }
}

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<prepend()>

        $pod_seq->prepend($text);
        $pod_seq1->prepend($pod_seq2);

Prepends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.

=cut

sub prepend {
   my $self  = shift;
   $self->{'-ptree'}->prepend(@_);
   _set_child2parent_links($self, @_);
   return $self;
}       

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<append()>

        $pod_seq->append($text);
        $pod_seq1->append($pod_seq2);

Appends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.

=cut

sub append {
   my $self = shift;
   $self->{'-ptree'}->append(@_);
   _set_child2parent_links($self, @_);
   return $self;
}       

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<nested()>

        $outer_seq = $pod_seq->nested || print "not nested";

If this interior sequence is nested inside of another interior
sequence, then the outer/parent sequence that contains it is
returned. Otherwise C<undef> is returned.

=cut

sub nested {
   my $self = shift;
  (@_ == 1)  and  $self->{'-parent_sequence'} = shift;
   return  $self->{'-parent_sequence'} || undef;
}

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<raw_text()>

        my $seq_raw_text = $pod_seq->raw_text();

This method will return the I<raw> text of the POD interior sequence,
exactly as it appeared in the input.

=cut

sub raw_text {
   my $self = shift;
   my $text = $self->{'-name'} . $self->{'-ldelim'};
   for ( $self->{'-ptree'}->children ) {
      $text .= (ref $_) ? $_->raw_text : $_;
   }
   $text .= $self->{'-rdelim'};
   return $text;
}

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<left_delimiter()>

        my $ldelim = $pod_seq->left_delimiter();

The leftmost delimiter beginning the argument text to the interior
sequence (should be "<").

=cut

sub left_delimiter {
   (@_ > 1)  and  $_[0]->{'-ldelim'} = $_[1];
   return $_[0]->{'-ldelim'};
}

## let ldelim() be an alias for left_delimiter()
*ldelim = \&left_delimiter;

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<right_delimiter()>

The rightmost delimiter beginning the argument text to the interior
sequence (should be ">").

=cut

sub right_delimiter {
   (@_ > 1)  and  $_[0]->{'-rdelim'} = $_[1];
   return $_[0]->{'-rdelim'};
}

## let rdelim() be an alias for right_delimiter()
*rdelim = \&right_delimiter;

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<parse_tree()>

        my $ptree = $pod_parser->parse_text($paragraph_text);
        $pod_seq->parse_tree( $ptree );
        $ptree = $pod_seq->parse_tree();

This method will get/set the corresponding parse-tree of the interior
sequence's text.

=cut

sub parse_tree {
   (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
   return $_[0]->{'-ptree'};
}       

## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;

##---------------------------------------------------------------------------

=head2 $pod_seq-E<gt>B<file_line()>

        my ($filename, $line_number) = $pod_seq->file_line();
        my $position = $pod_seq->file_line();

Returns the current filename and line number for the interior sequence
object.  If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.

=cut

sub file_line {
   my @loc = ($_[0]->{'-file'}  || '<unknown-file>',
              $_[0]->{'-line'}  || 0);
   return (wantarray) ? @loc : join(':', @loc);
}

##---------------------------------------------------------------------------

=head2 Pod::InteriorSequence::B<DESTROY()>

This method performs any necessary cleanup for the interior-sequence.
If you override this method then it is B<imperative> that you invoke
the parent method from within your own method, otherwise
I<interior-sequence storage will not be reclaimed upon destruction!>

=cut

sub DESTROY {
   ## We need to get rid of all child->parent pointers throughout the
   ## tree so their reference counts will go to zero and they can be
   ## garbage-collected
   _unset_child2parent_links(@_);
}

##---------------------------------------------------------------------------

#############################################################################

package Pod::ParseTree;

##---------------------------------------------------------------------------

=head1 B<Pod::ParseTree>

This object corresponds to a tree of parsed POD text. As POD text is
scanned from left to right, it is parsed into an ordered list of
text-strings and B<Pod::InteriorSequence> objects (in order of
appearance). A B<Pod::ParseTree> object corresponds to this list of
strings and sequences. Each interior sequence in the parse-tree may
itself contain a parse-tree (since interior sequences may be nested).

=cut

##---------------------------------------------------------------------------

=head2 Pod::ParseTree-E<gt>B<new()>

        my $ptree1 = Pod::ParseTree->new;
        my $ptree2 = new Pod::ParseTree;
        my $ptree4 = Pod::ParseTree->new($array_ref);
        my $ptree3 = new Pod::ParseTree($array_ref);

This is a class method that constructs a C<Pod::Parse_tree> object and
returns a reference to the new parse-tree. If a single-argument is given,
it must be a reference to an array, and is used to initialize the root
(top) of the parse tree.

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;

    my $self = (@_ == 1  and  ref $_[0]) ? $_[0] : [];

    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    return $self;
}

##---------------------------------------------------------------------------

=head2 $ptree-E<gt>B<top()>

        my $top_node = $ptree->top();
        $ptree->top( $top_node );
        $ptree->top( @children );

This method gets/sets the top node of the parse-tree. If no arguments are
given, it returns the topmost node in the tree (the root), which is also
a B<Pod::ParseTree>. If it is given a single argument that is a reference,
then the reference is assumed to a parse-tree and becomes the new top node.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.

=cut

sub top {
   my $self = shift;
   if (@_ > 0) {
      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
   }
   return $self;
}

## let parse_tree() & ptree() be aliases for the 'top' method
*parse_tree = *ptree = \&top;

##---------------------------------------------------------------------------

=head2 $ptree-E<gt>B<children()>

This method gets/sets the children of the top node in the parse-tree.
If no arguments are given, it returns the list (array) of children
(each of which should be either a string or a B<Pod::InteriorSequence>.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.

=cut

sub children {
   my $self = shift;
   if (@_ > 0) {
      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;
   }
   return @{ $self };
}

##---------------------------------------------------------------------------

=head2 $ptree-E<gt>B<prepend()>

This method prepends the given text or parse-tree to the current parse-tree.
If the first item on the parse-tree is text and the argument is also text,
then the text is prepended to the first item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<before>
the current one.

=cut

use vars qw(@ptree);  ## an alias used for performance reasons

sub prepend {
   my $self = shift;
   local *ptree = $self;
   for (@_) {
      next  unless length;
      if (@ptree  and  !(ref $ptree[0])  and  !(ref $_)) {
         $ptree[0] = $_ . $ptree[0];
      }
      else {
         unshift @ptree, $_;
      }
   }
}

##---------------------------------------------------------------------------

=head2 $ptree-E<gt>B<append()>

This method appends the given text or parse-tree to the current parse-tree.
If the last item on the parse-tree is text and the argument is also text,
then the text is appended to the last item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<after>
the current one.

=cut

sub append {
   my $self = shift;
   local *ptree = $self;
   for (@_) {
      next  unless length;
      if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
         $ptree[-1] .= $_;
      }
      else {
         push @ptree, $_;
      }
   }
}

=head2 $ptree-E<gt>B<raw_text()>

        my $ptree_raw_text = $ptree->raw_text();

This method will return the I<raw> text of the POD parse-tree
exactly as it appeared in the input.

=cut

sub raw_text {
   my $self = shift;
   my $text = "";
   for ( @$self ) {
      $text .= (ref $_) ? $_->raw_text : $_;
   }
   return $text;
}

##---------------------------------------------------------------------------

## Private routines to set/unset child->parent links

sub _unset_child2parent_links {
   my $self = shift;
   local *ptree = $self;
   for (@ptree) {
       next  unless (length  and  ref  and  ref ne 'SCALAR');
       $_->_unset_child2parent_links()
           if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
   }
}

sub _set_child2parent_links {
    ## nothing to do, Pod::ParseTrees cant have parent pointers
}

=head2 Pod::ParseTree::B<DESTROY()>

This method performs any necessary cleanup for the parse-tree.
If you override this method then it is B<imperative>
that you invoke the parent method from within your own method,
otherwise I<parse-tree storage will not be reclaimed upon destruction!>

=cut

sub DESTROY {
   ## We need to get rid of all child->parent pointers throughout the
   ## tree so their reference counts will go to zero and they can be
   ## garbage-collected
   _unset_child2parent_links(@_);
}

#############################################################################

=head1 SEE ALSO

See L<Pod::Parser>, L<Pod::Select>

=head1 AUTHOR

Brad Appleton E<lt>bradapp@enteract.comE<gt>

=cut

1;
that use Net::* modules ?

Most of the libnet client classes allow options to be passed to the
constructor, in most cases one option is called C<Debug>. Passing
this option with a non-zero value will turn on a protocol trace, which
will be sent to STDERR. This trace can be useful to see what commands
are being sent to the remote server and what responses are being
received back.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Pod::LaTeX;

# Copyright (C) 2000 by Tim Jenness <t.jenness@jach.hawaii.edu>
# All Rights Reserved.

=head1 NAME

Pod::LaTeX - Convert Pod data to formatted Latex

=head1 SYNOPSIS

  use Pod::LaTeX;
  my $parser = Pod::LaTeX->new ( );

  $parser->parse_from_filehandle;

  $parser->parse_from_file ('file.pod', 'file.tex');

=head1 DESCRIPTION

C<Pod::LaTeX> is a module to convert documentation in the Pod format
into Latex. The L<B<pod2latex>|pod2latex> X<pod2latex> command uses
this module for translation.

C<Pod::LaTeX> is a derived class from L<Pod::Select|Pod::Select>.

=cut


use strict;
require Pod::ParseUtils;
use base qw/ Pod::Select /;

# use Data::Dumper; # for debugging
use Carp;

use vars qw/ $VERSION %HTML_Escapes @LatexSections /;

$VERSION = '0.53';

# Definitions of =headN -> latex mapping
@LatexSections = (qw/
		  chapter
		  section
		  subsection
		  subsubsection
		  paragraph
		  subparagraph
		  /);

# Standard escape sequences converted to Latex
# Up to "yuml" these are taken from the original pod2latex
# command written by Taro Kawagish (kawagish@imslab.co.jp)

%HTML_Escapes = (
    'amp'       =>      '&',      #   ampersand
    'lt'        =>      '$<$',    #   ' left chevron, less-than
    'gt'        =>      '$>$',    #   ' right chevron, greater-than
    'quot'      =>      '"',      #   double quote
    'sol'       =>      '/',
    'verbar'    =>      '$|$',

    "Aacute"    =>      "\\'{A}",       #   capital A, acute accent
    "aacute"    =>      "\\'{a}",       #   small a, acute accent
    "Acirc"     =>      "\\^{A}",       #   capital A, circumflex accent
    "acirc"     =>      "\\^{a}",       #   small a, circumflex accent
    "AElig"     =>      '\\AE',         #   capital AE diphthong (ligature)
    "aelig"     =>      '\\ae',         #   small ae diphthong (ligature)
    "Agrave"    =>      "\\`{A}",       #   capital A, grave accent
    "agrave"    =>      "\\`{a}",       #   small a, grave accent
    "Aring"     =>      '\\u{A}',       #   capital A, ring
    "aring"     =>      '\\u{a}',       #   small a, ring
    "Atilde"    =>      '\\~{A}',       #   capital A, tilde
    "atilde"    =>      '\\~{a}',       #   small a, tilde
    "Auml"      =>      '\\"{A}',       #   capital A, dieresis or umlaut mark
    "auml"      =>      '\\"{a}',       #   small a, dieresis or umlaut mark
    "Ccedil"    =>      '\\c{C}',       #   capital C, cedilla
    "ccedil"    =>      '\\c{c}',       #   small c, cedilla
    "Eacute"    =>      "\\'{E}",       #   capital E, acute accent
    "eacute"    =>      "\\'{e}",       #   small e, acute accent
    "Ecirc"     =>      "\\^{E}",       #   capital E, circumflex accent
    "ecirc"     =>      "\\^{e}",       #   small e, circumflex accent
    "Egrave"    =>      "\\`{E}",       #   capital E, grave accent
    "egrave"    =>      "\\`{e}",       #   small e, grave accent
    "ETH"       =>      '\\OE',         #   capital Eth, Icelandic
    "eth"       =>      '\\oe',         #   small eth, Icelandic
    "Euml"      =>      '\\"{E}',       #   capital E, dieresis or umlaut mark
    "euml"      =>      '\\"{e}',       #   small e, dieresis or umlaut mark
    "Iacute"    =>      "\\'{I}",       #   capital I, acute accent
    "iacute"    =>      "\\'{i}",       #   small i, acute accent
    "Icirc"     =>      "\\^{I}",       #   capital I, circumflex accent
    "icirc"     =>      "\\^{i}",       #   small i, circumflex accent
    "Igrave"    =>      "\\`{I}",       #   capital I, grave accent
    "igrave"    =>      "\\`{i}",       #   small i, grave accent
    "Iuml"      =>      '\\"{I}',       #   capital I, dieresis or umlaut mark
    "iuml"      =>      '\\"{i}',       #   small i, dieresis or umlaut mark
    "Ntilde"    =>      '\\~{N}',       #   capital N, tilde
    "ntilde"    =>      '\\~{n}',       #   small n, tilde
    "Oacute"    =>      "\\'{O}",       #   capital O, acute accent
    "oacute"    =>      "\\'{o}",       #   small o, acute accent
    "Ocirc"     =>      "\\^{O}",       #   capital O, circumflex accent
    "ocirc"     =>      "\\^{o}",       #   small o, circumflex accent
    "Ograve"    =>      "\\`{O}",       #   capital O, grave accent
    "ograve"    =>      "\\`{o}",       #   small o, grave accent
    "Oslash"    =>      "\\O",          #   capital O, slash
    "oslash"    =>      "\\o",          #   small o, slash
    "Otilde"    =>      "\\~{O}",       #   capital O, tilde
    "otilde"    =>      "\\~{o}",       #   small o, tilde
    "Ouml"      =>      '\\"{O}',       #   capital O, dieresis or umlaut mark
    "ouml"      =>      '\\"{o}',       #   small o, dieresis or umlaut mark
    "szlig"     =>      '\\ss{}',       #   small sharp s, German (sz ligature)
    "THORN"     =>      '\\L',          #   capital THORN, Icelandic
    "thorn"     =>      '\\l',,         #   small thorn, Icelandic
    "Uacute"    =>      "\\'{U}",       #   capital U, acute accent
    "uacute"    =>      "\\'{u}",       #   small u, acute accent
    "Ucirc"     =>      "\\^{U}",       #   capital U, circumflex accent
    "ucirc"     =>      "\\^{u}",       #   small u, circumflex accent
    "Ugrave"    =>      "\\`{U}",       #   capital U, grave accent
    "ugrave"    =>      "\\`{u}",       #   small u, grave accent
    "Uuml"      =>      '\\"{U}',       #   capital U, dieresis or umlaut mark
    "uuml"      =>      '\\"{u}',       #   small u, dieresis or umlaut mark
    "Yacute"    =>      "\\'{Y}",       #   capital Y, acute accent
    "yacute"    =>      "\\'{y}",       #   small y, acute accent
    "yuml"      =>      '\\"{y}',       #   small y, dieresis or umlaut mark

    # Added by TimJ

    "iexcl"  =>   '!`',           # inverted exclamation mark
#    "cent"   =>   ' ',        # cent sign
    "pound"  =>   '\pounds',      # (UK) pound sign
#    "curren" =>   ' ',        # currency sign
#    "yen"    =>   ' ',        # yen sign
#    "brvbar" =>   ' ',        # broken vertical bar
    "sect"   =>   '\S',           # section sign
    "uml"    =>   '\"{}',        # diaresis
    "copy"   =>   '\copyright',   # Copyright symbol
#    "ordf"   =>   ' ',        # feminine ordinal indicator
    "laquo"  =>   '$\ll$',      # ' # left pointing double angle quotation mark
    "not"    =>   '$\neg$',       # '  # not sign
    "shy"    =>   '-',            # soft hyphen
#    "reg"    =>   ' ',        # registered trademark
    "macr"   =>   '$^-$',         # ' # macron, overline
    "deg"    =>   '$^\circ$',     # '  # degree sign
    "plusmn" =>   '$\pm$',        # ' # plus-minus sign
    "sup2"   =>   '$^2$',         # ' # superscript 2
    "sup3"   =>   '$^3$',         # ' # superscript 3
    "acute"  =>   "\\'{}",        # acute accent
    "micro"  =>   '$\mu$',        # micro sign
    "para"   =>   '\P',           # pilcrow sign = paragraph sign
    "middot" =>   '$\cdot$',      # middle dot = Georgian comma
    "cedil"  =>   '\c{}',        # cedilla
    "sup1"   =>   '$^1$',         # ' # superscript 1
#    "ordm"   =>   ' ',        # masculine ordinal indicator
    "raquo"  =>   '$\gg$',     # ' # right pointing double angle quotation mark
    "frac14" =>   '$\frac{1}{4}$',   # ' # vulgar fraction one quarter
    "frac12" =>   '$\frac{1}{2}$',   # ' # vulgar fraction one half
    "frac34" =>   '$\frac{3}{4}$',   # ' # vulgar fraction three quarters
    "iquest" =>   "?'",              # inverted question mark
    "times"  =>   '$\times$',        # ' # multiplication sign
    "divide" =>   '$\div$',          # division sign

    # Greek letters using HTML codes
    "alpha"  =>   '$\alpha$',   # '
    "beta"   =>   '$\beta$',    # '
    "gamma"  =>   '$\gamma$',   # '
    "delta"  =>   '$\delta$',   # '
    "epsilon"=>   '$\epsilon$', # '
    "zeta"   =>   '$\zeta$',    # '
    "eta"    =>   '$\eta$',     # '
    "theta"  =>   '$\theta$',   # '
    "iota"   =>   '$\iota$',    # '
    "kappa"  =>   '$\kappa$',   # '
    "lambda" =>   '$\lambda$',  # '
    "mu"     =>   '$\mu$',      # '
    "nu"     =>   '$\nu$',      # '
    "xi"     =>   '$\xi$',      # '
    "omicron"=>   '$o$',        # '
    "pi"     =>   '$\pi$',      # '
    "rho"    =>   '$\rho$',     # '
    "sigma"  =>   '$\sigma$',   # '
    "tau"    =>   '$\tau$',     # '
    "upsilon"=>   '$\upsilon$', # '
    "phi"    =>   '$\phi$',     # '
    "chi"    =>   '$\chi$',     # '
    "psi"    =>   '$\psi$',     # '
    "omega"  =>   '$\omega$',   # '

    "Alpha"  =>   '$A$',   # '
    "Beta"   =>   '$B$',    # '
    "Gamma"  =>   '$\Gamma$',   # '
    "Delta"  =>   '$\Delta$',   # '
    "Epsilon"=>   '$E$', # '
    "Zeta"   =>   '$Z$',    # '
    "Eta"    =>   '$H$',     # '
    "Theta"  =>   '$\Theta$',   # '
    "Iota"   =>   '$I$',    # '
    "Kappa"  =>   '$K$',   # '
    "Lambda" =>   '$\Lambda$',  # '
    "Mu"     =>   '$M$',      # '
    "Nu"     =>   '$N$',      # '
    "Xi"     =>   '$\Xi$',      # '
    "Omicron"=>   '$O$',        # '
    "Pi"     =>   '$\Pi$',      # '
    "Rho"    =>   '$R$',     # '
    "Sigma"  =>   '$\Sigma$',   # '
    "Tau"    =>   '$T$',     # '
    "Upsilon"=>   '$\Upsilon$', # '
    "Phi"    =>   '$\Phi$',     # '
    "Chi"    =>   '$X$',     # '
    "Psi"    =>   '$\Psi$',     # '
    "Omega"  =>   '$\Omega$',   # '


);


=head1 OBJECT METHODS

The following methods are provided in this module. Methods inherited
from C<Pod::Select> are not described in the public interface.

=over 4

=begin __PRIVATE__

=item C<initialize>

Initialise the object. This method is subclassed from C<Pod::Parser>.
The base class method is invoked. This method defines the default
behaviour of the object unless overridden by supplying arguments to
the constructor. 

Internal settings are defaulted as well as the public instance data.
Internal hash values are accessed directly (rather than through
a method) and start with an underscore.

This method should not be invoked by the user directly.

=end __PRIVATE__

=cut



#   - An array for nested lists

# Arguments have already been read by this point

sub initialize {
  my $self = shift;

  # print Dumper($self);

  # Internals
  $self->{_Lists} = [];             # For nested lists
  $self->{_suppress_all_para}  = 0; # For =begin blocks
  $self->{_suppress_next_para} = 0; # For =for blocks
  $self->{_dont_modify_any_para}=0; # For =begin blocks
  $self->{_dont_modify_next_para}=0; # For =for blocks
  $self->{_CURRENT_HEAD1}   = '';   # Name of current HEAD1 section

  # Options - only initialise if not already set

  # Cause the '=head1 NAME' field to be treated specially
  # The contents of the NAME paragraph will be converted
  # to a section title. All subsequent =head1 will be converted
  # to =head2 and down. Will not affect =head1's prior to NAME 
  # Assumes:  'Module - purpose' format
  # Also creates a purpose field
  # The name is used for Labeling of the subsequent subsections
  $self->{ReplaceNAMEwithSection} = 0
    unless exists $self->{ReplaceNAMEwithSection};
  $self->{AddPreamble}      = 1    # make full latex document
    unless exists $self->{AddPreamble};
  $self->{StartWithNewPage} = 0    # Start new page for pod section
    unless exists $self->{StartWithNewPage};
  $self->{TableOfContents}  = 0    # Add table of contents
    unless exists $self->{TableOfContents};  # only relevent if AddPreamble=1
   $self->{AddPostamble}     = 1          # Add closing latex code at end
    unless exists $self->{AddPostamble}; #  effectively end{document} and index
  $self->{MakeIndex}        = 1         # Add index (only relevant AddPostamble
    unless exists $self->{MakeIndex};   # and AddPreamble)

  $self->{UniqueLabels}     = 1          # Use label unique for each pod
    unless exists $self->{UniqueLabels}; # either based on the filename
                                         # or supplied

  # Control the level of =head1. default is \section
  # 
  $self->{Head1Level}     = 1   # Offset in latex sections
    unless exists $self->{Head1Level}; # 0 is chapter, 2 is subsection

  # Control at which level numbering of sections is turned off
  # ie subsection becomes subsection*
  # The numbering is relative to the latex sectioning commands
  # and is independent of Pod heading level
  # default is to number \section but not \subsection
  $self->{LevelNoNum} = 2
    unless exists $self->{LevelNoNum};

  # Label to be used as prefix to all internal section names
  # If not defined will attempt to derive it from the filename
  # This can not happen when running parse_from_filehandle though
  # hence the ability to set the label externally
  # The label could then be Pod::Parser_DESCRIPTION or somesuch

  $self->{Label}            = undef # label to be used as prefix
    unless exists $self->{Label};   # to all internal section names

  # These allow the caller to add arbritrary latex code to
  # start and end of document. AddPreamble and AddPostamble are ignored
  # if these are set.
  # Also MakeIndex and TableOfContents are also ignored.
  $self->{UserPreamble}     = undef # User supplied start (AddPreamble =1)
    unless exists $self->{Label};
  $self->{UserPostamble}    = undef # Use supplied end    (AddPostamble=1)
    unless exists $self->{Label};

  # Run base initialize
  $self->SUPER::initialize;

}

=back

=head2 Data Accessors

The following methods are provided for accessing instance data. These
methods should be used for accessing configuration parameters rather
than assuming the object is a hash.

Default values can be supplied by using these names as keys to a hash
of arguments when using the C<new()> constructor.

=over 4

=item B<AddPreamble>

Logical to control whether a C<latex> preamble is to be written.
If true, a valid C<latex> preamble is written before the pod data is written.
This is similar to:

  \documentclass{article}
  \begin{document}

but will be more complicated if table of contents and indexing are required.
Can be used to set or retrieve the current value.

  $add = $parser->AddPreamble();
  $parser->AddPreamble(1);

If used in conjunction with C<AddPostamble> a full latex document will
be written that could be immediately processed by C<latex>.

=cut

sub AddPreamble {
   my $self = shift;
   if (@_) {
     $self->{AddPreamble} = shift;
   }
   return $self->{AddPreamble};
}

=item B<AddPostamble>

Logical to control whether a standard C<latex> ending is written to the output
file after the document has been processed.
In its simplest form this is simply:

  \end{document}

but can be more complicated if a index is required.
Can be used to set or retrieve the current value.

  $add = $parser->AddPostamble();
  $parser->AddPostamble(1);

If used in conjunction with C<AddPreaamble> a full latex document will
be written that could be immediately processed by C<latex>.

=cut

sub AddPostamble {
   my $self = shift;
   if (@_) {
     $self->{AddPostamble} = shift;
   }
   return $self->{AddPostamble};
}

=item B<Head1Level>

The C<latex> sectioning level that should be used to correspond to
a pod C<=head1> directive. This can be used, for example, to turn
a C<=head1> into a C<latex> C<subsection>. This should hold a number
corresponding to the required position in an array containing the
following elements:

 [0] chapter
 [1] section
 [2] subsection
 [3] subsubsection
 [4] paragraph
 [5] subparagraph

Can be used to set or retrieve the current value:

  $parser->Head1Level(2);
  $sect = $parser->Head1Level;

Setting this number too high can result in sections that may not be reproducible
in the expected way. For example, setting this to 4 would imply that C<=head3>
do not have a corresponding C<latex> section (C<=head1> would correspond to
a C<paragraph>).

A check is made to ensure that the supplied value is an integer in the
range 0 to 5.

Default is for a value of 1 (i.e. a C<section>).

=cut

sub Head1Level {
   my $self = shift;
   if (@_) {
     my $arg = shift;
     if ($arg =~ /^\d$/ && $arg <= $#LatexSections) {
       $self->{Head1Level} = $arg;
     } else {
       carp "Head1Level supplied ($arg) must be integer in range 0 to ".$#LatexSections . "- Ignoring\n";
     }
   }
   return $self->{Head1Level};
}

=item B<Label>

This is the label that is prefixed to all C<latex> label and index
entries to make them unique. In general, pods have similarly titled
sections (NAME, DESCRIPTION etc) and a C<latex> label will be multiply
defined if more than one pod document is to be included in a single
C<latex> file. To overcome this, this label is prefixed to a label
whenever a label is required (joined with an underscore) or to an
index entry (joined by an exclamation mark which is the normal index
separator). For example, C<\label{text}> becomes C<\label{Label_text}>.

Can be used to set or retrieve the current value:

  $label = $parser->Label;
  $parser->Label($label);

This label is only used if C<UniqueLabels> is true.
Its value is set automatically from the C<NAME> field
if C<ReplaceNAMEwithSection> is true. If this is not the case
it must be set manually before starting the parse.

Default value is C<undef>.

=cut

sub Label {
   my $self = shift;
   if (@_) {
     $self->{Label} = shift;
   }
   return $self->{Label};
}

=item B<LevelNoNum>

Control the point at which C<latex> section numbering is turned off.
For example, this can be used to make sure that C<latex> sections
are numbered but subsections are not.

Can be used to set or retrieve the current value:

  $lev = $parser->LevelNoNum;
  $parser->LevelNoNum(2);

The argument must be an integer between 0 and 5 and is the same as the
number described in C<Head1Level> method description. The number has
nothing to do with the pod heading number, only the C<latex> sectioning.

Default is 2. (i.e. C<latex> subsections are written as C<subsection*>
but sections are numbered).

=cut

sub LevelNoNum {
   my $self = shift;
   if (@_) {
     $self->{LevelNoNum} = shift;
   }
   return $self->{LevelNoNum};
}

=item B<MakeIndex>

Controls whether C<latex> commands for creating an index are to be inserted
into the preamble and postamble

  $makeindex = $parser->MakeIndex;
  $parser->MakeIndex(0);

Irrelevant if both C<AddPreamble> and C<AddPostamble> are false (or equivalently,
C<UserPreamble> and C<UserPostamble> are set).

Default is for an index to be created.

=cut

sub MakeIndex {
   my $self = shift;
   if (@_) {
     $self->{MakeIndex} = shift;
   }
   return $self->{MakeIndex};
}

=item B<ReplaceNAMEwithSection>

This controls whether the C<NAME> section in the pod is to be translated
literally or converted to a slightly modified output where the section
name is the pod name rather than "NAME".

If true, the pod segment

  =head1 NAME

  pod::name - purpose

  =head1 SYNOPSIS

is converted to the C<latex>

  \section{pod::name\label{pod_name}\index{pod::name}}

  Purpose

  \subsection*{SYNOPSIS\label{pod_name_SYNOPSIS}%
               \index{pod::name!SYNOPSIS}}

(dependent on the value of C<Head1Level> and C<LevelNoNum>). Note that
subsequent C<head1> directives translate to subsections rather than
sections and that the labels and index now include the pod name (dependent
on the value of C<UniqueLabels>).

The C<Label> is set from the pod name regardless of any current value
of C<Label>.

  $mod = $parser->ReplaceNAMEwithSection;
  $parser->ReplaceNAMEwithSection(0);

Default is to translate the pod literally.

=cut

sub ReplaceNAMEwithSection {
   my $self = shift;
   if (@_) {
     $self->{ReplaceNAMEwithSection} = shift;
   }
   return $self->{ReplaceNAMEwithSection};
}

=item B<StartWithNewPage>

If true, each pod translation will begin with a C<latex>
C<\clearpage>.

  $parser->StartWithNewPage(1);
  $newpage = $parser->StartWithNewPage;

Default is false.

=cut

sub StartWithNewPage {
   my $self = shift;
   if (@_) {
     $self->{StartWithNewPage} = shift;
   }
   return $self->{StartWithNewPage};
}

=item B<TableOfContents>

If true, a table of contents will be created.
Irrelevant if C<AddPreamble> is false or C<UserPreamble>
is set.

  $toc = $parser->TableOfContents;
  $parser->TableOfContents(1);

Default is false.

=cut

sub TableOfContents {
   my $self = shift;
   if (@_) {
     $self->{TableOfContents} = shift;
   }
   return $self->{TableOfContents};
}

=item B<UniqueLabels>

If true, the translator will attempt to make sure that
each C<latex> label or index entry will be uniquely identified
by prefixing the contents of C<Label>. This allows
multiple documents to be combined without clashing 
common labels such as C<DESCRIPTION> and C<SYNOPSIS>

  $parser->UniqueLabels(1);
  $unq = $parser->UniqueLabels;

Default is true.

=cut

sub UniqueLabels {
   my $self = shift;
   if (@_) {
     $self->{UniqueLabels} = shift;
   }
   return $self->{UniqueLabels};
}

=item B<UserPreamble>

User supplied C<latex> preamble. Added before the pod translation
data. 

If set, the contents will be prepended to the output file before the translated 
data regardless of the value of C<AddPreamble>.
C<MakeIndex> and C<TableOfContents> will also be ignored.

=cut

sub UserPreamble {
   my $self = shift;
   if (@_) {
     $self->{UserPreamble} = shift;
   }
   return $self->{UserPreamble};
}

=item B<UserPostamble>

User supplied C<latex> postamble. Added after the pod translation
data. 

If set, the contents will be prepended to the output file after the translated 
data regardless of the value of C<AddPostamble>.
C<MakeIndex> will also be ignored.

=cut

sub UserPostamble {
   my $self = shift;
   if (@_) {
     $self->{UserPostamble} = shift;
   }
   return $self->{UserPostamble};
}

=begin __PRIVATE__

=item B<Lists>

Contains details of the currently active lists.
  The array contains C<Pod::List> objects. A new C<Pod::List>
object is created each time a list is encountered and it is
pushed onto this stack. When the list context ends, it 
is popped from the stack. The array will be empty if no
lists are active.

Returns array of list information in list context
Returns array ref in scalar context

=cut



sub lists {
  my $self = shift;
  return @{ $self->{_Lists} } if wantarray();
  return $self->{_Lists};
}

=end __PRIVATE__

=back

=begin __PRIVATE__

=head2 Subclassed methods

The following methods override methods provided in the C<Pod::Select>
base class. See C<Pod::Parser> and C<Pod::Select> for more information
on what these methods require.

=over 4

=cut

######### END ACCESSORS ###################

# Opening pod

=item B<begin_pod>

Writes the C<latex> preamble if requested.

=cut

sub begin_pod {
  my $self = shift;

  # Get the pod identification
  # This should really come from the '=head1 NAME' paragraph

  my $infile = $self->input_file;
  my $class = ref($self);
  my $date = gmtime(time);

  # Comment message to say where this came from
  my $comment = << "__TEX_COMMENT__";
%%  Latex generated from POD in document $infile
%%  Using the perl module $class
%%  Converted on $date
__TEX_COMMENT__

  # Write the preamble
  # If the caller has supplied one then we just use that

  my $preamble = '';
  if (defined $self->UserPreamble) {

    $preamble = $self->UserPreamble;

    # Add the description of where this came from
    $preamble .=  "\n$comment";
    

  } elsif ($self->AddPreamble) {
    # Write our own preamble

    # Code to initialise index making
    # Use an array so that we can prepend comment if required
    my @makeidx = (
		   '\usepackage{makeidx}',
		   '\makeindex',
		  );

    unless ($self->MakeIndex) {
      foreach (@makeidx) {
	$_ = '%% ' . $_;
      }
    }
    my $makeindex = join("\n",@makeidx) . "\n";


    # Table of contents
    my $tableofcontents = '\tableofcontents';
    
    $tableofcontents = '%% ' . $tableofcontents
      unless $self->TableOfContents;

    # Roll our own
    $preamble = << "__TEX_HEADER__";
\\documentclass{article}

$comment

$makeindex

\\begin{document}

$tableofcontents

__TEX_HEADER__

  }

  # Write the header (blank if none)
  $self->_output($preamble);

  # Start on new page if requested
  $self->_output("\\clearpage\n") if $self->StartWithNewPage;

}


=item B<end_pod>

Write the closing C<latex> code.

=cut

sub end_pod {
  my $self = shift;

  # End string
  my $end = '';

  # Use the user version of the postamble if deinfed
  if (defined $self->UserPostamble) {
    $end = $self->UserPostamble;

    $self->_output($end);

  } elsif ($self->AddPostamble) {

    # Check for index
    my $makeindex = '\printindex';

    $makeindex = '%% '. $makeindex  unless $self->MakeIndex;

    $end = "$makeindex\n\n\\end{document}\n";
  }


  $self->_output($end);

}

=item B<command>

Process basic pod commands.

=cut

sub command {
  my $self = shift;
  my ($command, $paragraph, $line_num, $parobj) = @_;

  # return if we dont care
  return if $command eq 'pod';

  $paragraph = $self->_replace_special_chars($paragraph);

  # Interpolate pod sequences in paragraph
  $paragraph = $self->interpolate($paragraph, $line_num);

  $paragraph =~ s/\s+$//;

  # Now run the command
  if ($command eq 'over') {

    $self->begin_list($paragraph, $line_num);

  } elsif ($command eq 'item') {

    $self->add_item($paragraph, $line_num);

  } elsif ($command eq 'back') {

    $self->end_list($line_num);

  } elsif ($command eq 'head1') {

    # Store the name of the section
    $self->{_CURRENT_HEAD1} = $paragraph;

    # Print it
    $self->head(1, $paragraph, $parobj);

  } elsif ($command eq 'head2') {

    $self->head(2, $paragraph, $parobj);

  } elsif ($command eq 'head3') {

    $self->head(3, $paragraph, $parobj);

  } elsif ($command eq 'head4') {

    $self->head(4, $paragraph, $parobj);

  } elsif ($command eq 'head5') {

    $self->head(5, $paragraph, $parobj);

  } elsif ($command eq 'head6') {

    $self->head(6, $paragraph, $parobj);

  } elsif ($command eq 'begin') {

    # pass through if latex
    if ($paragraph =~ /^latex/i) {
      # Make sure that subsequent paragraphs are not modfied before printing
      $self->{_dont_modify_any_para} = 1;

    } else {
      # Suppress all subsequent paragraphs unless 
      # it is explcitly intended for latex
      $self->{_suppress_all_para} = 1;
    }

  } elsif ($command eq 'for') {

    # pass through if latex
    if ($paragraph =~ /^latex/i) {
      # Make sure that next paragraph is not modfied before printing
      $self->{_dont_modify_next_para} = 1;

    } else {
      # Suppress the next paragraph unless it is latex
      $self->{_suppress_next_para} = 1
    }

  } elsif ($command eq 'end') {

    # Reset suppression
    $self->{_suppress_all_para} = 0;
    $self->{_dont_modify_any_para} = 0;

  } elsif ($command eq 'pod') {

    # Do nothing

  } else {
    carp "Command $command not recognised at line $line_num\n";
  }

}

=item B<verbatim>

Verbatim text

=cut

sub verbatim {
  my $self = shift;
  my ($paragraph, $line_num, $parobj) = @_;

  # Expand paragraph unless in =for or =begin block
  if ($self->{_dont_modify_any_para} || $self->{_dont_modify_next_para}) {
    # Just print as is
    $self->_output($paragraph);

    # Reset flag if in =for
    $self->{_dont_modify_next_para} = 0;

  } else {

    return if $paragraph =~ /^\s+$/;

    # Clean trailing space
    $paragraph =~ s/\s+$//;

    # Clean tabs
    $paragraph =~ s/\t/        /g;

    $self->_output('\begin{verbatim}' . "\n$paragraph\n". '\end{verbatim}'."\n");
  }
}

=item B<textblock>

Plain text paragraph.

=cut

sub textblock {
  my $self = shift;
  my ($paragraph, $line_num, $parobj) = @_;

  # print Dumper($self);
  
  # Expand paragraph unless in =for or =begin block
  if ($self->{_dont_modify_any_para} || $self->{_dont_modify_next_para}) {
    # Just print as is
    $self->_output($paragraph);

    # Reset flag if in =for
    $self->{_dont_modify_next_para} = 0;

    return;
  } 

  
  # Escape latex special characters
  $paragraph = $self->_replace_special_chars($paragraph);

  # Interpolate interior sequences
  my $expansion = $self->interpolate($paragraph, $line_num);
  $expansion =~ s/\s+$//;


  # If we are replacing 'head1 NAME' with a section
  # we need to look in the paragraph and rewrite things
  # Need to make sure this is called only on the first paragraph
  # following 'head1 NAME' and not on subsequent paragraphs that may be
  # present.
  if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection()) {

    # Strip white space from start and end
    $paragraph =~ s/^\s+//;
    $paragraph =~ s/\s$//;

    # Split the string into 2 parts
    my ($name, $purpose) = split(/\s+-\s+/, $expansion,2);

    # Now prevent this from triggering until a new head1 NAME is set
    $self->{_CURRENT_HEAD1} = '_NAME';

    # Might want to clear the Label() before doing this (CHECK)

    # Print the heading
    $self->head(1, $name, $parobj);

    # Set the labeling in case we want unique names later
    $self->Label( $self->_create_label( $name, 1 ) );

    # Raise the Head1Level by one so that subsequent =head1 appear
    # as subsections of the main name section unless we are already
    # at maximum [Head1Level() could check this itself - CHECK]
    $self->Head1Level( $self->Head1Level() + 1)
      unless $self->Head1Level == $#LatexSections;

    # Now write out the new latex paragraph
    $purpose = ucfirst($purpose);
    $self->_output("\n\n$purpose\n\n");

  } else {
    # Just write the output
    $self->_output("\n\n$expansion\n\n");
  }

}

=item B<interior_sequence>

Interior sequence expansion

=cut

sub interior_sequence {
  my $self = shift;

  my ($seq_command, $seq_argument, $pod_seq) = @_;

  if ($seq_command eq 'B') {
    return "\\textbf{$seq_argument}";

  } elsif ($seq_command eq 'I') {
    return "\\textit{$seq_argument}";

  } elsif ($seq_command eq 'E') {

    # If it is simply a number
    if ($seq_argument =~ /^\d+$/) {
      return chr($seq_argument);
    # Look up escape in hash table
    } elsif (exists $HTML_Escapes{$seq_argument}) {
      return $HTML_Escapes{$seq_argument};

    } else {
      my ($file, $line) = $pod_seq->file_line();
      warn "Escape sequence $seq_argument not recognised at line $line of file $file\n";
      return;
    }

  } elsif ($seq_command eq 'Z') {

    # Zero width space
    return '$\!$'; # '

  } elsif ($seq_command eq 'C') {
    return "\\texttt{$seq_argument}";

  } elsif ($seq_command eq 'F') {
    return "\\emph{$seq_argument}";

  } elsif ($seq_command eq 'S') {
    # non breakable spaces
    my $nbsp = '$\:$'; #'

    $seq_argument =~ s/\s/$nbsp/g;
    return $seq_argument;

  } elsif ($seq_command eq 'L') {

    my $link = new Pod::Hyperlink($seq_argument);

    # undef on failure
    unless (defined $link) {
      carp $@;
      return;
    }

    # Handle internal links differently
    my $type = $link->type;
    my $page = $link->page;

    if ($type eq 'section' && $page eq '') {
      # Use internal latex reference 
      my $node = $link->node;

      # Convert to a label
      $node = $self->_create_label($node);

      return "\\S\\ref{$node}";

    } else {
      # Use default markup for external references
      # (although Starlink would use \xlabel)
      my $markup = $link->markup;

      my ($file, $line) = $pod_seq->file_line();

      return $self->interpolate($link->markup, $line);
    }



  } elsif ($seq_command eq 'P') {
    # Special markup for Pod::Hyperlink
    # Replace :: with /
    my $link = $seq_argument;
    $link =~ s/::/\//g;

    my $ref = "\\emph{$seq_argument}";
    return $ref;

  } elsif ($seq_command eq 'Q') {
    # Special markup for Pod::Hyperlink
    return "\\textsf{$seq_argument}\n";

  } elsif ($seq_command eq 'X') {
    # Index entries

    # use \index command
    # I will let '!' go through for now
    # not sure how sub categories are handled in X<>
    my $index = $self->_create_index($seq_argument);
    return "\\index{$index}\n";

  } else {
    carp "Unknown sequence $seq_command<$seq_argument>";
  }

}

=back

=head2 List Methods

Methods used to handle lists.

=over 4

=item B<begin_list>

Called when a new list is found (via the C<over> directive).
Creates a new C<Pod::List> object and stores it on the 
list stack.

  $parser->begin_list($indent, $line_num);

=cut

sub begin_list {
  my $self = shift;
  my $indent = shift;
  my $line_num = shift;

  # Indicate that a list should be started for the next item
  # need to do this to work out the type of list
  push ( @{$self->lists}, new Pod::List(-indent => $indent, 
					-start => $line_num,
					-file => $self->input_file,
				       )	 
       );

}

=item B<end_list>

Called when the end of a list is found (the C<back> directive).
Pops the C<Pod::List> object off the stack of lists and writes
the C<latex> code required to close a list.

  $parser->end_list($line_num);

=cut

sub end_list {
  my $self = shift;
  my $line_num = shift;

  unless (defined $self->lists->[-1]) {
    my $file = $self->input_file;
    warn "No list is active at line $line_num (file=$file). Missing =over?\n";
    return;
  }

  # What to write depends on list type
  my $type = $self->lists->[-1]->type;

  # Dont write anything if the list type is not set
  # iomplying that a list was created but no entries were
  # placed in it (eg because of a =begin/=end combination)
  $self->_output("\\end{$type}\n")
    if (defined $type && length($type) > 0);
  
  # Clear list
  pop(@{ $self->lists});

}

=item B<add_item>

Add items to the list. The first time an item is encountered 
(determined from the state of the current C<Pod::List> object)
the type of list is determined (ordered, unnumbered or description)
and the relevant latex code issued.

  $parser->add_item($paragraph, $line_num);

=cut

sub add_item {
  my $self = shift;
  my $paragraph = shift;
  my $line_num = shift;

  unless (defined $self->lists->[-1]) {
    my $file = $self->input_file;
    warn "List has already ended by line $line_num of file $file. Missing =over?\n";
    # Replace special chars
#    $paragraph = $self->_replace_special_chars($paragraph);
    $self->_output("$paragraph\n\n");
    return;
  }

  # If paragraphs printing is turned off via =begin/=end or whatver
  # simply return immediately
  return if ($self->{_suppress_all_para} || $self->{_suppress_next_para});

  # Check to see whether we are starting a new lists
  if (scalar($self->lists->[-1]->item) == 0) {

    # Examine the paragraph to determine what type of list
    # we have
    $paragraph =~ s/\s+$//;
    $paragraph =~ s/^\s+//;

    my $type;
    if (substr($paragraph, 0,1) eq '*') {
      $type = 'itemize';
    } elsif ($paragraph =~ /^\d/) {
      $type = 'enumerate';
    } else {
      $type = 'description';
    }
    $self->lists->[-1]->type($type);

    $self->_output("\\begin{$type}\n");

  }

  my $type = $self->lists->[-1]->type;

  if ($type eq 'description') {
    # Handle long items - long items do not wrap
    if (length($paragraph) < 40) {
      # A real description list item
      $self->_output("\\item[$paragraph] \\mbox{}");
    } else {
      # The item is now simply bold text
      $self->_output(qq{\\item \\textbf{$paragraph}});
    }

  } else {
    # If the item was '* Something' we still need to write
    # out the something
    my $extra_info = $paragraph;
    $extra_info =~ s/^\*\s*//;
    $self->_output("\\item $extra_info");
  }

  # Store the item name in the object. Required so that 
  # we can tell if the list is new or not
  $self->lists->[-1]->item($paragraph);

}

=back

=head2 Methods for headings

=over 4

=item B<head>

Print a heading of the required level.

  $parser->head($level, $paragraph, $parobj);

The first argument is the pod heading level. The second argument
is the contents of the heading. The 3rd argument is a Pod::Paragraph
object so that the line number can be extracted.

=cut

sub head {
  my $self = shift;
  my $num = shift;
  my $paragraph = shift;
  my $parobj = shift;

  # If we are replace 'head1 NAME' with a section
  # we return immediately if we get it
  return 
    if ($self->{_CURRENT_HEAD1} =~ /^NAME/i && $self->ReplaceNAMEwithSection());

  # Create a label
  my $label = $self->_create_label($paragraph);

  # Create an index entry
  my $index = $self->_create_index($paragraph);

  # Work out position in the above array taking into account
  # that =head1 is equivalent to $self->Head1Level

  my $level = $self->Head1Level() - 1 + $num;

  # Warn if heading to large
  if ($num > $#LatexSections) {
    my $line = $parobj->file_line;
    my $file = $self->input_file;
    warn "Heading level too large ($level) for LaTeX at line $line of file $file\n";
    $level = $#LatexSections;
  }

  # Check to see whether section should be unnumbered
  my $star = ($level >= $self->LevelNoNum ? '*' : '');

  # Section
  $self->_output("\\" .$LatexSections[$level] .$star ."{$paragraph\\label{".$label ."}\\index{".$index."}}");

}


=back

=end __PRIVATE__

=begin __PRIVATE__

=head2 Internal methods

Internal routines are described in this section. They do not form part of the
public interface. All private methods start with an underscore.

=over 4

=item B<_output>

Output text to the output filehandle. This method must be always be called
to output parsed text.

   $parser->_output($text);

Does not write anything if a =begin or =for is active that should be
ignored.

=cut

sub _output { 
  my $self = shift;
  my $text = shift;

  print { $self->output_handle } $text 
    unless $self->{_suppress_all_para} ||
      $self->{_suppress_next_para};

  # Reset pargraph stuff for =for
  $self->{_suppress_next_para} = 0
    if $self->{_suppress_next_para};
}


=item B<_replace_special_chars>

Subroutine to replace characters that are special in C<latex>
with the escaped forms

  $escaped = $parser->_replace_special_chars($paragraph);

Need to call this routine before interior_sequences are munged but
not if verbatim.

Special characters and the C<latex> equivalents are:

  }     \}
  {     \{
  _     \_
  $     \$
  %     \%
  &     \&
  \     $\backslash$
  ^     \^{}
  ~     \~{}
  |     $|$

=cut

sub _replace_special_chars {
  my $self = shift;
  my $paragraph = shift;

  # Replace a \ with $\backslash$
  # This is made more complicated because the dollars will be escaped
  # by the subsequent replacement. Easiest to add \backslash 
  # now and then add the dollars
  $paragraph =~ s/\\/\\backslash/g;

  # Must be done after escape of \ since this command adds latex escapes
  # Replace characters that can be escaped
  $paragraph =~ s/([\$\#&%_{}])/\\$1/g;

  # Replace ^ characters with \^{} so that $^F works okay
  $paragraph =~ s/(\^)/\\$1\{\}/g;

  # Replace tilde (~) with \texttt{\~{}}
  $paragraph =~ s/~/\\texttt\{\\~\{\}\}/g;

  # Replace | with $|$
  $paragraph =~ s'\|'$|$'g;

  # Now add the dollars around each \backslash
  $paragraph =~ s/(\\backslash)/\$$1\$/g;

  return $paragraph;
}


=item B<_create_label>

Return a string that can be used as an internal reference
in a C<latex> document (i.e. accepted by the C<\label> command)

 $label = $parser->_create_label($string)

If UniqueLabels is true returns a label prefixed by Label()
This can be suppressed with an optional second argument.

 $label = $parser->_create_label($string, $suppress);

If a second argument is supplied (of any value including undef)
the Label() is never prefixed. This means that this routine can
be called to create a Label() without prefixing a previous setting.

=cut

sub _create_label {
  my $self = shift;
  my $paragraph = shift;
  my $suppress = (@_ ? 1 : 0 );

  # Remove latex commands
  $paragraph = $self->_clean_latex_commands($paragraph);

  # Remove non alphanumerics from the label and replace with underscores
  # want to protect '-' though so use negated character classes 
  $paragraph =~ s/[^-:\w]/_/g;

  # Multiple underscores will look unsightly so remove repeats
  # This will also have the advantage of tidying up the end and
  # start of string
  $paragraph =~ s/_+/_/g;

  # If required need to make sure that the label is unique
  # since it is possible to have multiple pods in a single
  # document
  if (!$suppress && $self->UniqueLabels() && defined $self->Label) {
    $paragraph = $self->Label() .'_'. $paragraph;
  }

  return $paragraph;
}


=item B<_create_index>

Similar to C<_create_label> except an index entry is created.
If C<UniqueLabels> is true, the index entry is prefixed by 
the current C<Label> and an exclamation mark.

  $ind = $parser->_create_index($paragraph);

An exclamation mark is used by C<makeindex> to generate 
sub-entries in an index.

=cut

sub _create_index {
  my $self = shift;
  my $paragraph = shift;
  my $suppress = (@_ ? 1 : 0 );

  # Remove latex commands
  $paragraph = $self->_clean_latex_commands($paragraph);

  # If required need to make sure that the index entry is unique
  # since it is possible to have multiple pods in a single
  # document
  if (!$suppress && $self->UniqueLabels() && defined $self->Label) {
    $paragraph = $self->Label() .'!'. $paragraph;
  }

  # Need to replace _ with space
  $paragraph =~ s/_/ /g;

  return $paragraph;

}

=item B<_clean_latex_commands>

Removes latex commands from text. The latex command is assumed to be of the
form C<\command{ text }>. "C<text>" is retained

  $clean = $parser->_clean_latex_commands($text);

=cut

sub _clean_latex_commands {
  my $self = shift;
  my $paragraph = shift;

  # Remove latex commands of the form \text{ }
  # and replace with the contents of the { }
  # need to make this non-greedy so that it can handle
  #  "\text{a} and \text2{b}"
  # without converting it to
  #  "a} and \text2{b"
  # This match will still get into trouble if \} is present 
  # This is not vital since the subsequent replacement of non-alphanumeric
  # characters will tidy it up anyway
  $paragraph =~ s/\\\w+{(.*?)}/$1/g;

  return $paragraph
}

=back

=end __PRIVATE__

=head1 NOTES

Compatible with C<latex2e> only. Can not be used with C<latex> v2.09
or earlier.

A subclass of C<Pod::Select> so that specific pod sections can be
converted to C<latex> by using the C<select> method.

Some HTML escapes are missing and many have not been tested.

=head1 SEE ALSO

L<Pod::Parser>, L<Pod::Select>, L<pod2latex>

=head1 AUTHORS

Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>

=head1 COPYRIGHT

Copyright (C) 2000 Tim Jenness. All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=begin __PRIVATE__

=head1 REVISION

$Id: LaTeX.pm,v 1.6 2000/08/21 09:05:03 timj Exp $

=end __PRIVATE__

=cut
an't get icmp protocol by name");
        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
        $self->{"fh"} = FileHandle->new();
        socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
            croak("icmp socket error - $!");
    }
    elsif ($self->{"proto"} eq "tcp")           # Just a file handle for now
    {
        $self->{"proto_num"} =                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 # Pod::Man -- Convert POD data to formatted *roff input.
# $Id: Man.pm,v 1.15 2001/02/10 06:50:22 eagle Exp $
#
# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module is intended to be a replacement for the pod2man script
# distributed with versions of Perl prior to 5.6, and attempts to match its
# output except for some specific circumstances where other decisions seemed
# to produce better output.  It uses Pod::Parser and is designed to be easy
# to subclass.
#
# Perl core hackers, please note that this module is also separately
# maintained outside of the Perl core as part of the podlators.  Please send
# me any patches at the address above in addition to sending them to the
# standard Perl mailing lists.

############################################################################
# Modules and declarations
############################################################################

package Pod::Man;

require 5.004;

use Carp qw(carp croak);
use Pod::Parser ();

use strict;
use subs qw(makespace);
use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);

@ISA = qw(Pod::Parser);

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
$VERSION = 1.15;


############################################################################
# Preamble and *roff output tables
############################################################################

# The following is the static preamble which starts all *roff output we
# generate.  It's completely static except for the font to use as a
# fixed-width font, which is designed by @CFONT@, and the left and right
# quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@.
# $PREAMBLE should therefore be run through s/\@CFONT\@/<font>/g before
# output.
$PREAMBLE = <<'----END OF PREAMBLE----';
.de Sh \" Subsection heading
.br
.if t .Sp
.ne 5
.PP
\fB\\$1\fR
.PP
..
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Ip \" List item
.br
.ie \\n(.$>=3 .ne \\$3
.el .ne 3
.IP "\\$1" \\$2
..
.de Vb \" Begin verbatim text
.ft @CFONT@
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R

.fi
..
.\" Set up some character translations and predefined strings.  \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote.  | will give a
.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used
.\" to do unbreakable dashes and therefore won't be available.  \*(C` and
.\" \*(C' expand to `' in nroff, nothing in troff, for use with C<>
.tr \(*W-|\(bv\*(Tr
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
.    ds -- \(*W-
.    ds PI pi
.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
.    ds L" ""
.    ds R" ""
.    ds C` @LQUOTE@
.    ds C' @RQUOTE@
'br\}
.el\{\
.    ds -- \|\(em\|
.    ds PI \(*p
.    ds L" ``
.    ds R" ''
'br\}
.\"
.\" If the F register is turned on, we'll generate index entries on stderr
.\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and
.\" index entries marked with X<> in POD.  Of course, you'll have to process
.\" the output yourself in some meaningful fashion.
.if \nF \{\
.    de IX
.    tm Index:\\$1\t\\n%\t"\\$2"
..
.    nr % 0
.    rr F
.\}
.\"
.\" For nroff, turn off justification.  Always turn off hyphenation; it
.\" makes way too many mistakes in technical documents.
.hy 0
.if n .na
.\"
.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
.bd B 3
.    \" fudge factors for nroff and troff
.if n \{\
.    ds #H 0
.    ds #V .8m
.    ds #F .3m
.    ds #[ \f1
.    ds #] \fP
.\}
.if t \{\
.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
.    ds #V .6m
.    ds #F 0
.    ds #[ \&
.    ds #] \&
.\}
.    \" simple accents for nroff and troff
.if n \{\
.    ds ' \&
.    ds ` \&
.    ds ^ \&
.    ds , \&
.    ds ~ ~
.    ds /
.\}
.if t \{\
.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
.\}
.    \" troff and (daisy-wheel) nroff accents
.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
.ds ae a\h'-(\w'a'u*4/10)'e
.ds Ae A\h'-(\w'A'u*4/10)'E
.    \" corrections for vroff
.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
.    \" for low resolution devices (crt and lpr)
.if \n(.H>23 .if \n(.V>19 \
\{\
.    ds : e
.    ds 8 ss
.    ds o a
.    ds d- d\h'-1'\(ga
.    ds D- D\h'-1'\(hy
.    ds th \o'bp'
.    ds Th \o'LP'
.    ds ae ae
.    ds Ae AE
.\}
.rm #[ #] #H #V #F C
----END OF PREAMBLE----
#`# for cperl-mode

# This table is taken nearly verbatim from Tom Christiansen's pod2man.  It
# assumes that the standard preamble has already been printed, since that's
# what defines all of the accent marks.  Note that some of these are quoted
# with double quotes since they contain embedded single quotes, so use \\
# uniformly for backslash for readability.
%ESCAPES = (
    'amp'       =>    '&',      # ampersand
    'lt'        =>    '<',      # left chevron, less-than
    'gt'        =>    '>',      # right chevron, greater-than
    'quot'      =>    '"',      # double quote
    'sol'       =>    '/',      # solidus (forward slash)
    'verbar'    =>    '|',      # vertical bar

    'Aacute'    =>    "A\\*'",  # capital A, acute accent
    'aacute'    =>    "a\\*'",  # small a, acute accent
    'Acirc'     =>    'A\\*^',  # capital A, circumflex accent
    'acirc'     =>    'a\\*^',  # small a, circumflex accent
    'AElig'     =>    '\*(AE',  # capital AE diphthong (ligature)
    'aelig'     =>    '\*(ae',  # small ae diphthong (ligature)
    'Agrave'    =>    "A\\*`",  # capital A, grave accent
    'agrave'    =>    "A\\*`",  # small a, grave accent
    'Aring'     =>    'A\\*o',  # capital A, ring
    'aring'     =>    'a\\*o',  # small a, ring
    'Atilde'    =>    'A\\*~',  # capital A, tilde
    'atilde'    =>    'a\\*~',  # small a, tilde
    'Auml'      =>    'A\\*:',  # capital A, dieresis or umlaut mark
    'auml'      =>    'a\\*:',  # small a, dieresis or umlaut mark
    'Ccedil'    =>    'C\\*,',  # capital C, cedilla
    'ccedil'    =>    'c\\*,',  # small c, cedilla
    'Eacute'    =>    "E\\*'",  # capital E, acute accent
    'eacute'    =>    "e\\*'",  # small e, acute accent
    'Ecirc'     =>    'E\\*^',  # capital E, circumflex accent
    'ecirc'     =>    'e\\*^',  # small e, circumflex accent
    'Egrave'    =>    'E\\*`',  # capital E, grave accent
    'egrave'    =>    'e\\*`',  # small e, grave accent
    'ETH'       =>    '\\*(D-', # capital Eth, Icelandic
    'eth'       =>    '\\*(d-', # small eth, Icelandic
    'Euml'      =>    'E\\*:',  # capital E, dieresis or umlaut mark
    'euml'      =>    'e\\*:',  # small e, dieresis or umlaut mark
    'Iacute'    =>    "I\\*'",  # capital I, acute accent
    'iacute'    =>    "i\\*'",  # small i, acute accent
    'Icirc'     =>    'I\\*^',  # capital I, circumflex accent
    'icirc'     =>    'i\\*^',  # small i, circumflex accent
    'Igrave'    =>    'I\\*`',  # capital I, grave accent
    'igrave'    =>    'i\\*`',  # small i, grave accent
    'Iuml'      =>    'I\\*:',  # capital I, dieresis or umlaut mark
    'iuml'      =>    'i\\*:',  # small i, dieresis or umlaut mark
    'Ntilde'    =>    'N\*~',   # capital N, tilde
    'ntilde'    =>    'n\*~',   # small n, tilde
    'Oacute'    =>    "O\\*'",  # capital O, acute accent
    'oacute'    =>    "o\\*'",  # small o, acute accent
    'Ocirc'     =>    'O\\*^',  # capital O, circumflex accent
    'ocirc'     =>    'o\\*^',  # small o, circumflex accent
    'Ograve'    =>    'O\\*`',  # capital O, grave accent
    'ograve'    =>    'o\\*`',  # small o, grave accent
    'Oslash'    =>    'O\\*/',  # capital O, slash
    'oslash'    =>    'o\\*/',  # small o, slash
    'Otilde'    =>    'O\\*~',  # capital O, tilde
    'otilde'    =>    'o\\*~',  # small o, tilde
    'Ouml'      =>    'O\\*:',  # capital O, dieresis or umlaut mark
    'ouml'      =>    'o\\*:',  # small o, dieresis or umlaut mark
    'szlig'     =>    '\*8',    # small sharp s, German (sz ligature)
    'THORN'     =>    '\\*(Th', # capital THORN, Icelandic
    'thorn'     =>    '\\*(th', # small thorn, Icelandic
    'Uacute'    =>    "U\\*'",  # capital U, acute accent
    'uacute'    =>    "u\\*'",  # small u, acute accent
    'Ucirc'     =>    'U\\*^',  # capital U, circumflex accent
    'ucirc'     =>    'u\\*^',  # small u, circumflex accent
    'Ugrave'    =>    'U\\*`',  # capital U, grave accent
    'ugrave'    =>    'u\\*`',  # small u, grave accent
    'Uuml'      =>    'U\\*:',  # capital U, dieresis or umlaut mark
    'uuml'      =>    'u\\*:',  # small u, dieresis or umlaut mark
    'Yacute'    =>    "Y\\*'",  # capital Y, acute accent
    'yacute'    =>    "y\\*'",  # small y, acute accent
    'yuml'      =>    'y\\*:',  # small y, dieresis or umlaut mark
);


############################################################################
# Static helper functions
############################################################################

# Protect leading quotes and periods against interpretation as commands.
# Also protect anything starting with a backslash, since it could expand
# or hide something that *roff would interpret as a command.  This is
# overkill, but it's much simpler than trying to parse *roff here.
sub protect {
    local $_ = shift;
    s/^([.\'\\])/\\&$1/mg;
    $_;
}

# Translate a font string into an escape.
sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] }


############################################################################
# Initialization
############################################################################

# Initialize the object.  Here, we also process any additional options
# passed to the constructor or set up defaults if none were given.  center
# is the centered title, release is the version number, and date is the date
# for the documentation.  Note that we can't know what file name we're
# processing due to the architecture of Pod::Parser, so that *has* to either
# be passed to the constructor or set separately with Pod::Man::name().
sub initialize {
    my $self = shift;

    # Figure out the fixed-width font.  If user-supplied, make sure that
    # they are the right length.
    for (qw/fixed fixedbold fixeditalic fixedbolditalic/) {
        if (defined $$self{$_}) {
            if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) {
                croak qq(roff font should be 1 or 2 chars,)
                    . qq( not "$$self{$_}");
            }
        } else {
            $$self{$_} = '';
        }
    }

    # Set the default fonts.  We can't be sure what fixed bold-italic is
    # going to be called, so default to just bold.
    $$self{fixed}           ||= 'CW';
    $$self{fixedbold}       ||= 'CB';
    $$self{fixeditalic}     ||= 'CI';
    $$self{fixedbolditalic} ||= 'CB';

    # Set up a table of font escapes.  First number is fixed-width, second
    # is bold, third is italic.
    $$self{FONTS} = { '000' => '\fR', '001' => '\fI',
                      '010' => '\fB', '011' => '\f(BI',
                      '100' => toescape ($$self{fixed}),
                      '101' => toescape ($$self{fixeditalic}),
                      '110' => toescape ($$self{fixedbold}),
                      '111' => toescape ($$self{fixedbolditalic})};

    # Extra stuff for page titles.
    $$self{center} = 'User Contributed Perl Documentation'
        unless defined $$self{center};
    $$self{indent}  = 4 unless defined $$self{indent};

    # We used to try first to get the version number from a local binary,
    # but we shouldn't need that any more.  Get the version from the running
    # Perl.  Work a little magic to handle subversions correctly under both
    # the pre-5.6 and the post-5.6 version numbering schemes.
    if (!defined $$self{release}) {
        my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/);
        $version[2] ||= 0;
        $version[2] *= 10 ** (3 - length $version[2]);
        for (@version) { $_ += 0 }
        $$self{release} = 'perl v' . join ('.', @version);
    }

    # Double quotes in things that will be quoted.
    for (qw/center date release/) {
        $$self{$_} =~ s/\"/\"\"/g if $$self{$_};
    }

    # Figure out what quotes we'll be using for C<> text.
    $$self{quotes} ||= '"';
    if ($$self{quotes} eq 'none') {
        $$self{LQUOTE} = $$self{RQUOTE} = '';
    } elsif (length ($$self{quotes}) == 1) {
        $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};
    } elsif ($$self{quotes} =~ /^(.)(.)$/
             || $$self{quotes} =~ /^(..)(..)$/) {
        $$self{LQUOTE} = $1;
        $$self{RQUOTE} = $2;
    } else {
        croak qq(Invalid quote specification "$$self{quotes}");
    }

    # Double the first quote; note that this should not be s///g as two
    # double quotes is represented in *roff as three double quotes, not
    # four.  Weird, I know.
    $$self{LQUOTE} =~ s/\"/\"\"/;
    $$self{RQUOTE} =~ s/\"/\"\"/;

    $$self{INDENT}  = 0;        # Current indentation level.
    $$self{INDENTS} = [];       # Stack of indentations.
    $$self{INDEX}   = [];       # Index keys waiting to be printed.
    $$self{ITEMS}   = 0;        # The number of consecutive =items.

    $self->SUPER::initialize;
}

# For each document we process, output the preamble first.
sub begin_pod {
    my $self = shift;

    # Try to figure out the name and section from the file name.
    my $section = $$self{section} || 1;
    my $name = $$self{name};
    if (!defined $name) {
        $name = $self->input_file;
        $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i);
        $name =~ s/\.p(od|[lm])\z//i;
        if ($section =~ /^1/) {
            require File::Basename;
            $name = uc File::Basename::basename ($name);
        } else {
            # Lose everything up to the first of
            #     */lib/*perl*      standard or site_perl module
            #     */*perl*/lib      from -D prefix=/opt/perl
            #     */*perl*/         random module hierarchy
            # which works.  Should be fixed to use File::Spec.  Also handle
            # a leading lib/ since that's what ExtUtils::MakeMaker creates.
            for ($name) {
                s%//+%/%g;
                if (     s%^.*?/lib/[^/]*perl[^/]*/%%si
                      or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) {
                    s%^site(_perl)?/%%s;      # site and site_perl
                    s%^(.*-$^O|$^O-.*)/%%so;  # arch
                    s%^\d+\.\d+%%s;           # version
                }
                s%^lib/%%;
                s%/%::%g;
            }
        }
    }

    # If $name contains spaces, quote it; this mostly comes up in the case
    # of input from stdin.
    $name = '"' . $name . '"' if ($name =~ /\s/);

    # Modification date header.  Try to use the modification time of our
    # input.
    if (!defined $$self{date}) {
        my $time = (stat $self->input_file)[9] || time;
        my ($day, $month, $year) = (localtime $time)[3,4,5];
        $month++;
        $year += 1900;
        $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day);
    }

    # Now, print out the preamble and the title.
    local $_ = $PREAMBLE;
    s/\@CFONT\@/$$self{fixed}/;
    s/\@LQUOTE\@/$$self{LQUOTE}/;
    s/\@RQUOTE\@/$$self{RQUOTE}/;
    chomp $_;
    print { $self->output_handle } <<"----END OF HEADER----";
.\\" Automatically generated by Pod::Man version $VERSION
.\\" @{[ scalar localtime ]}
.\\"
.\\" Standard preamble:
.\\" ======================================================================
$_
.\\" ======================================================================
.\\"
.IX Title "$name $section"
.TH $name $section "$$self{release}" "$$self{date}" "$$self{center}"
.UC
----END OF HEADER----
#"# for cperl-mode

    # Initialize a few per-file variables.
    $$self{INDENT} = 0;
    $$self{NEEDSPACE} = 0;
}


############################################################################
# Core overrides
############################################################################

# Called for each command paragraph.  Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
# the command to a method named the same as the command.  =cut is handled
# internally by Pod::Parser.
sub command {
    my $self = shift;
    my $command = shift;
    return if $command eq 'pod';
   return if ($$self{EXCLUDE} && $command ne 'end');
    if ($self->can ('cmd_' . $command)) {
        $command = 'cmd_' . $command;
        $self->$command (@_);
     } else {
        my ($text, $line, $paragraph) = @_;
        my $file;
        ($file, $line) = $paragraph->file_line;
        $text =~ s/\n+\z//;
        $text = " $text" if ($text =~ /^\S/);
        warn qq($file:$line: Unknown command paragraph "=$command$text"\n);
        return;
    }
}

# Called for a verbatim paragraph.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Rofficate backslashes, untabify, put a
# zero-width character at the beginning of each line to protect against
# commands, and wrap in .Vb/.Ve.
sub verbatim {
    my $self = shift;
    return if $$self{EXCLUDE};
    local $_ = shift;
    return if /^\s+$/;
    s/\s+$/\n/;
    my $lines = tr/\n/\n/;
    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
    s/\\/\\e/g;
    s/^(\s*\S)/'\&' . $1/gme;
    $self->makespace;
    $self->output (".Vb $lines\n$_.Ve\n");
    $$self{NEEDSPACE} = 0;
}

# Called for a regular text block.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Perform interpolation and output the results.
sub textblock {
    my $self = shift;
    return if $$self{EXCLUDE};
    $self->output ($_[0]), return if $$self{VERBATIM};

    # Perform a little magic to collapse multiple L<> references.  We'll
    # just rewrite the whole thing into actual text at this part, bypassing
    # the whole internal sequence parsing thing.
    my $text = shift;
    $text =~ s{
        (L<                     # A link of the form L</something>.
              /
              (
                  [:\w]+        # The item has to be a simple word...
                  (\(\))?       # ...or simple function.
              )
          >
          (
              ,?\s+(and\s+)?    # Allow lots of them, conjuncted.
              L<
                  /
                  ( [:\w]+ ( \(\) )? )
              >
          )+
        )
    } {
        local $_ = $1;
        s{ L< / ( [^>]+ ) > } {$1}xg;
        my @items = split /(?:,?\s+(?:and\s+)?)/;
        my $string = 'the ';
        my $i;
        for ($i = 0; $i < @items; $i++) {
            $string .= $items[$i];
            $string .= ', ' if @items > 2 && $i != $#items;
            $string .= ' ' if @items == 2 && $i == 2;
            $string .= 'and ' if ($i == $#items - 1);
        }
        $string .= ' entries elsewhere in this document';
        $string;
    }gex;

    # Parse the tree and output it.  collapse knows about references to
    # scalars as well as scalars and does the right thing with them.
    $text = $self->parse ($text, @_);
    $text =~ s/\n\s*$/\n/;
    $self->makespace;
    $self->output (protect $self->textmapfonts ($text));
    $self->outindex;
    $$self{NEEDSPACE} = 1;
}

# Called for an interior sequence.  Takes a Pod::InteriorSequence object and
# returns a reference to a scalar.  This scalar is the final formatted text.
# It's returned as a reference so that other interior sequences above us
# know that the text has already been processed.
sub sequence {
    my ($self, $seq) = @_;
    my $command = $seq->cmd_name;

    # Zero-width characters.
    if ($command eq 'Z') {
        # Workaround to generate a blessable reference, needed by 5.005.
        my $tmp = '\&';
        return bless \ "$tmp", 'Pod::Man::String';
    }

    # C<>, L<>, X<>, and E<> don't apply guesswork to their contents.  C<>
    # needs some additional special handling.
    my $literal = ($command =~ /^[CELX]$/);
    $literal++ if $command eq 'C';
    local $_ = $self->collapse ($seq->parse_tree, $literal);

    # Handle E<> escapes.
    if ($command eq 'E') {
        if (/^\d+$/) {
            return bless \ chr ($_), 'Pod::Man::String';
        } elsif (exists $ESCAPES{$_}) {
            return bless \ "$ESCAPES{$_}", 'Pod::Man::String';
        } else {
            carp "Unknown escape E<$1>";
            return bless \ "E<$_>", 'Pod::Man::String';
        }
    }

    # For all the other sequences, empty content produces no output.
    return '' if $_ eq '';

    # Handle formatting sequences.
    if ($command eq 'B') {
        return bless \ ('\f(BS' . $_ . '\f(BE'), 'Pod::Man::String';
    } elsif ($command eq 'F') {
        return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String';
    } elsif ($command eq 'I') {
        return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String';
    } elsif ($command eq 'C') {
        return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"),
            'Pod::Man::String';
    }

    # Handle links.
    if ($command eq 'L') {
        # A bug in lvalue subs in 5.6 requires the temporary variable.
        my $tmp = $self->buildlink ($_);
        return bless \ "$tmp", 'Pod::Man::String';
    }

    # Whitespace protection replaces whitespace with "\ ".
    if ($command eq 'S') {
        s/\s+/\\ /g;
        return bless \ "$_", 'Pod::Man::String';
    }

    # Add an index entry to the list of ones waiting to be output.
    if ($command eq 'X') { push (@{ $$self{INDEX} }, $_); return '' }

    # Anything else is unknown.
    carp "Unknown sequence $command<$_>";
}


############################################################################
# Command paragraphs
############################################################################

# All command paragraphs take the paragraph and the line number.

# First level heading.  We can't output .IX in the NAME section due to a bug
# in some versions of catman, so don't output a .IX for that section.  .SH
# already uses small caps, so remove any E<> sequences that would cause
# them.
sub cmd_head1 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\\s-?\d//g;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_)));
    $self->outindex (($_ eq 'NAME') ? () : ('Header', $_));
    $$self{NEEDSPACE} = 0;
}

# Second level heading.
sub cmd_head2 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_)));
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 0;
}

# Third level heading.
sub cmd_head3 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->makespace;
    $self->output ($self->switchquotes ('.I', $self->mapfonts ($_)));
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 1;
}

# Fourth level heading.
sub cmd_head4 {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    if ($$self{ITEMS} > 1) {
        $$self{ITEMS} = 0;
        $self->output (".PD\n");
    }
    $self->makespace;
    $self->output ($self->textmapfonts ($_) . "\n");
    $self->outindex ('Subsection', $_);
    $$self{NEEDSPACE} = 1;
}

# Start a list.  For indents after the first, wrap the outside indent in .RS
# so that hanging paragraph tags will be correct.
sub cmd_over {
    my $self = shift;
    local $_ = shift;
    unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
    if (@{ $$self{INDENTS} } > 0) {
        $self->output (".RS $$self{INDENT}\n");
    }
    push (@{ $$self{INDENTS} }, $$self{INDENT});
    $$self{INDENT} = ($_ + 0);
}

# End a list.  If we've closed an embedded indent, we've mangled the hanging
# paragraph indent, so temporarily replace it with .RS and set WEIRDINDENT.
# We'll close that .RS at the next =back or =item.
sub cmd_back {
    my $self = shift;
    $$self{INDENT} = pop @{ $$self{INDENTS} };
    unless (defined $$self{INDENT}) {
        carp "Unmatched =back";
        $$self{INDENT} = 0;
    }
    if ($$self{WEIRDINDENT}) {
        $self->output (".RE\n");
        $$self{WEIRDINDENT} = 0;
    }
    if (@{ $$self{INDENTS} } > 0) {
        $self->output (".RE\n");
        $self->output (".RS $$self{INDENT}\n");
        $$self{WEIRDINDENT} = 1;
    }
    $$self{NEEDSPACE} = 1;
}

# An individual list item.  Emit an index entry for anything that's
# interesting, but don't emit index entries for things like bullets and
# numbers.  rofficate bullets too while we're at it (so for nice output, use
# * for your lists rather than o or . or - or some other thing).  Newlines
# in an item title are turned into spaces since *roff can't handle them
# embedded.
sub cmd_item {
    my $self = shift;
    local $_ = $self->parse (@_);
    s/\s+$//;
    s/\s*\n\s*/ /g;
    my $index;
    if (/\w/ && !/^\w[.\)]\s*$/) {
        $index = $_;
        $index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//;
    }
    s/^\*(\s|\Z)/\\\(bu$1/;
    if ($$self{WEIRDINDENT}) {
        $self->output (".RE\n");
        $$self{WEIRDINDENT} = 0;
    }
    $_ = $self->textmapfonts ($_);
    $self->output (".PD 0\n") if ($$self{ITEMS} == 1);
    $self->output ($self->switchquotes ('.Ip', $_, $$self{INDENT}));
    $self->outindex ($index ? ('Item', $index) : ());
    $$self{NEEDSPACE} = 0;
    $$self{ITEMS}++;
}

# Begin a block for a particular translator.  Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
    my $self = shift;
    local $_ = shift;
    my ($kind) = /^(\S+)/ or return;
    if ($kind eq 'man' || $kind eq 'roff') {
        $$self{VERBATIM} = 1;
    } else {
        $$self{EXCLUDE} = 1;
    }
}

# End a block for a particular translator.  We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
    my $self = shift;
    $$self{EXCLUDE} = 0;
    $$self{VERBATIM} = 0;
}

# One paragraph for a particular translator.  Ignore it unless it's intended
# for man or roff, in which case we output it verbatim.
sub cmd_for {
    my $self = shift;
    local $_ = shift;
    return unless s/^(?:man|roff)\b[ \t]*\n?//;
    $self->output ($_);
}


############################################################################
# Link handling
############################################################################

# Handle links.  We can't actually make real hyperlinks, so this is all to
# figure out what text and formatting we print out.
sub buildlink {
    my $self = shift;
    local $_ = shift;

    # Smash whitespace in case we were split across multiple lines.
    s/\s+/ /g;

    # If we were given any explicit text, just output it.
    if (m{ ^ ([^|]+) \| }x) { return $1 }

    # Okay, leading and trailing whitespace isn't important.
    s/^\s+//;
    s/\s+$//;

    # If the argument looks like a URL, return it verbatim.  This only
    # handles URLs that use the server syntax.
    if (m%^[a-z]+://\S+$%) { return $_ }

    # Default to using the whole content of the link entry as a section
    # name.  Note that L<manpage/> forces a manpage interpretation, as does
    # something looking like L<manpage(section)>.  Do the same thing to
    # L<manpage(section)> as we would to manpage(section) without the L<>;
    # see guesswork().  If we've added italics, don't add the "manpage"
    # text; markup is sufficient.
    my ($manpage, $section) = ('', $_);
    if (/^"\s*(.*?)\s*"$/) {
        $section = '"' . $1 . '"';
    } elsif (m{ ^ [-:.\w]+ (?: \( \S+ \) )? $ }x) {
        ($manpage, $section) = ($_, '');
        $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|('/e;
    } elsif (m%/%) {
        ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
        if ($manpage =~ /^[-:.\w]+(?:\(\S+\))?$/) {
            $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|'/e;
        }
        $section =~ s/^\"\s*//;
        $section =~ s/\s*\"$//;
    }
    if ($manpage && $manpage !~ /\\f\(IS/) {
        $manpage = "the $manpage manpage";
    }

    # Now build the actual output text.
    my $text = '';
    if (!length ($section) && !length ($manpage)) {
        carp "Invalid link $_";
    } elsif (!length ($section)) {
        $text = $manpage;
    } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
        $text .= 'the ' . $section . ' entry';
        $text .= (length $manpage) ? " in $manpage"
                                   : " elsewhere in this document";
    } else {
        if ($section !~ /^".*"$/) { $section = '"' . $section . '"' }
        $text .= 'the section on ' . $section;
        $text .= " in $manpage" if length $manpage;
    }
    $text;
}


############################################################################
# Escaping and fontification
############################################################################

# At this point, we'll have embedded font codes of the form \f(<font>[SE]
# where <font> is one of B, I, or F.  Turn those into the right font start
# or end codes.  The old pod2man didn't get B<someI<thing> else> right;
# after I<> it switched back to normal text rather than bold.  We take care
# of this by using variables as a combined pointer to our current font
# sequence, and set each to the number of current nestings of start tags for
# that font.  Use them as a vector to look up what font sequence to use.
#
# \fP changes to the previous font, but only one previous font is kept.  We
# don't know what the outside level font is; normally it's R, but if we're
# inside a heading it could be something else.  So arrange things so that
# the outside font is always the "previous" font and end with \fP instead of
# \fR.  Idea from Zack Weinberg.
sub mapfonts {
    my $self = shift;
    local $_ = shift;

    my ($fixed, $bold, $italic) = (0, 0, 0);
    my %magic = (F => \$fixed, B => \$bold, I => \$italic);
    my $last = '\fR';
    s { \\f\((.)(.) } {
        my $sequence = '';
        my $f;
        if ($last ne '\fR') { $sequence = '\fP' }
        ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
        $f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
        if ($f eq $last) {
            '';
        } else {
            if ($f ne '\fR') { $sequence .= $f }
            $last = $f;
            $sequence;
        }
    }gxe;
    $_;
}

# Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU
# groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather
# than R, presumably because \f(CW doesn't actually do a font change.  To
# work around this, use a separate textmapfonts for text blocks where the
# default font is always R and only use the smart mapfonts for headings.
sub textmapfonts {
    my $self = shift;
    local $_ = shift;

    my ($fixed, $bold, $italic) = (0, 0, 0);
    my %magic = (F => \$fixed, B => \$bold, I => \$italic);
    s { \\f\((.)(.) } {
        ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1;
        $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)};
    }gxe;
    $_;
}


############################################################################
# *roff-specific parsing
############################################################################

# Called instead of parse_text, calls parse_text with the right flags.
sub parse {
    my $self = shift;
    $self->parse_text ({ -expand_seq   => 'sequence',
                         -expand_ptree => 'collapse' }, @_);
}

# Takes a parse tree and a flag saying whether or not to treat it as literal
# text (not call guesswork on it), and returns the concatenation of all of
# the text strings in that parse tree.  If the literal flag isn't true,
# guesswork() will be called on all plain scalars in the parse tree.
# Otherwise, just escape backslashes in the normal case.  If collapse is
# being called on a C<> sequence, literal is set to 2, and we do some
# additional cleanup.  Assumes that everything in the parse tree is either a
# scalar or a reference to a scalar.
sub collapse {
    my ($self, $ptree, $literal) = @_;
    if ($literal) {
        return join ('', map {
            if (ref $_) {
                $$_;
            } else {
                s/\\/\\e/g;
                s/-/\\-/g    if $literal > 1;
                s/__/_\\|_/g if $literal > 1;
                $_;
            }
        } $ptree->children);
    } else {
        return join ('', map {
            ref ($_) ? $$_ : $self->guesswork ($_)
        } $ptree->children);
    }
}

# Takes a text block to perform guesswork on; this is guaranteed not to
# contain any interior sequences.  Returns the text block with remapping
# done.
sub guesswork {
    my $self = shift;
    local $_ = shift;

    # rofficate backslashes.
    s/\\/\\e/g;

    # Ensure double underbars have a tiny space between them.
    s/__/_\\|_/g;

    # Make all caps a little smaller.  Be careful here, since we don't want
    # to make @ARGV into small caps, nor do we want to fix the MIME in
    # MIME-Version, since it looks weird with the full-height V.
    s{
        ( ^ | [\s\(\"\'\`\[\{<>] )
        ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* )
        (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ )
    } { $1 . '\s-1' . $2 . '\s0' }egx;

    # Turn PI into a pretty pi.
    s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx;

    # Italize functions in the form func().
    s{
        \b
        (
            [:\w]+ (?:\\s-1)? \(\)
        )
    } { '\f(IS' . $1 . '\f(IE' }egx;

    # func(n) is a reference to a manual page.  Make it \fIfunc\fR\|(n).
    s{
        \b
        (\w[-:.\w]+ (?:\\s-1)?)
        (
            \( [^\)] \)
        )
    } { '\f(IS' . $1 . '\f(IE\|' . $2 }egx;

    # Convert simple Perl variable references to a fixed-width font.
    s{
        ( \s+ )
        ( [\$\@%] [\w:]+ )
        (?! \( )
    } { $1 . '\f(FS' . $2 . '\f(FE'}egx;

    # Translate -- into a real em dash if it's used like one and fix up
    # dashes, but keep hyphens hyphens.
    s{ (\G|^|.) (-+) (\b|.) } {
        my ($pre, $dash, $post) = ($1, $2, $3);
        if (length ($dash) == 1) {
            ($pre =~ /[a-zA-Z]/) ? "$pre-$post" : "$pre\\-$post";
        } elsif (length ($dash) == 2
                 && ((!$pre && !$post)
                     || ($pre =~ /\w/ && !$post)
                     || ($pre eq ' ' && $post eq ' ')
                     || ($pre eq '=' && $post ne '=')
                     || ($pre ne '=' && $post eq '='))) {
            "$pre\\*(--$post";
        } else {
            $pre . ('\-' x length $dash) . $post;
        }
    }egxs;

    # Fix up double quotes.
    s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx;

    # Make C++ into \*(C+, which is a squinched version.
    s{ \b C\+\+ } {\\*\(C+}gx;

    # All done.
    $_;
}


############################################################################
# Output formatting
############################################################################

# Make vertical whitespace.
sub makespace {
    my $self = shift;
    $self->output (".PD\n") if ($$self{ITEMS} > 1);
    $$self{ITEMS} = 0;
    $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n")
        if $$self{NEEDSPACE};
}

# Output any pending index entries, and optionally an index entry given as
# an argument.  Support multiple index entries in X<> separated by slashes,
# and strip special escapes from index entries.
sub outindex {
    my ($self, $section, $index) = @_;
    my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} };
    return unless ($section || @entries);
    $$self{INDEX} = [];
    my $output;
    if (@entries) {
        my $output = '.IX Xref "'
            . join (' ', map { s/\"/\"\"/; $_ } @entries)
            . '"' . "\n";
    }
    if ($section) {
        $index =~ s/\"/\"\"/;
        $index =~ s/\\-/-/g;
        $index =~ s/\\(?:s-?\d|.\(..|.)//g;
        $output .= ".IX $section " . '"' . $index . '"' . "\n";
    }
    $self->output ($output);
}

# Output text to the output device.
sub output { print { $_[0]->output_handle } $_[1] }

# Given a command and a single argument that may or may not contain double
# quotes, handle double-quote formatting for it.  If there are no double
# quotes, just return the command followed by the argument in double quotes.
# If there are double quotes, use an if statement to test for nroff, and for
# nroff output the command followed by the argument in double quotes with
# embedded double quotes doubled.  For other formatters, remap paired double
# quotes to LQUOTE and RQUOTE.
sub switchquotes {
    my $self = shift;
    my $command = shift;
    local $_ = shift;
    my $extra = shift;
    s/\\\*\([LR]\"/\"/g;

    # We also have to deal with \*C` and \*C', which are used to add the
    # quotes around C<> text, since they may expand to " and if they do this
    # confuses the .SH macros and the like no end.  Expand them ourselves.
    # If $extra is set, we're dealing with =item, which in most nroff macro
    # sets requires an extra level of quoting of double quotes.
    my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
    if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) {
        s/\"/\"\"/g;
        my $troff = $_;
        $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
        s/\\\*\(C\`/$$self{LQUOTE}/g;
        s/\\\*\(C\'/$$self{RQUOTE}/g;
        $troff =~ s/\\\*\(C[\'\`]//g;
        s/\"/\"\"/g if $extra;
        $troff =~ s/\"/\"\"/g if $extra;
        $_ = qq("$_") . ($extra ? " $extra" : '');
        $troff = qq("$troff") . ($extra ? " $extra" : '');
        return ".if n $command $_\n.el $command $troff\n";
    } else {
        $_ = qq("$_") . ($extra ? " $extra" : '');
        return "$command $_\n";
    }
}

__END__

.\" These are some extra bits of roff that I don't want to lose track of
.\" but that have been removed from the preamble to make it a bit shorter
.\" since they're not currently being used.  They're accents and special
.\" characters we don't currently have escapes for.
.if n \{\
.    ds ? ?
.    ds ! !
.    ds q
.\}
.if t \{\
.    ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
.    ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
.    ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
.\}
.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
.ds oe o\h'-(\w'o'u*4/10)'e
.ds Oe O\h'-(\w'O'u*4/10)'E
.if \n(.H>23 .if \n(.V>19 \
\{\
.    ds v \h'-1'\o'\(aa\(ga'
.    ds _ \h'-1'^
.    ds . \h'-1'.
.    ds 3 3
.    ds oe oe
.    ds Oe OE
.\}

############################################################################
# Documentation
############################################################################

=head1 NAME

Pod::Man - Convert POD data to formatted *roff input

=head1 SYNOPSIS

    use Pod::Man;
    my $parser = Pod::Man->new (release => $VERSION, section => 8);

    # Read POD from STDIN and write to STDOUT.
    $parser->parse_from_filehandle;

    # Read POD from file.pod and write to file.1.
    $parser->parse_from_file ('file.pod', 'file.1');

=head1 DESCRIPTION

Pod::Man is a module to convert documentation in the POD format (the
preferred language for documenting Perl) into *roff input using the man
macro set.  The resulting *roff code is suitable for display on a terminal
using nroff(1), normally via man(1), or printing using troff(1).  It is
conventionally invoked using the driver script B<pod2man>, but it can also
be used directly.

As a derived class from Pod::Parser, Pod::Man supports the same methods and
interfaces.  See L<Pod::Parser> for all the details; briefly, one creates a
new parser with C<Pod::Man-E<gt>new()> and then calls either
parse_from_filehandle() or parse_from_file().

new() can take options, in the form of key/value pairs that control the
behavior of the parser.  See below for details.

If no options are given, Pod::Man uses the name of the input file with any
trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to
section 1 unless the file ended in C<.pm> in which case it defaults to
section 3, to a centered title of "User Contributed Perl Documentation", to
a centered footer of the Perl version it is run with, and to a left-hand
footer of the modification date of its input (or the current date if given
STDIN for input).

Pod::Man assumes that your *roff formatters have a fixed-width font named
CW.  If yours is called something else (like CR), use the C<fixed> option to
specify it.  This generally only matters for troff output for printing.
Similarly, you can set the fonts used for bold, italic, and bold italic
fixed-width output.

Besides the obvious pod conversions, Pod::Man also takes care of formatting
func(), func(n), and simple variable references like $foo or @bar so you
don't have to use code escapes for them; complex expressions like
C<$fred{'stuff'}> will still need to be escaped, though.  It also translates
dashes that aren't used as hyphens into en dashes, makes long dashes--like
this--into proper em dashes, fixes "paired quotes," makes C++ and PI look
right, puts a little space between double underbars, makes ALLCAPS a teeny
bit smaller in troff(1), and escapes stuff that *roff treats as special so
that you don't have to.

The recognized options to new() are as follows.  All options take a single
argument.

=over 4

=item center

Sets the centered page header to use instead of "User Contributed Perl
Documentation".

=item date

Sets the left-hand footer.  By default, the modification date of the input
file will be used, or the current date if stat() can't find that file (the
case if the input is from STDIN), and the date will be formatted as
YYYY-MM-DD.

=item fixed

The fixed-width font to use for vertabim text and code.  Defaults to CW.
Some systems may want CR instead.  Only matters for troff(1) output.

=item fixedbold

Bold version of the fixed-width font.  Defaults to CB.  Only matters for
troff(1) output.

=item fixeditalic

Italic version of the fixed-width font (actually, something of a misnomer,
since most fixed-width fonts only have an oblique version, not an italic
version).  Defaults to CI.  Only matters for troff(1) output.

=item fixedbolditalic

Bold italic (probably actually oblique) version of the fixed-width font.
Pod::Man doesn't assume you have this, and defaults to CB.  Some systems
(such as Solaris) have this font available as CX.  Only matters for troff(1)
output.

=item quotes

Sets the quote marks used to surround CE<lt>> text.  If the value is a
single character, it is used as both the left and right quote; if it is two
characters, the first character is used as the left quote and the second as
the right quoted; and if it is four characters, the first two are used as
the left quote and the second two as the right quote.

This may also be set to the special value C<none>, in which case no quote
marks are added around CE<lt>> text (but the font is still changed for troff
output).

=item release

Set the centered footer.  By default, this is the version of Perl you run
Pod::Man under.  Note that some system an macro sets assume that the
centered footer will be a modification date and will prepend something like
"Last modified: "; if this is the case, you may want to set C<release> to
the last modified date and C<date> to the version number.

=item section

Set the section for the C<.TH> macro.  The standard section numbering
convention is to use 1 for user commands, 2 for system calls, 3 for
functions, 4 for devices, 5 for file formats, 6 for games, 7 for
miscellaneous information, and 8 for administrator commands.  There is a lot
of variation here, however; some systems (like Solaris) use 4 for file
formats, 5 for miscellaneous information, and 7 for devices.  Still others
use 1m instead of 8, or some mix of both.  About the only section numbers
that are reliably consistent are 1, 2, and 3.

By default, section 1 will be used unless the file ends in .pm in which case
section 3 will be selected.

=back

The standard Pod::Parser method parse_from_filehandle() takes up to two
arguments, the first being the file handle to read POD from and the second
being the file handle to write the formatted output to.  The first defaults
to STDIN if not given, and the second defaults to STDOUT.  The method
parse_from_file() is almost identical, except that its two arguments are the
input and output disk files instead.  See L<Pod::Parser> for the specific
details.

=head1 DIAGNOSTICS

=over 4

=item roff font should be 1 or 2 chars, not "%s"

(F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that
wasn't either one or two characters.  Pod::Man doesn't support *roff fonts
longer than two characters, although some *roff extensions do (the canonical
versions of nroff(1) and troff(1) don't either).

=item Invalid link %s

(W) The POD source contained a C<LE<lt>E<gt>> sequence that Pod::Man was
unable to parse.  You should never see this error message; it probably
indicates a bug in Pod::Man.

=item Invalid quote specification "%s"

(F) The quote specification given (the quotes option to the constructor) was
invalid.  A quote specification must be one, two, or four characters long.

=item %s:%d: Unknown command paragraph "%s".

(W) The POD source contained a non-standard command paragraph (something of
the form C<=command args>) that Pod::Man didn't know about.  It was ignored.

=item Unknown escape EE<lt>%sE<gt>

(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::Man didn't
know about.  C<EE<lt>%sE<gt>> was printed verbatim in the output.

=item Unknown sequence %s

(W) The POD source contained a non-standard interior sequence (something of
the form C<XE<lt>E<gt>>) that Pod::Man didn't know about.  It was ignored.

=item %s: Unknown command paragraph "%s" on line %d.

(W) The POD source contained a non-standard command paragraph (something of
the form C<=command args>) that Pod::Man didn't know about. It was ignored.

=item Unmatched =back

(W) Pod::Man encountered a C<=back> command that didn't correspond to an
C<=over> command.

=back

=head1 BUGS

The lint-like features and strict POD format checking done by B<pod2man> are
not yet implemented and should be, along with the corresponding C<lax>
option.

The NAME section should be recognized specially and index entries emitted
for everything in that section.  This would have to be deferred until the
next section, since extraneous things in NAME tends to confuse various man
page processors.

The handling of hyphens, en dashes, and em dashes is somewhat fragile, and
one may get the wrong one under some circumstances.  This should only matter
for troff(1) output.

When and whether to use small caps is somewhat tricky, and Pod::Man doesn't
necessarily get it right.

Pod::Man doesn't handle font names longer than two characters.  Neither do
most troff(1) implementations, but GNU troff does as an extension.  It would
be nice to support as an option for those who want to use it.

The preamble added to each output file is rather verbose, and most of it is
only necessary in the presence of EE<lt>E<gt> escapes for non-ASCII
characters.  It would ideally be nice if all of those definitions were only
output if needed, perhaps on the fly as the characters are used.

Some of the automagic applied to file names assumes Unix directory
separators.

Pod::Man is excessively slow.

=head1 SEE ALSO

L<Pod::Parser|Pod::Parser>, perlpod(1), pod2man(1), nroff(1), troff(1),
man(1), man(7)

Ossanna, Joseph F., and Brian W. Kernighan.  "Troff User's Manual,"
Computing Science Technical Report No. 54, AT&T Bell Laboratories.  This is
the best documentation of standard nroff(1) and troff(1).  At the time of
this writing, it's available at http://www.cs.bell-labs.com/cm/cs/cstr.html.

The man page documenting the man macro set may be man(5) instead of man(7)
on your system.  Also, please see pod2man(1) for extensive documentation on
writing manual pages if you've not done it before and aren't familiar with
the conventions.

=head1 AUTHOR

Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
original B<pod2man> by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>.

=cut
INARY TELOPT_ECHO TELOPT_RCP TELOPT_SGA TELOPT_NAMS
		TELOPT_STATUS TELOPT_TM TELOPT_RCTE TELOPT_NAOL TELOPT_NAOP
		TELOPT_NAOCRD TELOPT_NAOHTS TELOPT_NAOHTD TELOPT_NAOFFD
		TELOPT_NAOVTS TELOPT_NAOVTD TELOPT_NAOLFD TELOPT_XASCII
		TELOPT_LOGOUT TELOPT_BM TELOPT_DET TELOPT_SUPDUP
		TELOPT_SUPDUPOUTPUT TELOPT_SNDLOC TELOPT_TTYPE TELOPT_EOR
		TELOPT_TUID TELOPT_OUTMRK TELOPT_TTYLOC TELOPT_3270REGIME
		TELOPT_X3                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################
# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Parser;

use vars qw($VERSION);
$VERSION = 1.13;  ## Current version of this package
require  5.005;    ## requires this Perl version or later

#############################################################################

=head1 NAME

Pod::Parser - base class for creating POD filters and translators

=head1 SYNOPSIS

    use Pod::Parser;

    package MyParser;
    @ISA = qw(Pod::Parser);

    sub command { 
        my ($parser, $command, $paragraph, $line_num) = @_;
        ## Interpret the command and its text; sample actions might be:
        if ($command eq 'head1') { ... }
        elsif ($command eq 'head2') { ... }
        ## ... other commands and their actions
        my $out_fh = $parser->output_handle();
        my $expansion = $parser->interpolate($paragraph, $line_num);
        print $out_fh $expansion;
    }

    sub verbatim { 
        my ($parser, $paragraph, $line_num) = @_;
        ## Format verbatim paragraph; sample actions might be:
        my $out_fh = $parser->output_handle();
        print $out_fh $paragraph;
    }

    sub textblock { 
        my ($parser, $paragraph, $line_num) = @_;
        ## Translate/Format this block of text; sample actions might be:
        my $out_fh = $parser->output_handle();
        my $expansion = $parser->interpolate($paragraph, $line_num);
        print $out_fh $expansion;
    }

    sub interior_sequence { 
        my ($parser, $seq_command, $seq_argument) = @_;
        ## Expand an interior sequence; sample actions might be:
        return "*$seq_argument*"     if ($seq_command eq 'B');
        return "`$seq_argument'"     if ($seq_command eq 'C');
        return "_${seq_argument}_'"  if ($seq_command eq 'I');
        ## ... other sequence commands and their resulting text
    }

    package main;

    ## Create a parser object and have it parse file whose name was
    ## given on the command-line (use STDIN if no files were given).
    $parser = new MyParser();
    $parser->parse_from_filehandle(\*STDIN)  if (@ARGV == 0);
    for (@ARGV) { $parser->parse_from_file($_); }

=head1 REQUIRES

perl5.005, Pod::InputObjects, Exporter, Symbol, Carp

=head1 EXPORTS

Nothing.

=head1 DESCRIPTION

B<Pod::Parser> is a base class for creating POD filters and translators.
It handles most of the effort involved with parsing the POD sections
from an input stream, leaving subclasses free to be concerned only with
performing the actual translation of text.

B<Pod::Parser> parses PODs, and makes method calls to handle the various
components of the POD. Subclasses of B<Pod::Parser> override these methods
to translate the POD into whatever output format they desire.

=head1 QUICK OVERVIEW

To create a POD filter for translating POD documentation into some other
format, you create a subclass of B<Pod::Parser> which typically overrides
just the base class implementation for the following methods:

=over 2

=item *

B<command()>

=item *

B<verbatim()>

=item *

B<textblock()>

=item *

B<interior_sequence()>

=back

You may also want to override the B<begin_input()> and B<end_input()>
methods for your subclass (to perform any needed per-file and/or
per-document initialization or cleanup).

If you need to perform any preprocesssing of input before it is parsed
you may want to override one or more of B<preprocess_line()> and/or
B<preprocess_paragraph()>.

Sometimes it may be necessary to make more than one pass over the input
files. If this is the case you have several options. You can make the
first pass using B<Pod::Parser> and override your methods to store the
intermediate results in memory somewhere for the B<end_pod()> method to
process. You could use B<Pod::Parser> for several passes with an
appropriate state variable to control the operation for each pass. If
your input source can't be reset to start at the beginning, you can
store it in some other structure as a string or an array and have that
structure implement a B<getline()> method (which is all that
B<parse_from_filehandle()> uses to read input).

Feel free to add any member data fields you need to keep track of things
like current font, indentation, horizontal or vertical position, or
whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">
to avoid name collisions.

For the most part, the B<Pod::Parser> base class should be able to
do most of the input parsing for you and leave you free to worry about
how to intepret the commands and translate the result.

Note that all we have described here in this quick overview is the
simplest most straightforward use of B<Pod::Parser> to do stream-based
parsing. It is also possible to use the B<Pod::Parser::parse_text> function
to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.

=head1 PARSING OPTIONS

A I<parse-option> is simply a named option of B<Pod::Parser> with a
value that corresponds to a certain specified behavior. These various
behaviors of B<Pod::Parser> may be enabled/disabled by setting or
or unsetting one or more I<parse-options> using the B<parseopts()> method.
The set of currently accepted parse-options is as follows:

=over 3

=item B<-want_nonPODs> (default: unset)

Normally (by default) B<Pod::Parser> will only provide access to
the POD sections of the input. Input paragraphs that are not part
of the POD-format documentation are not made available to the caller
(not even using B<preprocess_paragraph()>). Setting this option to a
non-empty, non-zero value will allow B<preprocess_paragraph()> to see
non-POD sections of the input as well as POD sections. The B<cutting()>
method can be used to determine if the corresponding paragraph is a POD
paragraph, or some other input paragraph.

=item B<-process_cut_cmd> (default: unset)

Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive
by itself and does not pass it on to the caller for processing. Setting
this option to a non-empty, non-zero value will cause B<Pod::Parser> to
pass the C<=cut> directive to the caller just like any other POD command
(and hence it may be processed by the B<command()> method).

B<Pod::Parser> will still interpret the C<=cut> directive to mean that
"cutting mode" has been (re)entered, but the caller will get a chance
to capture the actual C<=cut> paragraph itself for whatever purpose
it desires.

=item B<-warnings> (default: unset)

Normally (by default) B<Pod::Parser> recognizes a bare minimum of
pod syntax errors and warnings and issues diagnostic messages
for errors, but not for warnings. (Use B<Pod::Checker> to do more
thorough checking of POD syntax.) Setting this option to a non-empty,
non-zero value will cause B<Pod::Parser> to issue diagnostics for
the few warnings it recognizes as well as the errors.

=back

Please see L<"parseopts()"> for a complete description of the interface
for the setting and unsetting of parse-options.

=cut

#############################################################################

use vars qw(@ISA);
use strict;
#use diagnostics;
use Pod::InputObjects;
use Carp;
use Exporter;
BEGIN {
   if ($] < 5.6) {
      require Symbol;
      import Symbol;
   }
}
@ISA = qw(Exporter);

## These "variables" are used as local "glob aliases" for performance
use vars qw(%myData %myOpts @input_stack);

#############################################################################

=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES

B<Pod::Parser> provides several methods which most subclasses will probably
want to override. These methods are as follows:

=cut

##---------------------------------------------------------------------------

=head1 B<command()>

            $parser->command($cmd,$text,$line_num,$pod_para);

This method should be overridden by subclasses to take the appropriate
action when a POD command paragraph (denoted by a line beginning with
"=") is encountered. When such a POD directive is seen in the input,
this method is called and is passed:

=over 3

=item C<$cmd>

the name of the command for this POD paragraph

=item C<$text>

the paragraph text for the given POD paragraph command.

=item C<$line_num>

the line-number of the beginning of the paragraph

=item C<$pod_para>

a reference to a C<Pod::Paragraph> object which contains further
information about the paragraph command (see L<Pod::InputObjects>
for details).

=back

B<Note> that this method I<is> called for C<=pod> paragraphs.

The base class implementation of this method simply treats the raw POD
command as normal block of paragraph text (invoking the B<textblock()>
method with the command paragraph).

=cut

sub command {
    my ($self, $cmd, $text, $line_num, $pod_para)  = @_;
    ## Just treat this like a textblock
    $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
}

##---------------------------------------------------------------------------

=head1 B<verbatim()>

            $parser->verbatim($text,$line_num,$pod_para);

This method may be overridden by subclasses to take the appropriate
action when a block of verbatim text is encountered. It is passed the
following parameters:

=over 3

=item C<$text>

the block of text for the verbatim paragraph

=item C<$line_num>

the line-number of the beginning of the paragraph

=item C<$pod_para>

a reference to a C<Pod::Paragraph> object which contains further
information about the paragraph (see L<Pod::InputObjects>
for details).

=back

The base class implementation of this method simply prints the textblock
(unmodified) to the output filehandle.

=cut

sub verbatim {
    my ($self, $text, $line_num, $pod_para) = @_;
    my $out_fh = $self->{_OUTPUT};
    print $out_fh $text;
}

##---------------------------------------------------------------------------

=head1 B<textblock()>

            $parser->textblock($text,$line_num,$pod_para);

This method may be overridden by subclasses to take the appropriate
action when a normal block of POD text is encountered (although the base
class method will usually do what you want). It is passed the following
parameters:

=over 3

=item C<$text>

the block of text for the a POD paragraph

=item C<$line_num>

the line-number of the beginning of the paragraph

=item C<$pod_para>

a reference to a C<Pod::Paragraph> object which contains further
information about the paragraph (see L<Pod::InputObjects>
for details).

=back

In order to process interior sequences, subclasses implementations of
this method will probably want to invoke either B<interpolate()> or
B<parse_text()>, passing it the text block C<$text>, and the corresponding
line number in C<$line_num>, and then perform any desired processing upon
the returned result.

The base class implementation of this method simply prints the text block
as it occurred in the input stream).

=cut

sub textblock {
    my ($self, $text, $line_num, $pod_para) = @_;
    my $out_fh = $self->{_OUTPUT};
    print $out_fh $self->interpolate($text, $line_num);
}

##---------------------------------------------------------------------------

=head1 B<interior_sequence()>

            $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);

This method should be overridden by subclasses to take the appropriate
action when an interior sequence is encountered. An interior sequence is
an embedded command within a block of text which appears as a command
name (usually a single uppercase character) followed immediately by a
string of text which is enclosed in angle brackets. This method is
passed the sequence command C<$seq_cmd> and the corresponding text
C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior
sequence that occurs in the string that it is passed. It should return
the desired text string to be used in place of the interior sequence.
The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>
object which contains further information about the interior sequence.
Please see L<Pod::InputObjects> for details if you need to access this
additional information.

Subclass implementations of this method may wish to invoke the 
B<nested()> method of C<$pod_seq> to see if it is nested inside
some other interior-sequence (and if so, which kind).

The base class implementation of the B<interior_sequence()> method
simply returns the raw text of the interior sequence (as it occurred
in the input) to the caller.

=cut

sub interior_sequence {
    my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
    ## Just return the raw text of the interior sequence
    return  $pod_seq->raw_text();
}

#############################################################################

=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES

B<Pod::Parser> provides several methods which subclasses may want to override
to perform any special pre/post-processing. These methods do I<not> have to
be overridden, but it may be useful for subclasses to take advantage of them.

=cut

##---------------------------------------------------------------------------

=head1 B<new()>

            my $parser = Pod::Parser->new();

This is the constructor for B<Pod::Parser> and its subclasses. You
I<do not> need to override this method! It is capable of constructing
subclass objects as well as base class objects, provided you use
any of the following constructor invocation styles:

    my $parser1 = MyParser->new();
    my $parser2 = new MyParser();
    my $parser3 = $parser2->new();

where C<MyParser> is some subclass of B<Pod::Parser>.

Using the syntax C<MyParser::new()> to invoke the constructor is I<not>
recommended, but if you insist on being able to do this, then the
subclass I<will> need to override the B<new()> constructor method. If
you do override the constructor, you I<must> be sure to invoke the
B<initialize()> method of the newly blessed object.

Using any of the above invocations, the first argument to the
constructor is always the corresponding package name (or object
reference). No other arguments are required, but if desired, an
associative array (or hash-table) my be passed to the B<new()>
constructor, as in:

    my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );
    my $parser2 = new MyParser( -myflag => 1 );

All arguments passed to the B<new()> constructor will be treated as
key/value pairs in a hash-table. The newly constructed object will be
initialized by copying the contents of the given hash-table (which may
have been empty). The B<new()> constructor for this class and all of its
subclasses returns a blessed reference to the initialized object (hash-table).

=cut

sub new {
    ## Determine if we were called via an object-ref or a classname
    my $this = shift;
    my $class = ref($this) || $this;
    ## Any remaining arguments are treated as initial values for the
    ## hash that is used to represent this object.
    my %params = @_;
    my $self = { %params };
    ## Bless ourselves into the desired class and perform any initialization
    bless $self, $class;
    $self->initialize();
    return $self;
}

##---------------------------------------------------------------------------

=head1 B<initialize()>

            $parser->initialize();

This method performs any necessary object initialization. It takes no
arguments (other than the object instance of course, which is typically
copied to a local variable named C<$self>). If subclasses override this
method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.

=cut

sub initialize {
    #my $self = shift;
    #return;
}

##---------------------------------------------------------------------------

=head1 B<begin_pod()>

            $parser->begin_pod();

This method is invoked at the beginning of processing for each POD
document that is encountered in the input. Subclasses should override
this method to perform any per-document initialization.

=cut

sub begin_pod {
    #my $self = shift;
    #return;
}

##---------------------------------------------------------------------------

=head1 B<begin_input()>

            $parser->begin_input();

This method is invoked by B<parse_from_filehandle()> immediately I<before>
processing input from a filehandle. The base class implementation does
nothing, however, subclasses may override it to perform any per-file
initializations.

Note that if multiple files are parsed for a single POD document
(perhaps the result of some future C<=include> directive) this method
is invoked for every file that is parsed. If you wish to perform certain
initializations once per document, then you should use B<begin_pod()>.

=cut

sub begin_input {
    #my $self = shift;
    #return;
}

##---------------------------------------------------------------------------

=head1 B<end_input()>

            $parser->end_input();

This method is invoked by B<parse_from_filehandle()> immediately I<after>
processing input from a filehandle. The base class implementation does
nothing, however, subclasses may override it to perform any per-file
cleanup actions.

Please note that if multiple files are parsed for a single POD document
(perhaps the result of some kind of C<=include> directive) this method
is invoked for every file that is parsed. If you wish to perform certain
cleanup actions once per document, then you should use B<end_pod()>.

=cut

sub end_input {
    #my $self = shift;
    #return;
}

##---------------------------------------------------------------------------

=head1 B<end_pod()>

            $parser->end_pod();

This method is invoked at the end of processing for each POD document
that is encountered in the input. Subclasses should override this method
to perform any per-document finalization.

=cut

sub end_pod {
    #my $self = shift;
    #return;
}

##---------------------------------------------------------------------------

=head1 B<preprocess_line()>

          $textline = $parser->preprocess_line($text, $line_num);

This method should be overridden by subclasses that wish to perform
any kind of preprocessing for each I<line> of input (I<before> it has
been determined whether or not it is part of a POD paragraph). The
parameter C<$text> is the input line; and the parameter C<$line_num> is
the line number of the corresponding text line.

The value returned should correspond to the new text to use in its
place.  If the empty string or an undefined value is returned then no
further processing will be performed for this line.

Please note that the B<preprocess_line()> method is invoked I<before>
the B<preprocess_paragraph()> method. After all (possibly preprocessed)
lines in a paragraph have been assembled together and it has been
determined that the paragraph is part of the POD documentation from one
of the selected sections, then B<preprocess_paragraph()> is invoked.

The base class implementation of this method returns the given text.

=cut

sub preprocess_line {
    my ($self, $text, $line_num) = @_;
    return  $text;
}

##---------------------------------------------------------------------------

=head1 B<preprocess_paragraph()>

            $textblock = $parser->preprocess_paragraph($text, $line_num);

This method should be overridden by subclasses that wish to perform any
kind of preprocessing for each block (paragraph) of POD documentation
that appears in the input stream. The parameter C<$text> is the POD
paragraph from the input file; and the parameter C<$line_num> is the
line number for the beginning of the corresponding paragraph.

The value returned should correspond to the new text to use in its
place If the empty string is returned or an undefined value is
returned, then the given C<$text> is ignored (not processed).

This method is invoked after gathering up all the lines in a paragraph
and after determining the cutting state of the paragraph,
but before trying to further parse or interpret them. After
B<preprocess_paragraph()> returns, the current cutting state (which
is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
to true then input text (including the given C<$text>) is cut (not
processed) until the next POD directive is encountered.

Please note that the B<preprocess_line()> method is invoked I<before>
the B<preprocess_paragraph()> method. After all (possibly preprocessed)
lines in a paragraph have been assembled together and either it has been
determined that the paragraph is part of the POD documentation from one
of the selected sections or the C<-want_nonPODs> option is true,
then B<preprocess_paragraph()> is invoked.

The base class implementation of this method returns the given text.

=cut

sub preprocess_paragraph {
    my ($self, $text, $line_num) = @_;
    return  $text;
}

#############################################################################

=head1 METHODS FOR PARSING AND PROCESSING

B<Pod::Parser> provides several methods to process input text. These
methods typically won't need to be overridden (and in some cases they
can't be overridden), but subclasses may want to invoke them to exploit
their functionality.

=cut

##---------------------------------------------------------------------------

=head1 B<parse_text()>

            $ptree1 = $parser->parse_text($text, $line_num);
            $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
            $ptree3 = $parser->parse_text(\%opts, $text, $line_num);

This method is useful if you need to perform your own interpolation 
of interior sequences and can't rely upon B<interpolate> to expand
them in simple bottom-up order order.

The parameter C<$text> is a string or block of text to be parsed
for interior sequences; and the parameter C<$line_num> is the
line number curresponding to the beginning of C<$text>.

B<parse_text()> will parse the given text into a parse-tree of "nodes."
and interior-sequences.  Each "node" in the parse tree is either a
text-string, or a B<Pod::InteriorSequence>.  The result returned is a
parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.

If desired, an optional hash-ref may be specified as the first argument
to customize certain aspects of the parse-tree that is created and
returned. The set of recognized option keywords are:

=over 3

=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>

Normally, the parse-tree returned by B<parse_text()> will contain an
unexpanded C<Pod::InteriorSequence> object for each interior-sequence
encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
every interior-sequence it sees by invoking the referenced function
(or named method of the parser object) and using the return value as the
expanded result.

If a subroutine reference was given, it is invoked as:

  &$code_ref( $parser, $sequence )

and if a method-name was given, it is invoked as:

  $parser->method_name( $sequence )

where C<$parser> is a reference to the parser object, and C<$sequence>
is a reference to the interior-sequence object.
[I<NOTE>: If the B<interior_sequence()> method is specified, then it is
invoked according to the interface specified in L<"interior_sequence()">].

=item B<-expand_text> =E<gt> I<code-ref>|I<method-name>

Normally, the parse-tree returned by B<parse_text()> will contain a
text-string for each contiguous sequence of characters outside of an
interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to
"preprocess" every such text-string it sees by invoking the referenced
function (or named method of the parser object) and using the return value
as the preprocessed (or "expanded") result. [Note that if the result is
an interior-sequence, then it will I<not> be expanded as specified by the
B<-expand_seq> option; Any such recursive expansion needs to be handled by
the specified callback routine.]

If a subroutine reference was given, it is invoked as:

  &$code_ref( $parser, $text, $ptree_node )

and if a method-name was given, it is invoked as:

  $parser->method_name( $text, $ptree_node )

where C<$parser> is a reference to the parser object, C<$text> is the
text-string encountered, and C<$ptree_node> is a reference to the current
node in the parse-tree (usually an interior-sequence object or else the
top-level node of the parse-tree).

=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>

Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
argument to the referenced subroutine (or named method of the parser
object) and return the result instead of the parse-tree object.

If a subroutine reference was given, it is invoked as:

  &$code_ref( $parser, $ptree )

and if a method-name was given, it is invoked as:

  $parser->method_name( $ptree )

where C<$parser> is a reference to the parser object, and C<$ptree>
is a reference to the parse-tree object.

=back

=cut

sub parse_text {
    my $self = shift;
    local $_ = '';

    ## Get options and set any defaults
    my %opts = (ref $_[0]) ? %{ shift() } : ();
    my $expand_seq   = $opts{'-expand_seq'}   || undef;
    my $expand_text  = $opts{'-expand_text'}  || undef;
    my $expand_ptree = $opts{'-expand_ptree'} || undef;

    my $text = shift;
    my $line = shift;
    my $file = $self->input_file();
    my $cmd  = "";

    ## Convert method calls into closures, for our convenience
    my $xseq_sub   = $expand_seq;
    my $xtext_sub  = $expand_text;
    my $xptree_sub = $expand_ptree;
    if (defined $expand_seq  and  $expand_seq eq 'interior_sequence') {
        ## If 'interior_sequence' is the method to use, we have to pass
        ## more than just the sequence object, we also need to pass the
        ## sequence name and text.
        $xseq_sub = sub {
            my ($self, $iseq) = @_;
            my $args = join("", $iseq->parse_tree->children);
            return  $self->interior_sequence($iseq->name, $args, $iseq);
        };
    }
    ref $xseq_sub    or  $xseq_sub   = sub { shift()->$expand_seq(@_) };
    ref $xtext_sub   or  $xtext_sub  = sub { shift()->$expand_text(@_) };
    ref $xptree_sub  or  $xptree_sub = sub { shift()->$expand_ptree(@_) };

    ## Keep track of the "current" interior sequence, and maintain a stack
    ## of "in progress" sequences.
    ##
    ## NOTE that we push our own "accumulator" at the very beginning of the
    ## stack. It's really a parse-tree, not a sequence; but it implements
    ## the methods we need so we can use it to gather-up all the sequences
    ## and strings we parse. Thus, by the end of our parsing, it should be
    ## the only thing left on our stack and all we have to do is return it!
    ##
    my $seq       = Pod::ParseTree->new();
    my @seq_stack = ($seq);
    my ($ldelim, $rdelim) = ('', '');

    ## Iterate over all sequence starts text (NOTE: split with
    ## capturing parens keeps the delimiters)
    $_ = $text;
    my @tokens = split /([A-Z]<(?:<+\s)?)/;
    while ( @tokens ) {
        $_ = shift @tokens;
        ## Look for the beginning of a sequence
        if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
            ## Push a new sequence onto the stack of those "in-progress"
            ($cmd, $ldelim) = ($1, $2);
            $seq = Pod::InteriorSequence->new(
                       -name   => $cmd,
                       -ldelim => $ldelim,  -rdelim => '',
                       -file   => $file,    -line   => $line
                   );
            $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
            (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
            push @seq_stack, $seq;
        }
        ## Look for sequence ending
        elsif ( @seq_stack > 1 ) {
            ## Make sure we match the right kind of closing delimiter
            my ($seq_end, $post_seq) = ("", "");
            if ( ($ldelim eq '<'   and  /\A(.*?)(>)/s)
                 or  /\A(.*?)(\s+$rdelim)/s )
            {
                ## Found end-of-sequence, capture the interior and the
                ## closing the delimiter, and put the rest back on the
                ## token-list
                $post_seq = substr($_, length($1) + length($2));
                ($_, $seq_end) = ($1, $2);
                (length $post_seq)  and  unshift @tokens, $post_seq;
            }
            if (length) {
                ## In the middle of a sequence, append this text to it, and
                ## dont forget to "expand" it if that's what the caller wanted
                $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
                $_ .= $seq_end;
            }
            if (length $seq_end) {
                ## End of current sequence, record terminating delimiter
                $seq->rdelim($seq_end);
                ## Pop it off the stack of "in progress" sequences
                pop @seq_stack;
                ## Append result to its parent in current parse tree
                $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
                                                   : $seq);
                ## Remember the current cmd-name and left-delimiter
                $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
                $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
                $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
            }
        }
        elsif (length) {
            ## In the middle of a sequence, append this text to it, and
            ## dont forget to "expand" it if that's what the caller wanted
            $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
        }
        ## Keep track of line count
        $line += tr/\n//;
        ## Remember the "current" sequence
        $seq = $seq_stack[-1];
    }

    ## Handle unterminated sequences
    my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
    while (@seq_stack > 1) {
       ($cmd, $file, $line) = ($seq->name, $seq->file_line);
       $ldelim  = $seq->ldelim;
       ($rdelim = $ldelim) =~ tr/</>/;
       $rdelim  =~ s/^(\S+)(\s*)$/$2$1/;
       pop @seq_stack;
       my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
                    " at line $line in file $file\n";
       (ref $errorsub) and &{$errorsub}($errmsg)
           or (defined $errorsub) and $self->$errorsub($errmsg)
               or  warn($errmsg);
       $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
       $seq = $seq_stack[-1];
    }

    ## Return the resulting parse-tree
    my $ptree = (pop @seq_stack)->parse_tree;
    return  $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
}

##---------------------------------------------------------------------------

=head1 B<interpolate()>

            $textblock = $parser->interpolate($text, $line_num);

This method translates all text (including any embedded interior sequences)
in the given text string C<$text> and returns the interpolated result. The
parameter C<$line_num> is the line number corresponding to the beginning
of C<$text>.

B<interpolate()> merely invokes a private method to recursively expand
nested interior sequences in bottom-up order (innermost sequences are
expanded first). If there is a need to expand nested sequences in
some alternate order, use B<parse_text> instead.

=cut

sub interpolate {
    my($self, $text, $line_num) = @_;
    my %parse_opts = ( -expand_seq => 'interior_sequence' );
    my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
    return  join "", $ptree->children();
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head1 B<parse_paragraph()>

            $parser->parse_paragraph($text, $line_num);

This method takes the text of a POD paragraph to be processed, along
with its corresponding line number, and invokes the appropriate method
(one of B<command()>, B<verbatim()>, or B<textblock()>).

For performance reasons, this method is invoked directly without any
dynamic lookup; Hence subclasses may I<not> override it!

=end __PRIVATE__

=cut

sub parse_paragraph {
    my ($self, $text, $line_num) = @_;
    local *myData = $self;  ## alias to avoid deref-ing overhead
    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
    local $_;

    ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
    my $wantNonPods = $myOpts{'-want_nonPODs'};

    ## Update cutting status
    $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;

    ## Perform any desired preprocessing if we wanted it this early
    $wantNonPods  and  $text = $self->preprocess_paragraph($text, $line_num);

    ## Ignore up until next POD directive if we are cutting
    return if $myData{_CUTTING};

    ## Now we know this is block of text in a POD section!

    ##-----------------------------------------------------------------
    ## This is a hook (hack ;-) for Pod::Select to do its thing without
    ## having to override methods, but also without Pod::Parser assuming
    ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
    ## field exists then we assume there is an is_selected() method for
    ## us to invoke (calling $self->can('is_selected') could verify this
    ## but that is more overhead than I want to incur)
    ##-----------------------------------------------------------------

    ## Ignore this block if it isnt in one of the selected sections
    if (exists $myData{_SELECTED_SECTIONS}) {
        $self->is_selected($text)  or  return ($myData{_CUTTING} = 1);
    }

    ## If we havent already, perform any desired preprocessing and
    ## then re-check the "cutting" state
    unless ($wantNonPods) {
       $text = $self->preprocess_paragraph($text, $line_num);
       return 1  unless ((defined $text) and (length $text));
       return 1  if ($myData{_CUTTING});
    }

    ## Look for one of the three types of paragraphs
    my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
    my $pod_para = undef;
    if ($text =~ /^(={1,2})(?=\S)/) {
        ## Looks like a command paragraph. Capture the command prefix used
        ## ("=" or "=="), as well as the command-name, its paragraph text,
        ## and whatever sequence of characters was used to separate them
        $pfx = $1;
        $_ = substr($text, length $pfx);
        ($cmd, $sep, $text) = split /(\s+)/, $_, 2; 
        ## If this is a "cut" directive then we dont need to do anything
        ## except return to "cutting" mode.
        if ($cmd eq 'cut') {
           $myData{_CUTTING} = 1;
           return  unless $myOpts{'-process_cut_cmd'};
        }
    }
    ## Save the attributes indicating how the command was specified.
    $pod_para = new Pod::Paragraph(
          -name      => $cmd,
          -text      => $text,
          -prefix    => $pfx,
          -separator => $sep,
          -file      => $myData{_INFILE},
          -line      => $line_num
    );
    # ## Invoke appropriate callbacks
    # if (exists $myData{_CALLBACKS}) {
    #    ## Look through the callback list, invoke callbacks,
    #    ## then see if we need to do the default actions
    #    ## (invoke_callbacks will return true if we do).
    #    return  1  unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
    # }
    if (length $cmd) {
        ## A command paragraph
        $self->command($cmd, $text, $line_num, $pod_para);
    }
    elsif ($text =~ /^\s+/) {
        ## Indented text - must be a verbatim paragraph
        $self->verbatim($text, $line_num, $pod_para);
    }
    else {
        ## Looks like an ordinary block of text
        $self->textblock($text, $line_num, $pod_para);
    }
    return  1;
}

##---------------------------------------------------------------------------

=head1 B<parse_from_filehandle()>

            $parser->parse_from_filehandle($in_fh,$out_fh);

This method takes an input filehandle (which is assumed to already be
opened for reading) and reads the entire input stream looking for blocks
(paragraphs) of POD documentation to be processed. If no first argument
is given the default input filehandle C<STDIN> is used.

The C<$in_fh> parameter may be any object that provides a B<getline()>
method to retrieve a single line of input text (hence, an appropriate
wrapper object could be used to parse PODs from a single string or an
array of strings).

Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
into paragraphs or "blocks" (which are separated by lines containing
nothing but whitespace). For each block of POD documentation
encountered it will invoke a method to parse the given paragraph.

If a second argument is given then it should correspond to a filehandle where
output should be sent (otherwise the default output filehandle is
C<STDOUT> if no output filehandle is currently in use).

B<NOTE:> For performance reasons, this method caches the input stream at
the top of the stack in a local variable. Any attempts by clients to
change the stack contents during processing when in the midst executing
of this method I<will not affect> the input stream used by the current
invocation of this method.

This method does I<not> usually need to be overridden by subclasses.

=cut

sub parse_from_filehandle {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
    my ($in_fh, $out_fh) = @_;
    $in_fh = \*STDIN  unless ($in_fh);
    local *myData = $self;  ## alias to avoid deref-ing overhead
    local *myOpts = ($myData{_PARSEOPTS} ||= {});  ## get parse-options
    local $_;

    ## Put this stream at the top of the stack and do beginning-of-input
    ## processing. NOTE that $in_fh might be reset during this process.
    my $topstream = $self->_push_input_stream($in_fh, $out_fh);
    (exists $opts{-cutting})  and  $self->cutting( $opts{-cutting} );

    ## Initialize line/paragraph
    my ($textline, $paragraph) = ('', '');
    my ($nlines, $plines) = (0, 0);

    ## Use <$fh> instead of $fh->getline where possible (for speed)
    $_ = ref $in_fh;
    my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/  or  tied $in_fh);

    ## Read paragraphs line-by-line
    while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
        $textline = $self->preprocess_line($textline, ++$nlines);
        next  unless ((defined $textline)  &&  (length $textline));
        $_ = $paragraph;  ## save previous contents

        if ((! length $paragraph) && ($textline =~ /^==/)) {
            ## '==' denotes a one-line command paragraph
            $paragraph = $textline;
            $plines    = 1;
            $textline  = '';
        } else {
            ## Append this line to the current paragraph
            $paragraph .= $textline;
            ++$plines;
        }

        ## See if this line is blank and ends the current paragraph.
        ## If it isnt, then keep iterating until it is.
        next unless (($textline =~ /^([^\S\r\n]*)[\r\n]*$/)
                                     && (length $paragraph));

        ## Issue a warning about any non-empty blank lines
        if (length($1) > 0 and $myOpts{'-warnings'} and ! $myData{_CUTTING}) {
            my $errorsub = $self->errorsub();
            my $file = $self->input_file();
            my $errmsg = "*** WARNING: line containing nothing but whitespace".
                         " in paragraph at line $nlines in file $file\n";
            (ref $errorsub) and &{$errorsub}($errmsg)
                or (defined $errorsub) and $self->$errorsub($errmsg)
                    or  warn($errmsg);
        }

        ## Now process the paragraph
        parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
        $paragraph = '';
        $plines = 0;
    }
    ## Dont forget about the last paragraph in the file
    if (length $paragraph) {
       parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
    }

    ## Now pop the input stream off the top of the input stack.
    $self->_pop_input_stream();
}

##---------------------------------------------------------------------------

=head1 B<parse_from_file()>

            $parser->parse_from_file($filename,$outfile);

This method takes a filename and does the following:

=over 2

=item *

opens the input and output files for reading
(creating the appropriate filehandles)

=item *

invokes the B<parse_from_filehandle()> method passing it the
corresponding input and output filehandles.

=item *

closes the input and output files.

=back

If the special input filename "-" or "<&STDIN" is given then the STDIN
filehandle is used for input (and no open or close is performed). If no
input filename is specified then "-" is implied.

If a second argument is given then it should be the name of the desired
output file. If the special output filename "-" or ">&STDOUT" is given
then the STDOUT filehandle is used for output (and no open or close is
performed). If the special output filename ">&STDERR" is given then the
STDERR filehandle is used for output (and no open or close is
performed). If no output filehandle is currently in use and no output
filename is specified, then "-" is implied.

This method does I<not> usually need to be overridden by subclasses.

=cut

sub parse_from_file {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
    my ($infile, $outfile) = @_;
    my ($in_fh,  $out_fh) = (gensym, gensym)  if ($] < 5.6);
    my ($close_input, $close_output) = (0, 0);
    local *myData = $self;
    local $_;

    ## Is $infile a filename or a (possibly implied) filehandle
    $infile  = '-'  unless ((defined $infile)  && (length $infile));
    if (($infile  eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
        ## Not a filename, just a string implying STDIN
        $myData{_INFILE} = "<standard input>";
        $in_fh = \*STDIN;
    }
    elsif (ref $infile) {
        ## Must be a filehandle-ref (or else assume its a ref to an object
        ## that supports the common IO read operations).
        $myData{_INFILE} = ${$infile};
        $in_fh = $infile;
    }
    else {
        ## We have a filename, open it for reading
        $myData{_INFILE} = $infile;
        open($in_fh, "< $infile")  or
             croak "Can't open $infile for reading: $!\n";
        $close_input = 1;
    }

    ## NOTE: we need to be *very* careful when "defaulting" the output
    ## file. We only want to use a default if this is the beginning of
    ## the entire document (but *not* if this is an included file). We
    ## determine this by seeing if the input stream stack has been set-up
    ## already
    ## 
    unless ((defined $outfile) && (length $outfile)) {
        (defined $myData{_TOP_STREAM}) && ($out_fh  = $myData{_OUTPUT})
                                       || ($outfile = '-');
    }
    ## Is $outfile a filename or a (possibly implied) filehandle
    if ((defined $outfile) && (length $outfile)) {
        if (($outfile  eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
            ## Not a filename, just a string implying STDOUT
            $myData{_OUTFILE} = "<standard output>";
            $out_fh  = \*STDOUT;
        }
        elsif ($outfile =~ /^>&(STDERR|2)$/i) {
            ## Not a filename, just a string implying STDERR
            $myData{_OUTFILE} = "<standard error>";
            $out_fh  = \*STDERR;
        }
        elsif (ref $outfile) {
            ## Must be a filehandle-ref (or else assume its a ref to an
            ## object that supports the common IO write operations).
            $myData{_OUTFILE} = ${$outfile};
            $out_fh = $outfile;
        }
        else {
            ## We have a filename, open it for writing
            $myData{_OUTFILE} = $outfile;
            (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
            open($out_fh, "> $outfile")  or
                 croak "Can't open $outfile for writing: $!\n";
            $close_output = 1;
        }
    }

    ## Whew! That was a lot of work to set up reasonably/robust behavior
    ## in the case of a non-filename for reading and writing. Now we just
    ## have to parse the input and close the handles when we're finished.
    $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);

    $close_input  and 
        close($in_fh) || croak "Can't close $infile after reading: $!\n";
    $close_output  and
        close($out_fh) || croak "Can't close $outfile after writing: $!\n";
}

#############################################################################

=head1 ACCESSOR METHODS

Clients of B<Pod::Parser> should use the following methods to access
instance data fields:

=cut

##---------------------------------------------------------------------------

=head1 B<errorsub()>

            $parser->errorsub("method_name");
            $parser->errorsub(\&warn_user);
            $parser->errorsub(sub { print STDERR, @_ });

Specifies the method or subroutine to use when printing error messages
about POD syntax. The supplied method/subroutine I<must> return TRUE upon
successful printing of the message. If C<undef> is given, then the B<warn>
builtin is used to issue error messages (this is the default behavior).

            my $errorsub = $parser->errorsub()
            my $errmsg = "This is an error message!\n"
            (ref $errorsub) and &{$errorsub}($errmsg)
                or (defined $errorsub) and $parser->$errorsub($errmsg)
                    or  warn($errmsg);

Returns a method name, or else a reference to the user-supplied subroutine
used to print error messages. Returns C<undef> if the B<warn> builtin
is used to issue error messages (this is the default behavior).

=cut

sub errorsub {
   return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};
}

##---------------------------------------------------------------------------

=head1 B<cutting()>

            $boolean = $parser->cutting();

Returns the current C<cutting> state: a boolean-valued scalar which
evaluates to true if text from the input file is currently being "cut"
(meaning it is I<not> considered part of the POD document).

            $parser->cutting($boolean);

Sets the current C<cutting> state to the given value and returns the
result.

=cut

sub cutting {
   return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
}

##---------------------------------------------------------------------------

##---------------------------------------------------------------------------

=head1 B<parseopts()>

When invoked with no additional arguments, B<parseopts> returns a hashtable
of all the current parsing options.

            ## See if we are parsing non-POD sections as well as POD ones
            my %opts = $parser->parseopts();
            $opts{'-want_nonPODs}' and print "-want_nonPODs\n";

When invoked using a single string, B<parseopts> treats the string as the
name of a parse-option and returns its corresponding value if it exists
(returns C<undef> if it doesn't).

            ## Did we ask to see '=cut' paragraphs?
            my $want_cut = $parser->parseopts('-process_cut_cmd');
            $want_cut and print "-process_cut_cmd\n";

When invoked with multiple arguments, B<parseopts> treats them as
key/value pairs and the specified parse-option names are set to the
given values. Any unspecified parse-options are unaffected.

            ## Set them back to the default
            $parser->parseopts(-warnings => 0);

When passed a single hash-ref, B<parseopts> uses that hash to completely
reset the existing parse-options, all previous parse-option values
are lost.

            ## Reset all options to default 
            $parser->parseopts( { } );

See L<"PARSING OPTIONS"> for more information on the name and meaning of each
parse-option currently recognized.

=cut

sub parseopts {
   local *myData = shift;
   local *myOpts = ($myData{_PARSEOPTS} ||= {});
   return %myOpts  if (@_ == 0);
   if (@_ == 1) {
      local $_ = shift;
      return  ref($_)  ?  $myData{_PARSEOPTS} = $_  :  $myOpts{$_};
   }
   my @newOpts = (%myOpts, @_);
   $myData{_PARSEOPTS} = { @newOpts };
}

##---------------------------------------------------------------------------

=head1 B<output_file()>

            $fname = $parser->output_file();

Returns the name of the output file being written.

=cut

sub output_file {
   return $_[0]->{_OUTFILE};
}

##---------------------------------------------------------------------------

=head1 B<output_handle()>

            $fhandle = $parser->output_handle();

Returns the output filehandle object.

=cut

sub output_handle {
   return $_[0]->{_OUTPUT};
}

##---------------------------------------------------------------------------

=head1 B<input_file()>

            $fname = $parser->input_file();

Returns the name of the input file being read.

=cut

sub input_file {
   return $_[0]->{_INFILE};
}

##---------------------------------------------------------------------------

=head1 B<input_handle()>

            $fhandle = $parser->input_handle();

Returns the current input filehandle object.

=cut

sub input_handle {
   return $_[0]->{_INPUT};
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head1 B<input_streams()>

            $listref = $parser->input_streams();

Returns a reference to an array which corresponds to the stack of all
the input streams that are currently in the middle of being parsed.

While parsing an input stream, it is possible to invoke
B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
stream and then return to parsing the previous input stream. Each input
stream to be parsed is pushed onto the end of this input stack
before any of its input is read. The input stream that is currently
being parsed is always at the end (or top) of the input stack. When an
input stream has been exhausted, it is popped off the end of the
input stack.

Each element on this input stack is a reference to C<Pod::InputSource>
object. Please see L<Pod::InputObjects> for more details.

This method might be invoked when printing diagnostic messages, for example,
to obtain the name and line number of the all input files that are currently
being processed.

=end __PRIVATE__

=cut

sub input_streams {
   return $_[0]->{_INPUT_STREAMS};
}

##---------------------------------------------------------------------------

=begin __PRIVATE__

=head1 B<top_stream()>

            $hashref = $parser->top_stream();

Returns a reference to the hash-table that represents the element
that is currently at the top (end) of the input stream stack
(see L<"input_streams()">). The return value will be the C<undef>
if the input stack is empty.

This method might be used when printing diagnostic messages, for example,
to obtain the name and line number of the current input file.

=end __PRIVATE__

=cut

sub top_stream {
   return $_[0]->{_TOP_STREAM} || undef;
}

#############################################################################

=head1 PRIVATE METHODS AND DATA

B<Pod::Parser> makes use of several internal methods and data fields
which clients should not need to see or use. For the sake of avoiding
name collisions for client data and methods, these methods and fields
are briefly discussed here. Determined hackers may obtain further
information about them by reading the B<Pod::Parser> source code.

Private data fields are stored in the hash-object whose reference is
returned by the B<new()> constructor for this class. The names of all
private methods and data-fields used by B<Pod::Parser> begin with a
prefix of "_" and match the regular expression C</^_\w+$/>.

=cut

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head1 B<_push_input_stream()>

            $hashref = $parser->_push_input_stream($in_fh,$out_fh);

This method will push the given input stream on the input stack and
perform any necessary beginning-of-document or beginning-of-file
processing. The argument C<$in_fh> is the input stream filehandle to
push, and C<$out_fh> is the corresponding output filehandle to use (if
it is not given or is undefined, then the current output stream is used,
which defaults to standard output if it doesnt exist yet).

The value returned will be reference to the hash-table that represents
the new top of the input stream stack. I<Please Note> that it is
possible for this method to use default values for the input and output
file handles. If this happens, you will need to look at the C<INPUT>
and C<OUTPUT> instance data members to determine their new values.

=end _PRIVATE_

=cut

sub _push_input_stream {
    my ($self, $in_fh, $out_fh) = @_;
    local *myData = $self;

    ## Initialize stuff for the entire document if this is *not*
    ## an included file.
    ##
    ## NOTE: we need to be *very* careful when "defaulting" the output
    ## filehandle. We only want to use a default value if this is the
    ## beginning of the entire document (but *not* if this is an included
    ## file).
    unless (defined  $myData{_TOP_STREAM}) {
        $out_fh  = \*STDOUT  unless (defined $out_fh);
        $myData{_CUTTING}       = 1;   ## current "cutting" state
        $myData{_INPUT_STREAMS} = [];  ## stack of all input streams
    }

    ## Initialize input indicators
    $myData{_OUTFILE} = '(unknown)'  unless (defined  $myData{_OUTFILE});
    $myData{_OUTPUT}  = $out_fh      if (defined  $out_fh);
    $in_fh            = \*STDIN      unless (defined  $in_fh);
    $myData{_INFILE}  = '(unknown)'  unless (defined  $myData{_INFILE});
    $myData{_INPUT}   = $in_fh;
    my $input_top     = $myData{_TOP_STREAM}
                      = new Pod::InputSource(
                            -name        => $myData{_INFILE},
                            -handle      => $in_fh,
                            -was_cutting => $myData{_CUTTING}
                        );
    local *input_stack = $myData{_INPUT_STREAMS};
    push(@input_stack, $input_top);

    ## Perform beginning-of-document and/or beginning-of-input processing
    $self->begin_pod()  if (@input_stack == 1);
    $self->begin_input();

    return  $input_top;
}

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head1 B<_pop_input_stream()>

            $hashref = $parser->_pop_input_stream();

This takes no arguments. It will perform any necessary end-of-file or
end-of-document processing and then pop the current input stream from
the top of the input stack.

The value returned will be reference to the hash-table that represents
the new top of the input stream stack.

=end _PRIVATE_

=cut

sub _pop_input_stream {
    my ($self) = @_;
    local *myData = $self;
    local *input_stack = $myData{_INPUT_STREAMS};

    ## Perform end-of-input and/or end-of-document processing
    $self->end_input()  if (@input_stack > 0);
    $self->end_pod()    if (@input_stack == 1);

    ## Restore cutting state to whatever it was before we started
    ## parsing this file.
    my $old_top = pop(@input_stack);
    $myData{_CUTTING} = $old_top->was_cutting();

    ## Dont forget to reset the input indicators
    my $input_top = undef;
    if (@input_stack > 0) {
       $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
       $myData{_INFILE}  = $input_top->name();
       $myData{_INPUT}   = $input_top->handle();
    } else {
       delete $myData{_TOP_STREAM};
       delete $myData{_INPUT_STREAMS};
    }

    return  $input_top;
}

#############################################################################

=head1 TREE-BASED PARSING

If straightforward stream-based parsing wont meet your needs (as is
likely the case for tasks such as translating PODs into structured
markup languages like HTML and XML) then you may need to take the
tree-based approach. Rather than doing everything in one pass and
calling the B<interpolate()> method to expand sequences into text, it
may be desirable to instead create a parse-tree using the B<parse_text()>
method to return a tree-like structure which may contain an ordered list
list of children (each of which may be a text-string, or a similar
tree-like structure).

Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and
to the objects described in L<Pod::InputObjects>. The former describes
the gory details and parameters for how to customize and extend the
parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides
several objects that may all be used interchangeably as parse-trees. The
most obvious one is the B<Pod::ParseTree> object. It defines the basic
interface and functionality that all things trying to be a POD parse-tree
should do. A B<Pod::ParseTree> is defined such that each "node" may be a
text-string, or a reference to another parse-tree.  Each B<Pod::Paragraph>
object and each B<Pod::InteriorSequence> object also supports the basic
parse-tree interface.

The B<parse_text()> method takes a given paragraph of text, and
returns a parse-tree that contains one or more children, each of which
may be a text-string, or an InteriorSequence object. There are also
callback-options that may be passed to B<parse_text()> to customize
the way it expands or transforms interior-sequences, as well as the
returned result. These callbacks can be used to create a parse-tree
with custom-made objects (which may or may not support the parse-tree
interface, depending on how you choose to do it).

If you wish to turn an entire POD document into a parse-tree, that process
is fairly straightforward. The B<parse_text()> method is the key to doing
this successfully. Every paragraph-callback (i.e. the polymorphic methods
for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes
a B<Pod::Paragraph> object as an argument. Each paragraph object has a
B<parse_tree()> method that can be used to get or set a corresponding
parse-tree. So for each of those paragraph-callback methods, simply call
B<parse_text()> with the options you desire, and then use the returned
parse-tree to assign to the given paragraph object.

That gives you a parse-tree for each paragraph - so now all you need is
an ordered list of paragraphs. You can maintain that yourself as a data
element in the object/hash. The most straightforward way would be simply
to use an array-ref, with the desired set of custom "options" for each
invocation of B<parse_text>. Let's assume the desired option-set is
given by the hash C<%options>. Then we might do something like the
following:

    package MyPodParserTree;

    @ISA = qw( Pod::Parser );

    ...

    sub begin_pod {
        my $self = shift;
        $self->{'-paragraphs'} = [];  ## initialize paragraph list
    }

    sub command { 
        my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
        my $ptree = $parser->parse_text({%options}, $paragraph, ...);
        $pod_para->parse_tree( $ptree );
        push @{ $self->{'-paragraphs'} }, $pod_para;
    }

    sub verbatim { 
        my ($parser, $paragraph, $line_num, $pod_para) = @_;
        push @{ $self->{'-paragraphs'} }, $pod_para;
    }

    sub textblock { 
        my ($parser, $paragraph, $line_num, $pod_para) = @_;
        my $ptree = $parser->parse_text({%options}, $paragraph, ...);
        $pod_para->parse_tree( $ptree );
        push @{ $self->{'-paragraphs'} }, $pod_para;
    }

    ...

    package main;
    ...
    my $parser = new MyPodParserTree(...);
    $parser->parse_from_file(...);
    my $paragraphs_ref = $parser->{'-paragraphs'};

Of course, in this module-author's humble opinion, I'd be more inclined to
use the existing B<Pod::ParseTree> object than a simple array. That way
everything in it, paragraphs and sequences, all respond to the same core
interface for all parse-tree nodes. The result would look something like:

    package MyPodParserTree2;

    ...

    sub begin_pod {
        my $self = shift;
        $self->{'-ptree'} = new Pod::ParseTree;  ## initialize parse-tree
    }

    sub parse_tree {
        ## convenience method to get/set the parse-tree for the entire POD
        (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];
        return $_[0]->{'-ptree'};
    }

    sub command { 
        my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
        my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
        $pod_para->parse_tree( $ptree );
        $parser->parse_tree()->append( $pod_para );
    }

    sub verbatim { 
        my ($parser, $paragraph, $line_num, $pod_para) = @_;
        $parser->parse_tree()->append( $pod_para );
    }

    sub textblock { 
        my ($parser, $paragraph, $line_num, $pod_para) = @_;
        my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
        $pod_para->parse_tree( $ptree );
        $parser->parse_tree()->append( $pod_para );
    }

    ...

    package main;
    ...
    my $parser = new MyPodParserTree2(...);
    $parser->parse_from_file(...);
    my $ptree = $parser->parse_tree;
    ...

Now you have the entire POD document as one great big parse-tree. You
can even use the B<-expand_seq> option to B<parse_text> to insert
whole different kinds of objects. Just don't expect B<Pod::Parser>
to know what to do with them after that. That will need to be in your
code. Or, alternatively, you can insert any object you like so long as
it conforms to the B<Pod::ParseTree> interface.

One could use this to create subclasses of B<Pod::Paragraphs> and
B<Pod::InteriorSequences> for specific commands (or to create your own
custom node-types in the parse-tree) and add some kind of B<emit()>
method to each custom node/subclass object in the tree. Then all you'd
need to do is recursively walk the tree in the desired order, processing
the children (most likely from left to right) by formatting them if
they are text-strings, or by calling their B<emit()> method if they
are objects/references.

=head1 SEE ALSO

L<Pod::InputObjects>, L<Pod::Select>

B<Pod::InputObjects> defines POD input objects corresponding to
command paragraphs, parse-trees, and interior-sequences.

B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
to selectively include and/or exclude sections of a POD document from being
translated based upon the current heading, subheading, subsubheading, etc.

=for __PRIVATE__
B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
the ability the employ I<callback functions> instead of, or in addition
to, overriding methods of the base class.

=for __PRIVATE__
B<Pod::Select> and B<Pod::Callbacks> do not override any
methods nor do they define any new methods with the same name. Because
of this, they may I<both> be used (in combination) as a base class of
the same subclass in order to combine their functionality without
causing any namespace clashes due to multiple inheritance.

=head1 AUTHOR

Brad Appleton E<lt>bradapp@enteract.comE<gt>

Based on code for B<Pod::Text> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>

=cut

1;
OR ()	     {25}; # End of Record
sub TELOPT_TUID ()	     {26}; # TACACS User Identification
sub TELOPT_OUTMRK ()	     {27}; # Output Marking
sub TELOPT_TTYLOC ()	     {28}; # Terminal Location Number
sub TELOPT_3270REGIME ()     {29}; # Telnet 3270 Regime
sub TELOPT_X3PAD ()	     {30}; # X.3 PAD
sub TELOPT_NAWS ()	     {31};                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 #############################################################################
# Pod/ParseUtils.pm -- helpers for POD parsing and conversion
#
# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::ParseUtils;

use vars qw($VERSION);
$VERSION = 0.22;   ## Current version of this package
require  5.005;    ## requires this Perl version or later

=head1 NAME

Pod::ParseUtils - helpers for POD parsing and conversion

=head1 SYNOPSIS

  use Pod::ParseUtils;

  my $list = new Pod::List;
  my $link = Pod::Hyperlink->new('Pod::Parser');

=head1 DESCRIPTION

B<Pod::ParseUtils> contains a few object-oriented helper packages for
POD parsing and processing (i.e. in POD formatters and translators).

=cut

#-----------------------------------------------------------------------------
# Pod::List
#
# class to hold POD list info (=over, =item, =back)
#-----------------------------------------------------------------------------

package Pod::List;

use Carp;

=head2 Pod::List

B<Pod::List> can be used to hold information about POD lists
(written as =over ... =item ... =back) for further processing.
The following methods are available:

=over 4

=item Pod::List-E<gt>new()

Create a new list object. Properties may be specified through a hash
reference like this:

  my $list = Pod::List->new({ -start => $., -indent => 4 });

See the individual methods/properties for details.

=cut

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    $self->initialize();
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-file} ||= 'unknown';
    $self->{-start} ||= 'unknown';
    $self->{-indent} ||= 4; # perlpod: "should be the default"
    $self->{_items} = [];
    $self->{-type} ||= '';
}

=item $list-E<gt>file()

Without argument, retrieves the file name the list is in. This must
have been set before by either specifying B<-file> in the B<new()>
method or by calling the B<file()> method with a scalar argument.

=cut

# The POD file name the list appears in
sub file {
   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}

=item $list-E<gt>start()

Without argument, retrieves the line number where the list started.
This must have been set before by either specifying B<-start> in the
B<new()> method or by calling the B<start()> method with a scalar
argument.

=cut

# The line in the file the node appears
sub start {
   return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
}

=item $list-E<gt>indent()

Without argument, retrieves the indent level of the list as specified
in C<=over n>. This must have been set before by either specifying
B<-indent> in the B<new()> method or by calling the B<indent()> method
with a scalar argument.

=cut

# indent level
sub indent {
   return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
}

=item $list-E<gt>type()

Without argument, retrieves the list type, which can be an arbitrary value,
e.g. C<OL>, C<UL>, ... when thinking the HTML way.
This must have been set before by either specifying
B<-type> in the B<new()> method or by calling the B<type()> method
with a scalar argument.

=cut

# The type of the list (UL, OL, ...)
sub type {
   return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}

=item $list-E<gt>rx()

Without argument, retrieves a regular expression for simplifying the 
individual item strings once the list type has been determined. Usage:
E.g. when converting to HTML, one might strip the leading number in
an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
This must have been set before by either specifying
B<-rx> in the B<new()> method or by calling the B<rx()> method
with a scalar argument.

=cut

# The regular expression to simplify the items
sub rx {
   return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
}

=item $list-E<gt>item()

Without argument, retrieves the array of the items in this list.
The items may be represented by any scalar.
If an argument has been given, it is pushed on the list of items.

=cut

# The individual =items of this list
sub item {
    my ($self,$item) = @_;
    if(defined $item) {
        push(@{$self->{_items}}, $item);
        return $item;
    }
    else {
        return @{$self->{_items}};
    }
}

=item $list-E<gt>parent()

Without argument, retrieves information about the parent holding this
list, which is represented as an arbitrary scalar.
This must have been set before by either specifying
B<-parent> in the B<new()> method or by calling the B<parent()> method
with a scalar argument.

=cut

# possibility for parsers/translators to store information about the
# lists's parent object
sub parent {
   return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
}

=item $list-E<gt>tag()

Without argument, retrieves information about the list tag, which can be
any scalar.
This must have been set before by either specifying
B<-tag> in the B<new()> method or by calling the B<tag()> method
with a scalar argument.

=back

=cut

# possibility for parsers/translators to store information about the
# list's object
sub tag {
   return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
}

#-----------------------------------------------------------------------------
# Pod::Hyperlink
#
# class to manipulate POD hyperlinks (L<>)
#-----------------------------------------------------------------------------

package Pod::Hyperlink;

=head2 Pod::Hyperlink

B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:

  my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');

The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
different parts of a POD hyperlink for further processing. It can also be
used to construct hyperlinks.

=over 4

=item Pod::Hyperlink-E<gt>new()

The B<new()> method can either be passed a set of key/value pairs or a single
scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
failure, the error message is stored in C<$@>.

=cut

use Carp;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = +{};
    bless $self, $class;
    $self->initialize();
    if(defined $_[0]) {
        if(ref($_[0])) {
            # called with a list of parameters
            %$self = %{$_[0]};
            $self->_construct_text();
        }
        else {
            # called with L<> contents
            return undef unless($self->parse($_[0]));
        }
    }
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-line} ||= 'undef';
    $self->{-file} ||= 'undef';
    $self->{-page} ||= '';
    $self->{-node} ||= '';
    $self->{-alttext} ||= '';
    $self->{-type} ||= 'undef';
    $self->{_warnings} = [];
}

=item $link-E<gt>parse($string)

This method can be used to (re)parse a (new) hyperlink, i.e. the contents
of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
Warnings are stored in the B<warnings> property.
E.g. sections like C<LE<lt>open(2)E<gt>> are deprected, as they do not point
to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
section can simply be dropped.

=cut

sub parse {
    my $self = shift;
    local($_) = $_[0];
    # syntax check the link and extract destination
    my ($alttext,$page,$node,$type) = (undef,'','','');

    $self->{_warnings} = [];

    # collapse newlines with whitespace
    s/\s*\n+\s*/ /g;

    # strip leading/trailing whitespace
    if(s/^[\s\n]+//) {
        $self->warning("ignoring leading whitespace in link");
    }
    if(s/[\s\n]+$//) {
        $self->warning("ignoring trailing whitespace in link");
    }
    unless(length($_)) {
        _invalid_link("empty link");
        return undef;
    }

    ## Check for different possibilities. This is tedious and error-prone
    # we match all possibilities (alttext, page, section/item)
    #warn "DEBUG: link=$_\n";

    # only page
    # problem: a lot of people use (), or (1) or the like to indicate
    # man page sections. But this collides with L<func()> that is supposed
    # to point to an internal funtion...
    my $page_rx = '[\w.]+(?:::[\w.]+)*(?:[(](?:\d\w*|)[)]|)';
    # page name only
    if(m!^($page_rx)$!o) {
        $page = $1;
        $type = 'page';
    }
    # alttext, page and "section"
    elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) {
        ($alttext, $page, $node) = ($1, $2, $3);
        $type = 'section';
    }
    # alttext and page
    elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) {
        ($alttext, $page) = ($1, $2);
        $type = 'page';
    }
    # alttext and "section"
    elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
        ($alttext, $node) = ($1,$2);
        $type = 'section';
    }
    # page and "section"
    elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
        ($page, $node) = ($1, $2);
        $type = 'section';
    }
    # page and item
    elsif(m!^($page_rx)\s*/\s*(.+)$!o) {
        ($page, $node) = ($1, $2);
        $type = 'item';
    }
    # only "section"
    elsif(m!^/?"(.+)"$!) {
        $node = $1;
        $type = 'section';
    }
    # only item
    elsif(m!^\s*/(.+)$!) {
        $node = $1;
        $type = 'item';
    }
    # non-standard: Hyperlink
    elsif(m!^((?:http|ftp|mailto|news):.+)$!i) {
        $node = $1;
        $type = 'hyperlink';
    }
    # alttext, page and item
    elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) {
        ($alttext, $page, $node) = ($1, $2, $3);
        $type = 'item';
    }
    # alttext and item
    elsif(m!^(.*?)\s*[|]\s*/(.+)$!) {
        ($alttext, $node) = ($1,$2);
    }
    # nonstandard: alttext and hyperlink
    elsif(m!^(.*?)\s*[|]\s*((?:http|ftp|mailto|news):.+)$!) {
        ($alttext, $node) = ($1,$2);
        $type = 'hyperlink';
    }
    # must be an item or a "malformed" section (without "")
    else {
        $node = $_;
        $type = 'item';
    }
    # collapse whitespace in nodes
    $node =~ s/\s+/ /gs;

    # empty alternative text expands to node name
    if(defined $alttext) {
        if(!length($alttext)) {
          $alttext = $node | $page;
        }
    }
    else {
        $alttext = '';
    }

    if($page =~ /[(]\w*[)]$/) {
        $self->warning("(section) in '$page' deprecated");
    }
    if($node =~ m:[|/]:) {
        $self->warning("node '$node' contains non-escaped | or /");
    }
    if($alttext =~ m:[|/]:) {
        $self->warning("alternative text '$node' contains non-escaped | or /");
    }
    $self->{-page} = $page;
    $self->{-node} = $node;
    $self->{-alttext} = $alttext;
    #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
    $self->{-type} = $type;
    $self->_construct_text();
    1;
}

sub _construct_text {
    my $self = shift;
    my $alttext = $self->alttext();
    my $type = $self->type();
    my $section = $self->node();
    my $page = $self->page();
    my $page_ext = '';
    $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
    if($alttext) {
        $self->{_text} = $alttext;
    }
    elsif($type eq 'hyperlink') {
        $self->{_text} = $section;
    }
    else {
        $self->{_text} = (!$section ? '' : 
            $type eq 'item' ? "the $section entry" :
                "the section on $section" ) .
            ($page ? ($section ? ' in ':'') . "the $page$page_ext manpage" :
                ' elsewhere in this document');
    }
    # for being marked up later
    # use the non-standard markers P<> and Q<>, so that the resulting
    # text can be parsed by the translators. It's their job to put
    # the correct hypertext around the linktext
    if($alttext) {
        $self->{_markup} = "Q<$alttext>";
    }
    elsif($type eq 'hyperlink') {
        $self->{_markup} = "Q<$section>";
    }
    else {
        $self->{_markup} = (!$section ? '' : 
            $type eq 'item' ? "the Q<$section> entry" :
                "the section on Q<$section>" ) .
            ($page ? ($section ? ' in ':'') . "the P<$page>$page_ext manpage" :
                ' elsewhere in this document');
    }
}

=item $link-E<gt>markup($string)

Set/retrieve the textual value of the link. This string contains special
markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
translator's interior sequence expansion engine to the
formatter-specific code to highlight/activate the hyperlink. The details
have to be implemented in the translator.

=cut

#' retrieve/set markuped text
sub markup {
    return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
}

=item $link-E<gt>text()

This method returns the textual representation of the hyperlink as above,
but without markers (read only). Depending on the link type this is one of
the following alternatives (the + and * denote the portions of the text
that are marked up):

  the +perl+ manpage
  the *$|* entry in the +perlvar+ manpage
  the section on *OPTIONS* in the +perldoc+ manpage
  the section on *DESCRIPTION* elsewhere in this document

=cut

# The complete link's text
sub text {
    $_[0]->{_text};
}

=item $link-E<gt>warning()

After parsing, this method returns any warnings encountered during the
parsing process.

=cut

# Set/retrieve warnings
sub warning {
    my $self = shift;
    if(@_) {
        push(@{$self->{_warnings}}, @_);
        return @_;
    }
    return @{$self->{_warnings}};
}

=item $link-E<gt>file()

=item $link-E<gt>line()

Just simple slots for storing information about the line and the file
the link was encountered in. Has to be filled in manually.

=cut

# The line in the file the link appears
sub line {
    return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
}

# The POD file name the link appears in
sub file {
    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}

=item $link-E<gt>page()

This method sets or returns the POD page this link points to.

=cut

# The POD page the link appears on
sub page {
    if (@_ > 1) {
        $_[0]->{-page} = $_[1];
        $_[0]->_construct_text();
    }
    $_[0]->{-page};
}

=item $link-E<gt>node()

As above, but the destination node text of the link.

=cut

# The link destination
sub node {
    if (@_ > 1) {
        $_[0]->{-node} = $_[1];
        $_[0]->_construct_text();
    }
    $_[0]->{-node};
}

=item $link-E<gt>alttext()

Sets or returns an alternative text specified in the link.

=cut

# Potential alternative text
sub alttext {
    if (@_ > 1) {
        $_[0]->{-alttext} = $_[1];
        $_[0]->_construct_text();
    }
    $_[0]->{-alttext};
}

=item $link-E<gt>type()

The node type, either C<section> or C<item>. As an unofficial type,
there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>

=cut

# The type: item or headn
sub type {
    return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}

=item $link-E<gt>link()

Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.

=back

=cut

# The link itself
sub link {
    my $self = shift;
    my $link = $self->page() || '';
    if($self->node()) {
        my $node = $self->node();
        $text =~ s/\|/E<verbar>/g;
        $text =~ s:/:E<sol>:g;
        if($self->type() eq 'section') {
            $link .= ($link ? '/' : '') . '"' . $node . '"';
        }
        elsif($self->type() eq 'hyperlink') {
            $link = $self->node();
        }
        else { # item
            $link .= '/' . $node;
        }
    }
    if($self->alttext()) {
        my $text = $self->alttext();
        $text =~ s/\|/E<verbar>/g;
        $text =~ s:/:E<sol>:g;
        $link = "$text|$link";
    }
    $link;
}

sub _invalid_link {
    my ($msg) = @_;
    # this sets @_
    #eval { die "$msg\n" };
    #chomp $@;
    $@ = $msg; # this seems to work, too!
    undef;
}

#-----------------------------------------------------------------------------
# Pod::Cache
#
# class to hold POD page details
#-----------------------------------------------------------------------------

package Pod::Cache;

=head2 Pod::Cache

B<Pod::Cache> holds information about a set of POD documents,
especially the nodes for hyperlinks.
The following methods are available:

=over 4

=item Pod::Cache-E<gt>new()

Create a new cache object. This object can hold an arbitrary number of
POD documents of class Pod::Cache::Item.

=cut

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = [];
    bless $self, $class;
    return $self;
}

=item $cache-E<gt>item()

Add a new item to the cache. Without arguments, this method returns a
list of all cache elements.

=cut

sub item {
    my ($self,%param) = @_;
    if(%param) {
        my $item = Pod::Cache::Item->new(%param);
        push(@$self, $item);
        return $item;
    }
    else {
        return @{$self};
    }
}

=item $cache-E<gt>find_page($name)

Look for a POD document named C<$name> in the cache. Returns the
reference to the corresponding Pod::Cache::Item object or undef if
not found.

=back

=cut

sub find_page {
    my ($self,$page) = @_;
    foreach(@$self) {
        if($_->page() eq $page) {
            return $_;
        }
    }
    undef;
}

package Pod::Cache::Item;

=head2 Pod::Cache::Item

B<Pod::Cache::Item> holds information about individual POD documents,
that can be grouped in a Pod::Cache object.
It is intended to hold information about the hyperlink nodes of POD
documents.
The following methods are available:

=over 4

=item Pod::Cache::Item-E<gt>new()

Create a new object.

=cut

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    $self->initialize();
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-nodes} = [] unless(defined $self->{-nodes});
}

=item $cacheitem-E<gt>page()

Set/retrieve the POD document name (e.g. "Pod::Parser").

=cut

# The POD page
sub page {
   return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
}

=item $cacheitem-E<gt>description()

Set/retrieve the POD short description as found in the C<=head1 NAME>
section.

=cut

# The POD description, taken out of NAME if present
sub description {
   return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
}

=item $cacheitem-E<gt>path()

Set/retrieve the POD file storage path.

=cut

# The file path
sub path {
   return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
}

=item $cacheitem-E<gt>file()

Set/retrieve the POD file name.

=cut

# The POD file name
sub file {
   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}

=item $cacheitem-E<gt>nodes()

Add a node (or a list of nodes) to the document's node list. Note that
the order is kept, i.e. start with the first node and end with the last.
If no argument is given, the current list of nodes is returned in the
same order the nodes have been added.
A node can be any scalar, but usually is a pair of node string and
unique id for the C<find_node> method to work correctly.

=cut

# The POD nodes
sub nodes {
    my ($self,@nodes) = @_;
    if(@nodes) {
        push(@{$self->{-nodes}}, @nodes);
        return @nodes;
    }
    else {
        return @{$self->{-nodes}};
    }
}

=item $cacheitem-E<gt>find_node($name)

Look for a node or index entry named C<$name> in the object.
Returns the unique id of the node (i.e. the second element of the array
stored in the node arry) or undef if not found.

=cut

sub find_node {
    my ($self,$node) = @_;
    my @search;
    push(@search, @{$self->{-nodes}}) if($self->{-nodes});
    push(@search, @{$self->{-idx}}) if($self->{-idx});
    foreach(@search) {
        if($_->[0] eq $node) {
            return $_->[1]; # id
        }
    }
    undef;
}

=item $cacheitem-E<gt>idx()

Add an index entry (or a list of them) to the document's index list. Note that
the order is kept, i.e. start with the first node and end with the last.
If no argument is given, the current list of index entries is returned in the
same order the entries have been added.
An index entry can be any scalar, but usually is a pair of string and
unique id.

=back

=cut

# The POD index entries
sub idx {
    my ($self,@idx) = @_;
    if(@idx) {
        push(@{$self->{-idx}}, @idx);
        return @idx;
    }
    else {
        return @{$self->{-idx}};
    }
}

=head1 AUTHOR

Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing
a lot of things from L<pod2man> and L<pod2roff> as well as other POD
processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.

=head1 SEE ALSO

L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
L<pod2html>

=cut

1;
od starts or stops logging of input.  This                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Pod::Plainer;
use strict;
use Pod::Parser;
our @ISA = qw(Pod::Parser);
our $VERSION = '0.01';

our %E = qw( < lt > gt );
 
sub escape_ltgt {
    (undef, my $text) = @_;
    $text =~ s/([<>])/E<$E{$1}>/g;
    $text 
} 

sub simple_delimiters {
    (undef, my $seq) = @_;
    $seq -> left_delimiter( '<' ); 
    $seq -> right_delimiter( '>' );  
    $seq;
}

sub textblock {
    my($parser,$text,$line) = @_;
    print {$parser->output_handle()}
	$parser->parse_text(
	    { -expand_text => q(escape_ltgt),
	      -expand_seq => q(simple_delimiters) },
	    $text, $line ) -> raw_text(); 
}

1;

__END__

=head1 NAME

Pod::Plainer - Perl extension for converting Pod to old style Pod.

=head1 SYNOPSIS

  use Pod::Plainer;

  my $parser = Pod::Plainer -> new ();
  $parser -> parse_from_filehandle(\*STDIN);

=head1 DESCRIPTION

Pod::Plainer uses Pod::Parser which takes Pod with the (new)
'CE<lt>E<lt> .. E<gt>E<gt>' constructs
and returns the old(er) style with just 'CE<lt>E<gt>';
'<' and '>' are replaced by 'EE<lt>ltE<gt>' and 'EE<lt>gtE<gt>'.

This can be used to pre-process Pod before using tools which do not
recognise the new style Pods.

=head2 EXPORT

None by default.

=head1 AUTHOR

Robin Barker, rmb1@cise.npl.co.uk

=head1 SEE ALSO

See L<Pod::Parser>.

=cut

m the object.  This may be a
useful error message when the remote side abnormally closes the
connection.  Typically the remote side will print an error message
before closing.

With no argument this method returns the last line read from the
object.  Wit                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################
# Pod/Select.pm -- function to select portions of POD docs
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Select;

use vars qw($VERSION);
$VERSION = 1.13;  ## Current version of this package
require  5.005;    ## requires this Perl version or later

#############################################################################

=head1 NAME

Pod::Select, podselect() - extract selected sections of POD from input

=head1 SYNOPSIS

    use Pod::Select;

    ## Select all the POD sections for each file in @filelist
    ## and print the result on standard output.
    podselect(@filelist);

    ## Same as above, but write to tmp.out
    podselect({-output => "tmp.out"}, @filelist):

    ## Select from the given filelist, only those POD sections that are
    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
    podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):

    ## Select the "DESCRIPTION" section of the PODs from STDIN and write
    ## the result to STDERR.
    podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);

or

    use Pod::Select;

    ## Create a parser object for selecting POD sections from the input
    $parser = new Pod::Select();

    ## Select all the POD sections for each file in @filelist
    ## and print the result to tmp.out.
    $parser->parse_from_file("<&STDIN", "tmp.out");

    ## Select from the given filelist, only those POD sections that are
    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
    $parser->select("NAME|SYNOPSIS", "OPTIONS");
    for (@filelist) { $parser->parse_from_file($_); }

    ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
    ## STDIN and write the result to STDERR.
    $parser->select("DESCRIPTION");
    $parser->add_selection("SEE ALSO");
    $parser->parse_from_filehandle(\*STDIN, \*STDERR);

=head1 REQUIRES

perl5.005, Pod::Parser, Exporter, Carp

=head1 EXPORTS

podselect()

=head1 DESCRIPTION

B<podselect()> is a function which will extract specified sections of
pod documentation from an input stream. This ability is provided by the
B<Pod::Select> module which is a subclass of B<Pod::Parser>.
B<Pod::Select> provides a method named B<select()> to specify the set of
POD sections to select for processing/printing. B<podselect()> merely
creates a B<Pod::Select> object and then invokes the B<podselect()>
followed by B<parse_from_file()>.

=head1 SECTION SPECIFICATIONS

B<podselect()> and B<Pod::Select::select()> may be given one or more
"section specifications" to restrict the text processed to only the
desired set of sections and their corresponding subsections.  A section
specification is a string containing one or more Perl-style regular
expressions separated by forward slashes ("/").  If you need to use a
forward slash literally within a section title you can escape it with a
backslash ("\/").

The formal syntax of a section specification is:

=over 4

=item *

I<head1-title-regex>/I<head2-title-regex>/...

=back

Any omitted or empty regular expressions will default to ".*".
Please note that each regular expression given is implicitly
anchored by adding "^" and "$" to the beginning and end.  Also, if a
given regular expression starts with a "!" character, then the
expression is I<negated> (so C<!foo> would match anything I<except>
C<foo>).

Some example section specifications follow.

=over 4

=item *

Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:

C<NAME|SYNOPSIS>

=item *

Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
section:

C<DESCRIPTION/Question|Answer>

=item *

Match the C<Comments> subsection of I<all> sections:

C</Comments>

=item *

Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:

C<DESCRIPTION/!Comments>

=item *

Match the C<DESCRIPTION> section but do I<not> match any of its subsections:

C<DESCRIPTION/!.+>

=item *

Match all top level sections but none of their subsections:

C</!.+>

=back 

=begin _NOT_IMPLEMENTED_

=head1 RANGE SPECIFICATIONS

B<podselect()> and B<Pod::Select::select()> may be given one or more
"range specifications" to restrict the text processed to only the
desired ranges of paragraphs in the desired set of sections. A range
specification is a string containing a single Perl-style regular
expression (a regex), or else two Perl-style regular expressions
(regexs) separated by a ".." (Perl's "range" operator is "..").
The regexs in a range specification are delimited by forward slashes
("/").  If you need to use a forward slash literally within a regex you
can escape it with a backslash ("\/").

The formal syntax of a range specification is:

=over 4

=item *

/I<start-range-regex>/[../I<end-range-regex>/]

=back

Where each the item inside square brackets (the ".." followed by the
end-range-regex) is optional. Each "range-regex" is of the form:

    =cmd-expr text-expr

Where I<cmd-expr> is intended to match the name of one or more POD
commands, and I<text-expr> is intended to match the paragraph text for
the command. If a range-regex is supposed to match a POD command, then
the first character of the regex (the one after the initial '/')
absolutely I<must> be an single '=' character; it may not be anything
else (not even a regex meta-character) if it is supposed to match
against the name of a POD command.

If no I<=cmd-expr> is given then the text-expr will be matched against
plain textblocks unless it is preceded by a space, in which case it is
matched against verbatim text-blocks. If no I<text-expr> is given then
only the command-portion of the paragraph is matched against.

Note that these two expressions are each implicitly anchored. This
means that when matching against the command-name, there will be an
implicit '^' and '$' around the given I<=cmd-expr>; and when matching
against the paragraph text there will be an implicit '\A' and '\Z'
around the given I<text-expr>.

Unlike with section-specs, the '!' character does I<not> have any special
meaning (negation or otherwise) at the beginning of a range-spec!

Some example range specifications follow.

=over 4

=item
Match all C<=for html> paragraphs:

C</=for html/>

=item
Match all paragraphs between C<=begin html> and C<=end html>
(note that this will I<not> work correctly if such sections
are nested):

C</=begin html/../=end html/>

=item
Match all paragraphs between the given C<=item> name until the end of the
current section:

C</=item mine/../=head\d/>

=item
Match all paragraphs between the given C<=item> until the next item, or
until the end of the itemized list (note that this will I<not> work as
desired if the item contains an itemized list nested within it):

C</=item mine/../=(item|back)/>

=back 

=end _NOT_IMPLEMENTED_

=cut

#############################################################################

use strict;
#use diagnostics;
use Carp;
use Pod::Parser 1.04;
use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL);

@ISA = qw(Pod::Parser);
@EXPORT = qw(&podselect);

## Maximum number of heading levels supported for '=headN' directives
*MAX_HEADING_LEVEL = \3;

#############################################################################

=head1 OBJECT METHODS

The following methods are provided in this module. Each one takes a
reference to the object itself as an implicit first parameter.

=cut

##---------------------------------------------------------------------------

## =begin _PRIVATE_
## 
## =head1 B<_init_headings()>
## 
## Initialize the current set of active section headings.
## 
## =cut
## 
## =end _PRIVATE_

use vars qw(%myData @section_headings);

sub _init_headings {
    my $self = shift;
    local *myData = $self;

    ## Initialize current section heading titles if necessary
    unless (defined $myData{_SECTION_HEADINGS}) {
        local *section_headings = $myData{_SECTION_HEADINGS} = [];
        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
            $section_headings[$i] = '';
        }
    }
}

##---------------------------------------------------------------------------

=head1 B<curr_headings()>

            ($head1, $head2, $head3, ...) = $parser->curr_headings();
            $head1 = $parser->curr_headings(1);

This method returns a list of the currently active section headings and
subheadings in the document being parsed. The list of headings returned
corresponds to the most recently parsed paragraph of the input.

If an argument is given, it must correspond to the desired section
heading number, in which case only the specified section heading is
returned. If there is no current section heading at the specified
level, then C<undef> is returned.

=cut

sub curr_headings {
    my $self = shift;
    $self->_init_headings()  unless (defined $self->{_SECTION_HEADINGS});
    my @headings = @{ $self->{_SECTION_HEADINGS} };
    return (@_ > 0  and  $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
}

##---------------------------------------------------------------------------

=head1 B<select()>

            $parser->select($section_spec1,$section_spec2,...);

This method is used to select the particular sections and subsections of
POD documentation that are to be printed and/or processed. The existing
set of selected sections is I<replaced> with the given set of sections.
See B<add_selection()> for adding to the current set of selected
sections.

Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">.  The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.

If no C<$section_spec> arguments are given, then the existing set of
selected sections is cleared out (which means C<all> sections will be
processed).

This method should I<not> normally be overridden by subclasses.

=cut

use vars qw(@selected_sections);

sub select {
    my $self = shift;
    my @sections = @_;
    local *myData = $self;
    local $_;

### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)

    ##---------------------------------------------------------------------
    ## The following is a blatant hack for backward compatibility, and for
    ## implementing add_selection(). If the *first* *argument* is the
    ## string "+", then the remaining section specifications are *added*
    ## to the current set of selections; otherwise the given section
    ## specifications will *replace* the current set of selections.
    ##
    ## This should probably be fixed someday, but for the present time,
    ## it seems incredibly unlikely that "+" would ever correspond to
    ## a legitimate section heading
    ##---------------------------------------------------------------------
    my $add = ($sections[0] eq "+") ? shift(@sections) : "";

    ## Reset the set of sections to use
    unless (@sections > 0) {
        delete $myData{_SELECTED_SECTIONS}  unless ($add);
        return;
    }
    $myData{_SELECTED_SECTIONS} = []
        unless ($add  &&  exists $myData{_SELECTED_SECTIONS});
    local *selected_sections = $myData{_SELECTED_SECTIONS};

    ## Compile each spec
    my $spec;
    for $spec (@sections) {
        if ( defined($_ = &_compile_section_spec($spec)) ) {
            ## Store them in our sections array
            push(@selected_sections, $_);
        }
        else {
            carp "Ignoring section spec \"$spec\"!\n";
        }
    }
}

##---------------------------------------------------------------------------

=head1 B<add_selection()>

            $parser->add_selection($section_spec1,$section_spec2,...);

This method is used to add to the currently selected sections and
subsections of POD documentation that are to be printed and/or
processed. See <select()> for replacing the currently selected sections.

Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.

This method should I<not> normally be overridden by subclasses.

=cut

sub add_selection {
    my $self = shift;
    $self->select("+", @_);
}

##---------------------------------------------------------------------------

=head1 B<clear_selections()>

            $parser->clear_selections();

This method takes no arguments, it has the exact same effect as invoking
<select()> with no arguments.

=cut

sub clear_selections {
    my $self = shift;
    $self->select();
}

##---------------------------------------------------------------------------

=head1 B<match_section()>

            $boolean = $parser->match_section($heading1,$heading2,...);

Returns a value of true if the given section and subsection heading
titles match any of the currently selected section specifications in
effect from prior calls to B<select()> and B<add_selection()> (or if
there are no explictly selected/deselected sections).

The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match.  If
C<$headingN> is omitted then it defaults to the current corresponding
section heading title in the input.

This method should I<not> normally be overridden by subclasses.

=cut

sub match_section {
    my $self = shift;
    my (@headings) = @_;
    local *myData = $self;

    ## Return true if no restrictions were explicitly specified
    my $selections = (exists $myData{_SELECTED_SECTIONS})
                       ?  $myData{_SELECTED_SECTIONS}  :  undef;
    return  1  unless ((defined $selections) && (@{$selections} > 0));

    ## Default any unspecified sections to the current one
    my @current_headings = $self->curr_headings();
    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
        (defined $headings[$i])  or  $headings[$i] = $current_headings[$i];
    }

    ## Look for a match against the specified section expressions
    my ($section_spec, $regex, $negated, $match);
    for $section_spec ( @{$selections} ) {
        ##------------------------------------------------------
        ## Each portion of this spec must match in order for
        ## the spec to be matched. So we will start with a 
        ## match-value of 'true' and logically 'and' it with
        ## the results of matching a given element of the spec.
        ##------------------------------------------------------
        $match = 1;
        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
            $regex   = $section_spec->[$i];
            $negated = ($regex =~ s/^\!//);
            $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
                                 : ($headings[$i] =~ /${regex}/));
            last unless ($match);
        }
        return  1  if ($match);
    }
    return  0;  ## no match
}

##---------------------------------------------------------------------------

=head1 B<is_selected()>

            $boolean = $parser->is_selected($paragraph);

This method is used to determine if the block of text given in
C<$paragraph> falls within the currently selected set of POD sections
and subsections to be printed or processed. This method is also
responsible for keeping track of the current input section and
subsections. It is assumed that C<$paragraph> is the most recently read
(but not yet processed) input paragraph.

The value returned will be true if the C<$paragraph> and the rest of the
text in the same section as C<$paragraph> should be selected (included)
for processing; otherwise a false value is returned.

=cut

sub is_selected {
    my ($self, $paragraph) = @_;
    local $_;
    local *myData = $self;

    $self->_init_headings()  unless (defined $myData{_SECTION_HEADINGS});

    ## Keep track of current sections levels and headings
    $_ = $paragraph;
    if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
        ## This is a section heading command
        my ($level, $heading) = ($2, $3);
        $level = 1 + (length($1) / 3)  if ((! length $level) || (length $1));
        ## Reset the current section heading at this level
        $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
        ## Reset subsection headings of this one to empty
        for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
            $myData{_SECTION_HEADINGS}->[$i] = '';
        }
    }

    return  $self->match_section();
}

#############################################################################

=head1 EXPORTED FUNCTIONS

The following functions are exported by this module. Please note that
these are functions (not methods) and therefore C<do not> take an
implicit first argument.

=cut

##---------------------------------------------------------------------------

=head1 B<podselect()>

            podselect(\%options,@filelist);

B<podselect> will print the raw (untranslated) POD paragraphs of all
POD sections in the given input files specified by C<@filelist>
according to the given options.

If any argument to B<podselect> is a reference to a hash
(associative array) then the values with the following keys are
processed as follows:

=over 4

=item B<-output>

A string corresponding to the desired output file (or ">&STDOUT"
or ">&STDERR"). The default is to use standard output.

=item B<-sections>

A reference to an array of sections specifications (as described in
L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
sections and subsections to be selected from input. If no section
specifications are given, then all sections of the PODs are used.

=begin _NOT_IMPLEMENTED_

=item B<-ranges>

A reference to an array of range specifications (as described in
L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
paragraphs to be selected from the desired input sections. If no range
specifications are given, then all paragraphs of the desired sections
are used.

=end _NOT_IMPLEMENTED_

=back

All other arguments should correspond to the names of input files
containing POD sections. A file name of "-" or "<&STDIN" will
be interpeted to mean standard input (which is the default if no
filenames are given).

=cut 

sub podselect {
    my(@argv) = @_;
    my %defaults   = ();
    my $pod_parser = new Pod::Select(%defaults);
    my $num_inputs = 0;
    my $output = ">&STDOUT";
    my %opts = ();
    local $_;
    for (@argv) {
        if (ref($_)) {
            next unless (ref($_) eq 'HASH');
            %opts = (%defaults, %{$_});

            ##-------------------------------------------------------------
            ## Need this for backward compatibility since we formerly used
            ## options that were all uppercase words rather than ones that
            ## looked like Unix command-line options.
            ## to be uppercase keywords)
            ##-------------------------------------------------------------
            %opts = map {
                my ($key, $val) = (lc $_, $opts{$_});
                $key =~ s/^(?=\w)/-/;
                $key =~ /^-se[cl]/  and  $key  = '-sections';
                #! $key eq '-range'    and  $key .= 's';
                ($key => $val);    
            } (keys %opts);

            ## Process the options
            (exists $opts{'-output'})  and  $output = $opts{'-output'};

            ## Select the desired sections
            $pod_parser->select(@{ $opts{'-sections'} })
                if ( (defined $opts{'-sections'})
                     && ((ref $opts{'-sections'}) eq 'ARRAY') );

            #! ## Select the desired paragraph ranges
            #! $pod_parser->select(@{ $opts{'-ranges'} })
            #!     if ( (defined $opts{'-ranges'})
            #!          && ((ref $opts{'-ranges'}) eq 'ARRAY') );
        }
        else {
            $pod_parser->parse_from_file($_, $output);
            ++$num_inputs;
        }
    }
    $pod_parser->parse_from_file("-")  unless ($num_inputs > 0);
}

#############################################################################

=head1 PRIVATE METHODS AND DATA

B<Pod::Select> makes uses a number of internal methods and data fields
which clients should not need to see or use. For the sake of avoiding
name collisions with client data and methods, these methods and fields
are briefly discussed here. Determined hackers may obtain further
information about them by reading the B<Pod::Select> source code.

Private data fields are stored in the hash-object whose reference is
returned by the B<new()> constructor for this class. The names of all
private methods and data-fields used by B<Pod::Select> begin with a
prefix of "_" and match the regular expression C</^_\w+$/>.

=cut

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head1 B<_compile_section_spec()>

            $listref = $parser->_compile_section_spec($section_spec);

This function (note it is a function and I<not> a method) takes a
section specification (as described in L<"SECTION SPECIFICATIONS">)
given in C<$section_sepc>, and compiles it into a list of regular
expressions. If C<$section_spec> has no syntax errors, then a reference
to the list (array) of corresponding regular expressions is returned;
otherwise C<undef> is returned and an error message is printed (using
B<carp>) for each invalid regex.

=end _PRIVATE_

=cut

sub _compile_section_spec {
    my ($section_spec) = @_;
    my (@regexs, $negated);

    ## Compile the spec into a list of regexs
    local $_ = $section_spec;
    s|\\\\|\001|g;  ## handle escaped backward slashes
    s|\\/|\002|g;   ## handle escaped forward slashes

    ## Parse the regexs for the heading titles
    @regexs = split('/', $_, $MAX_HEADING_LEVEL);

    ## Set default regex for ommitted levels
    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
        $regexs[$i]  = '.*'  unless ((defined $regexs[$i])
                                     && (length $regexs[$i]));
    }
    ## Modify the regexs as needed and validate their syntax
    my $bad_regexs = 0;
    for (@regexs) {
        $_ .= '.+'  if ($_ eq '!');
        s|\001|\\\\|g;       ## restore escaped backward slashes
        s|\002|\\/|g;        ## restore escaped forward slashes
        $negated = s/^\!//;  ## check for negation
        eval "/$_/";         ## check regex syntax
        if ($@) {
            ++$bad_regexs;
            carp "Bad regular expression /$_/ in \"$section_spec\": $@\n";
        }
        else {
            ## Add the forward and rear anchors (and put the negator back)
            $_ = '^' . $_  unless (/^\^/);
            $_ = $_ . '$'  unless (/\$$/);
            $_ = '!' . $_  if ($negated);
        }
    }
    return  (! $bad_regexs) ? [ @regexs ] : undef;
}

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head2 $self->{_SECTION_HEADINGS}

A reference to an array of the current section heading titles for each
heading level (note that the first heading level title is at index 0).

=end _PRIVATE_

=cut

##---------------------------------------------------------------------------

=begin _PRIVATE_

=head2 $self->{_SELECTED_SECTIONS}

A reference to an array of references to arrays. Each subarray is a list
of anchored regular expressions (preceded by a "!" if the expression is to
be negated). The index of the expression in the subarray should correspond
to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
that it is to be matched against.

=end _PRIVATE_

=cut

#############################################################################

=head1 SEE ALSO

L<Pod::Parser>

=head1 AUTHOR

Brad Appleton E<lt>bradapp@enteract.comE<gt>

Based on code for B<pod2text> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>

=cut

1;


    print inet_time('localhost');
    print inet_time('localhost', 'tcp');

    print inet_daytime();	# use default host from Net::Config
    print inet_daytime('localhost');
    print inet_daytime('localhost', 'tcp');

=head1 DESCRIPTION

C<Net::Time> provides subroutines that obtain the time on a remote machine.

=over 4

=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])

Obtain the time on C<HOST>, or some default host if C<HOST> is not given
or not defined,                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 # Pod::Text::Color -- Convert POD data to formatted color ASCII text
# $Id: Color.pm,v 0.6 2000/12/25 12:52:39 eagle Exp $
#
# Copyright 1999 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This is just a basic proof of concept.  It should later be modified to
# make better use of color, take options changing what colors are used for
# what text, and the like.

############################################################################
# Modules and declarations
############################################################################

package Pod::Text::Color;

require 5.004;

use Pod::Text ();
use Term::ANSIColor qw(colored);

use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Pod::Text);

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
$VERSION = 0.06;


############################################################################
# Overrides
############################################################################

# Make level one headings bold.
sub cmd_head1 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $self->SUPER::cmd_head1 (colored ($_, 'bold'));
}

# Make level two headings bold.
sub cmd_head2 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $self->SUPER::cmd_head2 (colored ($_, 'bold'));
}

# Fix the various interior sequences.
sub seq_b { return colored ($_[1], 'bold')   }
sub seq_f { return colored ($_[1], 'cyan')   }
sub seq_i { return colored ($_[1], 'yellow') }

# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the escape sequences.
sub wrap {
    my $self = shift;
    local $_ = shift;
    my $output = '';
    my $spaces = ' ' x $$self{MARGIN};
    my $width = $$self{width} - $$self{MARGIN};
    while (length > $width) {
        if (s/^((?:(?:\e\[[\d;]+m)?[^\n]){0,$width})\s+//
            || s/^((?:(?:\e\[[\d;]+m)?[^\n]){$width})//) {
            $output .= $spaces . $1 . "\n";
        } else {
            last;
        }
    }
    $output .= $spaces . $_;
    $output =~ s/\s+$/\n\n/;
    $output;
}

############################################################################
# Module return value and documentation
############################################################################

1;
__END__

=head1 NAME

Pod::Text::Color - Convert POD data to formatted color ASCII text

=head1 SYNOPSIS

    use Pod::Text::Color;
    my $parser = Pod::Text::Color->new (sentence => 0, width => 78);

    # Read POD from STDIN and write to STDOUT.
    $parser->parse_from_filehandle;

    # Read POD from file.pod and write to file.txt.
    $parser->parse_from_file ('file.pod', 'file.txt');

=head1 DESCRIPTION

Pod::Text::Color is a simple subclass of Pod::Text that highlights output
text using ANSI color escape sequences.  Apart from the color, it in all
ways functions like Pod::Text.  See L<Pod::Text> for details and available
options.

Term::ANSIColor is used to get colors and therefore must be installed to use
this module.

=head1 BUGS

This is just a basic proof of concept.  It should be seriously expanded to
support configurable coloration via options passed to the constructor, and
B<pod2text> should be taught about those.

=head1 SEE ALSO

L<Pod::Text|Pod::Text>, L<Pod::Parser|Pod::Parser>

=head1 AUTHOR

Russ Allbery E<lt>rra@stanford.eduE<gt>.

=cut
anted from $caller"
		unless $caller_method eq $wanted_method;

	local ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN) =
	      ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN);


	unless ($NEXT::NEXT{$self,$wanted_method}) {
		my @forebears =
			ancestors ref $self || $self, $wanted_class;
		while (@forebears) {
			last if shift @forebears eq $caller_class
		}
		no strict 'refs';
		@{$NEXT::NEXT{$self,$wanted_method}} = 
			map { *{"${_}::$caller_method"}{CODE}||()                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                # Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
# $Id: Overstrike.pm,v 1.1 2000/12/25 12:51:23 eagle Exp $
#
# Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
#   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This was written because the output from:
#
#     pod2text Text.pm > plain.txt; less plain.txt
#
# is not as rich as the output from
#
#     pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
#
# and because both Pod::Text::Color and Pod::Text::Termcap are not device
# independent.

############################################################################
# Modules and declarations
############################################################################

package Pod::Text::Overstrike;

require 5.004;

use Pod::Text ();

use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Pod::Text);

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
$VERSION = 1.01;


############################################################################
# Overrides
############################################################################

# Make level one headings bold, overridding any existing formatting.
sub cmd_head1 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    s/(.)\cH\1//g;
    s/_\cH//g;
    s/(.)/$1\b$1/g;
    $self->SUPER::cmd_head1 ($_);
}

# Make level two headings bold, overriding any existing formatting.
sub cmd_head2 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    s/(.)\cH\1//g;
    s/_\cH//g;
    s/(.)/$1\b$1/g;
    $self->SUPER::cmd_head2 ($_);
}

# Make level three headings underscored, overriding any existing formatting.
sub cmd_head3 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    s/(.)\cH\1//g;
    s/_\cH//g;
    s/(.)/_\b$1/g;
    $self->SUPER::cmd_head3 ($_);
}

# Fix the various interior sequences.
sub seq_b { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/$1\b$1/g; $_ }
sub seq_f { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/_\b$1/g; $_ }
sub seq_i { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/_\b$1/g; $_ }

# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the escape sequences.
sub wrap {
    my $self = shift;
    local $_ = shift;
    my $output = '';
    my $spaces = ' ' x $$self{MARGIN};
    my $width = $$self{width} - $$self{MARGIN};
    while (length > $width) {
        if (s/^((?:(?:[^\n]\cH)?[^\n]){0,$width})\s+//
            || s/^((?:(?:[^\n]\cH)?[^\n]){$width})//) {
            $output .= $spaces . $1 . "\n";
        } else {
            last;
        }
    }
    $output .= $spaces . $_;
    $output =~ s/\s+$/\n\n/;
    $output;
}

############################################################################
# Module return value and documentation
############################################################################

1;
__END__

=head1 NAME

Pod::Text::Overstrike - Convert POD data to formatted overstrike text

=head1 SYNOPSIS

    use Pod::Text::Overstrike;
    my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);

    # Read POD from STDIN and write to STDOUT.
    $parser->parse_from_filehandle;

    # Read POD from file.pod and write to file.txt.
    $parser->parse_from_file ('file.pod', 'file.txt');

=head1 DESCRIPTION

Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
output text using overstrike sequences, in a manner similar to nroff.
Characters in bold text are overstruck (character, backspace, character) and
characters in underlined text are converted to overstruck underscores
(underscore, backspace, character).  This format was originally designed for
hardcopy terminals and/or lineprinters, yet is readable on softcopy (CRT)
terminals.

Overstruck text is best viewed by page-at-a-time programs that take
advantage of the terminal's B<stand-out> and I<underline> capabilities, such
as the less program on Unix.

Apart from the overstrike, it in all ways functions like Pod::Text.  See
L<Pod::Text> for details and available options.

=head1 BUGS

Currently, the outermost formatting instruction wins, so for example
underlined text inside a region of bold text is displayed as simply bold.
There may be some better approach possible.

=head1 SEE ALSO

L<Pod::Text|Pod::Text>, L<Pod::Parser|Pod::Parser>

=head1 AUTHOR

Joe Smith E<lt>Joe.Smith@inwap.comE<gt>, using the framework created by Russ
Allbery E<lt>rra@stanford.eduE<gt>.

=cut
t commonly used in C<AUTOLOAD> methods, as a means to
decline an C<AUTOLOAD> request, but preserve the normal exception-on-failure 
semantics:

	sub AUTOLOAD {
		if ($AUTOLOAD =~ /foo|bar/) {
			# handle here
		}
		else {  # try elsewhere
			shift()->NEXT::ACTUAL::AUTOLOAD(@_);
		}
	}

By using C<NEXT::ACTUAL>, if there is no other C<AUTOLOAD> to ha                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                # Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes.
# $Id: Termcap.pm,v 1.0 2000/12/25 12:52:48 eagle Exp $
#
# Copyright 1999 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This is a simple subclass of Pod::Text that overrides a few key methods to
# output the right termcap escape sequences for formatted text on the
# current terminal type.

############################################################################
# Modules and declarations
############################################################################

package Pod::Text::Termcap;

require 5.004;

use Pod::Text ();
use POSIX ();
use Term::Cap;

use strict;
use vars qw(@ISA $VERSION);

@ISA = qw(Pod::Text);

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
$VERSION = 1.00;


############################################################################
# Overrides
############################################################################

# In the initialization method, grab our terminal characteristics as well as
# do all the stuff we normally do.
sub initialize {
    my $self = shift;

    # The default Term::Cap path won't work on Solaris.
    $ENV{TERMPATH} = "$ENV{HOME}/.termcap:/etc/termcap"
        . ":/usr/share/misc/termcap:/usr/share/lib/termcap";

    my $termios = POSIX::Termios->new;
    $termios->getattr;
    my $ospeed = $termios->getospeed;
    my $term = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
    $$self{BOLD} = $$term{_md} or die 'BOLD';
    $$self{UNDL} = $$term{_us} or die 'UNDL';
    $$self{NORM} = $$term{_me} or die 'NORM';

    unless (defined $$self{width}) {
        $$self{width} = $ENV{COLUMNS} || $$term{_co} || 78;
        $$self{width} -= 2;
    }

    $self->SUPER::initialize;
}

# Make level one headings bold.
sub cmd_head1 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $self->SUPER::cmd_head1 ("$$self{BOLD}$_$$self{NORM}");
}

# Make level two headings bold.
sub cmd_head2 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $self->SUPER::cmd_head2 ("$$self{BOLD}$_$$self{NORM}");
}

# Fix up B<> and I<>.  Note that we intentionally don't do F<>.
sub seq_b { my $self = shift; return "$$self{BOLD}$_[0]$$self{NORM}" }
sub seq_i { my $self = shift; return "$$self{UNDL}$_[0]$$self{NORM}" }

# Override the wrapping code to igore the special sequences.
sub wrap {
    my $self = shift;
    local $_ = shift;
    my $output = '';
    my $spaces = ' ' x $$self{MARGIN};
    my $width = $$self{width} - $$self{MARGIN};
    my $code = "(?:\Q$$self{BOLD}\E|\Q$$self{UNDL}\E|\Q$$self{NORM}\E)";
    while (length > $width) {
        if (s/^((?:$code?[^\n]){0,$width})\s+//
            || s/^((?:$code?[^\n]){$width})//) {
            $output .= $spaces . $1 . "\n";
        } else {
            last;
        }
    }
    $output .= $spaces . $_;
    $output =~ s/\s+$/\n\n/;
    $output;
}


############################################################################
# Module return value and documentation
############################################################################

1;
__END__

=head1 NAME

Pod::Text::Color - Convert POD data to ASCII text with format escapes

=head1 SYNOPSIS

    use Pod::Text::Termcap;
    my $parser = Pod::Text::Termcap->new (sentence => 0, width => 78);

    # Read POD from STDIN and write to STDOUT.
    $parser->parse_from_filehandle;

    # Read POD from file.pod and write to file.txt.
    $parser->parse_from_file ('file.pod', 'file.txt');

=head1 DESCRIPTION

Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output
text using the correct termcap escape sequences for the current terminal.
Apart from the format codes, it in all ways functions like Pod::Text.  See
L<Pod::Text> for details and available options.

=head1 SEE ALSO

L<Pod::Text|Pod::Text>, L<Pod::Parser|Pod::Parser>

=head1 AUTHOR

Russ Allbery E<lt>rra@stanford.eduE<gt>.

=cut
mpiler.

=head1 CONVENTIONS

Most compiler backends use the following conventions: OPTIONS
consists of a comma-separated list of words (no white-space).
The C<-v> option usually puts the backend into verbose mode.
The C<-ofile> option generates output to B<file> instead of
stdout. The C<-D> option followed by various letters turns on
various internal debugging flags. See the documentation for the
desired ba                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                # Pod::Text -- Convert POD data to formatted ASCII text.
# $Id: Text.pm,v 2.8 2001/02/10 06:50:23 eagle Exp $
#
# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module is intended to be a replacement for Pod::Text, and attempts to
# match its output except for some specific circumstances where other
# decisions seemed to produce better output.  It uses Pod::Parser and is
# designed to be very easy to subclass.

############################################################################
# Modules and declarations
############################################################################

package Pod::Text;

require 5.004;

use Carp qw(carp croak);
use Exporter ();
use Pod::Select ();

use strict;
use vars qw(@ISA @EXPORT %ESCAPES $VERSION);

# We inherit from Pod::Select instead of Pod::Parser so that we can be used
# by Pod::Usage.
@ISA = qw(Pod::Select Exporter);

# We have to export pod2text for backward compatibility.
@EXPORT = qw(pod2text);

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
# This number should ideally be the same as the CVS revision in podlators,
# however.
$VERSION = 2.08;


############################################################################
# Table of supported E<> escapes
############################################################################

# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
# which got it near verbatim from the original Pod::Text.  It is therefore
# credited to Tom Christiansen, and I'm glad I didn't have to write it.  :)
# "iexcl" to "divide" added by Tim Jenness.
%ESCAPES = (
    'amp'       =>    '&',      # ampersand
    'lt'        =>    '<',      # left chevron, less-than
    'gt'        =>    '>',      # right chevron, greater-than
    'quot'      =>    '"',      # double quote
    'sol'       =>    '/',      # solidus (forward slash)
    'verbar'    =>    '|',      # vertical bar

    "Aacute"    =>    "\xC1",   # capital A, acute accent
    "aacute"    =>    "\xE1",   # small a, acute accent
    "Acirc"     =>    "\xC2",   # capital A, circumflex accent
    "acirc"     =>    "\xE2",   # small a, circumflex accent
    "AElig"     =>    "\xC6",   # capital AE diphthong (ligature)
    "aelig"     =>    "\xE6",   # small ae diphthong (ligature)
    "Agrave"    =>    "\xC0",   # capital A, grave accent
    "agrave"    =>    "\xE0",   # small a, grave accent
    "Aring"     =>    "\xC5",   # capital A, ring
    "aring"     =>    "\xE5",   # small a, ring
    "Atilde"    =>    "\xC3",   # capital A, tilde
    "atilde"    =>    "\xE3",   # small a, tilde
    "Auml"      =>    "\xC4",   # capital A, dieresis or umlaut mark
    "auml"      =>    "\xE4",   # small a, dieresis or umlaut mark
    "Ccedil"    =>    "\xC7",   # capital C, cedilla
    "ccedil"    =>    "\xE7",   # small c, cedilla
    "Eacute"    =>    "\xC9",   # capital E, acute accent
    "eacute"    =>    "\xE9",   # small e, acute accent
    "Ecirc"     =>    "\xCA",   # capital E, circumflex accent
    "ecirc"     =>    "\xEA",   # small e, circumflex accent
    "Egrave"    =>    "\xC8",   # capital E, grave accent
    "egrave"    =>    "\xE8",   # small e, grave accent
    "ETH"       =>    "\xD0",   # capital Eth, Icelandic
    "eth"       =>    "\xF0",   # small eth, Icelandic
    "Euml"      =>    "\xCB",   # capital E, dieresis or umlaut mark
    "euml"      =>    "\xEB",   # small e, dieresis or umlaut mark
    "Iacute"    =>    "\xCC",   # capital I, acute accent
    "iacute"    =>    "\xEC",   # small i, acute accent
    "Icirc"     =>    "\xCE",   # capital I, circumflex accent
    "icirc"     =>    "\xEE",   # small i, circumflex accent
    "Igrave"    =>    "\xCD",   # capital I, grave accent
    "igrave"    =>    "\xED",   # small i, grave accent
    "Iuml"      =>    "\xCF",   # capital I, dieresis or umlaut mark
    "iuml"      =>    "\xEF",   # small i, dieresis or umlaut mark
    "Ntilde"    =>    "\xD1",   # capital N, tilde
    "ntilde"    =>    "\xF1",   # small n, tilde
    "Oacute"    =>    "\xD3",   # capital O, acute accent
    "oacute"    =>    "\xF3",   # small o, acute accent
    "Ocirc"     =>    "\xD4",   # capital O, circumflex accent
    "ocirc"     =>    "\xF4",   # small o, circumflex accent
    "Ograve"    =>    "\xD2",   # capital O, grave accent
    "ograve"    =>    "\xF2",   # small o, grave accent
    "Oslash"    =>    "\xD8",   # capital O, slash
    "oslash"    =>    "\xF8",   # small o, slash
    "Otilde"    =>    "\xD5",   # capital O, tilde
    "otilde"    =>    "\xF5",   # small o, tilde
    "Ouml"      =>    "\xD6",   # capital O, dieresis or umlaut mark
    "ouml"      =>    "\xF6",   # small o, dieresis or umlaut mark
    "szlig"     =>    "\xDF",   # small sharp s, German (sz ligature)
    "THORN"     =>    "\xDE",   # capital THORN, Icelandic
    "thorn"     =>    "\xFE",   # small thorn, Icelandic
    "Uacute"    =>    "\xDA",   # capital U, acute accent
    "uacute"    =>    "\xFA",   # small u, acute accent
    "Ucirc"     =>    "\xDB",   # capital U, circumflex accent
    "ucirc"     =>    "\xFB",   # small u, circumflex accent
    "Ugrave"    =>    "\xD9",   # capital U, grave accent
    "ugrave"    =>    "\xF9",   # small u, grave accent
    "Uuml"      =>    "\xDC",   # capital U, dieresis or umlaut mark
    "uuml"      =>    "\xFC",   # small u, dieresis or umlaut mark
    "Yacute"    =>    "\xDD",   # capital Y, acute accent
    "yacute"    =>    "\xFD",   # small y, acute accent
    "yuml"      =>    "\xFF",   # small y, dieresis or umlaut mark

    "laquo"     =>    "\xAB",   # left pointing double angle quotation mark
    "lchevron"  =>    "\xAB",   #  synonym (backwards compatibility)
    "raquo"     =>    "\xBB",   # right pointing double angle quotation mark
    "rchevron"  =>    "\xBB",   #  synonym (backwards compatibility)

    "iexcl"     =>    "\xA1",   # inverted exclamation mark
    "cent"      =>    "\xA2",   # cent sign
    "pound"     =>    "\xA3",   # (UK) pound sign
    "curren"    =>    "\xA4",   # currency sign
    "yen"       =>    "\xA5",   # yen sign
    "brvbar"    =>    "\xA6",   # broken vertical bar
    "sect"      =>    "\xA7",   # section sign
    "uml"       =>    "\xA8",   # diaresis
    "copy"      =>    "\xA9",   # Copyright symbol
    "ordf"      =>    "\xAA",   # feminine ordinal indicator
    "not"       =>    "\xAC",   # not sign
    "shy"       =>    "\xAD",   # soft hyphen
    "reg"       =>    "\xAE",   # registered trademark
    "macr"      =>    "\xAF",   # macron, overline
    "deg"       =>    "\xB0",   # degree sign
    "plusmn"    =>    "\xB1",   # plus-minus sign
    "sup2"      =>    "\xB2",   # superscript 2
    "sup3"      =>    "\xB3",   # superscript 3
    "acute"     =>    "\xB4",   # acute accent
    "micro"     =>    "\xB5",   # micro sign
    "para"      =>    "\xB6",   # pilcrow sign = paragraph sign
    "middot"    =>    "\xB7",   # middle dot = Georgian comma
    "cedil"     =>    "\xB8",   # cedilla
    "sup1"      =>    "\xB9",   # superscript 1
    "ordm"      =>    "\xBA",   # masculine ordinal indicator
    "frac14"    =>    "\xBC",   # vulgar fraction one quarter
    "frac12"    =>    "\xBD",   # vulgar fraction one half
    "frac34"    =>    "\xBE",   # vulgar fraction three quarters
    "iquest"    =>    "\xBF",   # inverted question mark
    "times"     =>    "\xD7",   # multiplication sign
    "divide"    =>    "\xF7",   # division sign
);


############################################################################
# Initialization
############################################################################

# Initialize the object.  Must be sure to call our parent initializer.
sub initialize {
    my $self = shift;

    $$self{alt}      = 0  unless defined $$self{alt};
    $$self{indent}   = 4  unless defined $$self{indent};
    $$self{loose}    = 0  unless defined $$self{loose};
    $$self{sentence} = 0  unless defined $$self{sentence};
    $$self{width}    = 76 unless defined $$self{width};

    # Figure out what quotes we'll be using for C<> text.
    $$self{quotes} ||= '"';
    if ($$self{quotes} eq 'none') {
        $$self{LQUOTE} = $$self{RQUOTE} = '';
    } elsif (length ($$self{quotes}) == 1) {
        $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes};
    } elsif ($$self{quotes} =~ /^(.)(.)$/
             || $$self{quotes} =~ /^(..)(..)$/) {
        $$self{LQUOTE} = $1;
        $$self{RQUOTE} = $2;
    } else {
        croak qq(Invalid quote specification "$$self{quotes}");
    }

    $$self{INDENTS}  = [];              # Stack of indentations.
    $$self{MARGIN}   = $$self{indent};  # Current left margin in spaces.

    $self->SUPER::initialize;
}


############################################################################
# Core overrides
############################################################################

# Called for each command paragraph.  Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
# the command to a method named the same as the command.  =cut is handled
# internally by Pod::Parser.
sub command {
    my $self = shift;
    my $command = shift;
    return if $command eq 'pod';
    return if ($$self{EXCLUDE} && $command ne 'end');
    $self->item ("\n") if defined $$self{ITEM};
    if ($self->can ('cmd_' . $command)) {
        $command = 'cmd_' . $command;
        $self->$command (@_);
    } else {
        my ($text, $line, $paragraph) = @_;
        my $file;
        ($file, $line) = $paragraph->file_line;
        $text =~ s/\n+\z//;
        $text = " $text" if ($text =~ /^\S/);
        warn qq($file:$line: Unknown command paragraph "=$command$text"\n);
        return;
    }
}

# Called for a verbatim paragraph.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Just output it verbatim, but with tabs converted
# to spaces.
sub verbatim {
    my $self = shift;
    return if $$self{EXCLUDE};
    $self->item if defined $$self{ITEM};
    local $_ = shift;
    return if /^\s*$/;
    s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
    $self->output ($_);
}

# Called for a regular text block.  Gets the paragraph, the line number, and
# a Pod::Paragraph object.  Perform interpolation and output the results.
sub textblock {
    my $self = shift;
    return if $$self{EXCLUDE};
    $self->output ($_[0]), return if $$self{VERBATIM};
    local $_ = shift;
    my $line = shift;

    # Perform a little magic to collapse multiple L<> references.  This is
    # here mostly for backwards-compatibility.  We'll just rewrite the whole
    # thing into actual text at this part, bypassing the whole internal
    # sequence parsing thing.
    s{
        (
          L<                    # A link of the form L</something>.
              /
              (
                  [:\w]+        # The item has to be a simple word...
                  (\(\))?       # ...or simple function.
              )
          >
          (
              ,?\s+(and\s+)?    # Allow lots of them, conjuncted.
              L<
                  /
                  (
                      [:\w]+
                      (\(\))?
                  )
              >
          )+
        )
    } {
        local $_ = $1;
        s%L</([^>]+)>%$1%g;
        my @items = split /(?:,?\s+(?:and\s+)?)/;
        my $string = "the ";
        my $i;
        for ($i = 0; $i < @items; $i++) {
            $string .= $items[$i];
            $string .= ", " if @items > 2 && $i != $#items;
            $string .= " and " if ($i == $#items - 1);
        }
        $string .= " entries elsewhere in this document";
        $string;
    }gex;

    # Now actually interpolate and output the paragraph.
    $_ = $self->interpolate ($_, $line);
    s/\s+$/\n/;
    if (defined $$self{ITEM}) {
        $self->item ($_ . "\n");
    } else {
        $self->output ($self->reformat ($_ . "\n"));
    }
}

# Called for an interior sequence.  Gets the command, argument, and a
# Pod::InteriorSequence object and is expected to return the resulting text.
# Calls code, bold, italic, file, and link to handle those types of
# sequences, and handles S<>, E<>, X<>, and Z<> directly.
sub interior_sequence {
    my $self = shift;
    my $command = shift;
    local $_ = shift;
    return '' if ($command eq 'X' || $command eq 'Z');

    # Expand escapes into the actual character now, carping if invalid.
    if ($command eq 'E') {
        if (/^\d+$/) {
            return chr;
        } else {
            return $ESCAPES{$_} if defined $ESCAPES{$_};
            carp "Unknown escape: E<$_>";
            return "E<$_>";
        }
    }

    # For all the other sequences, empty content produces no output.
    return if $_ eq '';

    # For S<>, compress all internal whitespace and then map spaces to \01.
    # When we output the text, we'll map this back.
    if ($command eq 'S') {
        s/\s{2,}/ /g;
        tr/ /\01/;
        return $_;
    }

    # Anything else needs to get dispatched to another method.
    if    ($command eq 'B') { return $self->seq_b ($_) }
    elsif ($command eq 'C') { return $self->seq_c ($_) }
    elsif ($command eq 'F') { return $self->seq_f ($_) }
    elsif ($command eq 'I') { return $self->seq_i ($_) }
    elsif ($command eq 'L') { return $self->seq_l ($_) }
    else { carp "Unknown sequence $command<$_>" }
}

# Called for each paragraph that's actually part of the POD.  We take
# advantage of this opportunity to untabify the input.
sub preprocess_paragraph {
    my $self = shift;
    local $_ = shift;
    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
    $_;
}


############################################################################
# Command paragraphs
############################################################################

# All command paragraphs take the paragraph and the line number.

# First level heading.
sub cmd_head1 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $_ = $self->interpolate ($_, shift);
    if ($$self{alt}) {
        $self->output ("\n==== $_ ====\n\n");
    } else {
        $_ .= "\n" if $$self{loose};
        $self->output ($_ . "\n");
    }
}

# Second level heading.
sub cmd_head2 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $_ = $self->interpolate ($_, shift);
    if ($$self{alt}) {
        $self->output ("\n==   $_   ==\n\n");
    } else {
        $self->output (' ' x ($$self{indent} / 2) . $_ . "\n\n");
    }
}

# Third level heading.
sub cmd_head3 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $_ = $self->interpolate ($_, shift);
    if ($$self{alt}) {
        $self->output ("\n=    $_    =\n\n");
    } else {
        $self->output (' ' x ($$self{indent} * 2 / 3 + 0.5) . $_ . "\n\n");
    }
}

# Third level heading.
sub cmd_head4 {
    my $self = shift;
    local $_ = shift;
    s/\s+$//;
    $_ = $self->interpolate ($_, shift);
    if ($$self{alt}) {
        $self->output ("\n-    $_    -\n\n");
    } else {
        $self->output (' ' x ($$self{indent} * 3 / 4 + 0.5) . $_ . "\n\n");
    }
}

# Start a list.
sub cmd_over {
    my $self = shift;
    local $_ = shift;
    unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
    push (@{ $$self{INDENTS} }, $$self{MARGIN});
    $$self{MARGIN} += ($_ + 0);
}

# End a list.
sub cmd_back {
    my $self = shift;
    $$self{MARGIN} = pop @{ $$self{INDENTS} };
    unless (defined $$self{MARGIN}) {
        carp "Unmatched =back";
        $$self{MARGIN} = $$self{indent};
    }
}

# An individual list item.
sub cmd_item {
    my $self = shift;
    if (defined $$self{ITEM}) { $self->item }
    local $_ = shift;
    s/\s+$//;
    $$self{ITEM} = $self->interpolate ($_);
}

# Begin a block for a particular translator.  Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
    my $self = shift;
    local $_ = shift;
    my ($kind) = /^(\S+)/ or return;
    if ($kind eq 'text') {
        $$self{VERBATIM} = 1;
    } else {
        $$self{EXCLUDE} = 1;
    }
}

# End a block for a particular translator.  We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
    my $self = shift;
    $$self{EXCLUDE} = 0;
    $$self{VERBATIM} = 0;
}

# One paragraph for a particular translator.  Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
    my $self = shift;
    local $_ = shift;
    my $line = shift;
    return unless s/^text\b[ \t]*\n?//;
    $self->verbatim ($_, $line);
}


############################################################################
# Interior sequences
############################################################################

# The simple formatting ones.  These are here mostly so that subclasses can
# override them and do more complicated things.
sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }
sub seq_c {
    return $_[0]{alt} ? "``$_[1]''" : "$_[0]{LQUOTE}$_[1]$_[0]{RQUOTE}"
}

# The complicated one.  Handle links.  Since this is plain text, we can't
# actually make any real links, so this is all to figure out what text we
# print out.
sub seq_l {
    my $self = shift;
    local $_ = shift;

    # Smash whitespace in case we were split across multiple lines.
    s/\s+/ /g;

    # If we were given any explicit text, just output it.
    if (/^([^|]+)\|/) { return $1 }

    # Okay, leading and trailing whitespace isn't important; get rid of it.
    s/^\s+//;
    s/\s+$//;

    # If the argument looks like a URL, return it verbatim.  This only
    # handles URLs that use the server syntax.
    if (m%^[a-z]+://\S+$%) { return $_ }

    # Default to using the whole content of the link entry as a section
    # name.  Note that L<manpage/> forces a manpage interpretation, as does
    # something looking like L<manpage(section)>.  The latter is an
    # enhancement over the original Pod::Text.
    my ($manpage, $section) = ('', $_);
    if (/^"\s*(.*?)\s*"$/) {
        $section = '"' . $1 . '"';
    } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
        ($manpage, $section) = ($_, '');
    } elsif (m%/%) {
        ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
    }

    # Now build the actual output text.
    my $text = '';
    if (!length $section) {
        $text = "the $manpage manpage" if length $manpage;
    } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
        $text .= 'the ' . $section . ' entry';
        $text .= (length $manpage) ? " in the $manpage manpage"
                                   : " elsewhere in this document";
    } else {
        $section =~ s/^\"\s*//;
        $section =~ s/\s*\"$//;
        $text .= 'the section on "' . $section . '"';
        $text .= " in the $manpage manpage" if length $manpage;
    }
    $text;
}


############################################################################
# List handling
############################################################################

# This method is called whenever an =item command is complete (in other
# words, we've seen its associated paragraph or know for certain that it
# doesn't have one).  It gets the paragraph associated with the item as an
# argument.  If that argument is empty, just output the item tag; if it
# contains a newline, output the item tag followed by the newline.
# Otherwise, see if there's enough room for us to output the item tag in the
# margin of the text or if we have to put it on a separate line.
sub item {
    my $self = shift;
    local $_ = shift;
    my $tag = $$self{ITEM};
    unless (defined $tag) {
        carp "item called without tag";
        return;
    }
    undef $$self{ITEM};
    my $indent = $$self{INDENTS}[-1];
    unless (defined $indent) { $indent = $$self{indent} }
    my $space = ' ' x $indent;
    $space =~ s/^ /:/ if $$self{alt};
    if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
        my $margin = $$self{MARGIN};
        $$self{MARGIN} = $indent;
        my $output = $self->reformat ($tag);
        $output =~ s/\n*$/\n/;
        $self->output ($output);
        $$self{MARGIN} = $margin;
        $self->output ($self->reformat ($_)) if /\S/;
    } else {
        $_ = $self->reformat ($_);
        s/^ /:/ if ($$self{alt} && $indent > 0);
        my $tagspace = ' ' x length $tag;
        s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
        $self->output ($_);
    }
}


############################################################################
# Output formatting
############################################################################

# Wrap a line, indenting by the current left margin.  We can't use
# Text::Wrap because it plays games with tabs.  We can't use formline, even
# though we'd really like to, because it screws up non-printing characters.
# So we have to do the wrapping ourselves.
sub wrap {
    my $self = shift;
    local $_ = shift;
    my $output = '';
    my $spaces = ' ' x $$self{MARGIN};
    my $width = $$self{width} - $$self{MARGIN};
    while (length > $width) {
        if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
            $output .= $spaces . $1 . "\n";
        } else {
            last;
        }
    }
    $output .= $spaces . $_;
    $output =~ s/\s+$/\n\n/;
    $output;
}

# Reformat a paragraph of text for the current margin.  Takes the text to
# reformat and returns the formatted text.
sub reformat {
    my $self = shift;
    local $_ = shift;

    # If we're trying to preserve two spaces after sentences, do some
    # munging to support that.  Otherwise, smash all repeated whitespace.
    if ($$self{sentence}) {
        s/ +$//mg;
        s/\.\n/. \n/g;
        s/\n/ /g;
        s/   +/  /g;
    } else {
        s/\s+/ /g;
    }
    $self->wrap ($_);
}

# Output text to the output device.
sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }


############################################################################
# Backwards compatibility
############################################################################

# The old Pod::Text module did everything in a pod2text() function.  This
# tries to provide the same interface for legacy applications.
sub pod2text {
    my @args;

    # This is really ugly; I hate doing option parsing in the middle of a
    # module.  But the old Pod::Text module supported passing flags to its
    # entry function, so handle -a and -<number>.
    while ($_[0] =~ /^-/) {
        my $flag = shift;
        if    ($flag eq '-a')       { push (@args, alt => 1)    }
        elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
        else {
            unshift (@_, $flag);
            last;
        }
    }

    # Now that we know what arguments we're using, create the parser.
    my $parser = Pod::Text->new (@args);

    # If two arguments were given, the second argument is going to be a file
    # handle.  That means we want to call parse_from_filehandle(), which
    # means we need to turn the first argument into a file handle.  Magic
    # open will handle the <&STDIN case automagically.
    if (defined $_[1]) {
        my @fhs = @_;
        local *IN;
        unless (open (IN, $fhs[0])) {
            croak ("Can't open $fhs[0] for reading: $!\n");
            return;
        }
        $fhs[0] = \*IN;
        return $parser->parse_from_filehandle (@fhs);
    } else {
        return $parser->parse_from_file (@_);
    }
}


############################################################################
# Module return value and documentation
############################################################################

1;
__END__

=head1 NAME

Pod::Text - Convert POD data to formatted ASCII text

=head1 SYNOPSIS

    use Pod::Text;
    my $parser = Pod::Text->new (sentence => 0, width => 78);

    # Read POD from STDIN and write to STDOUT.
    $parser->parse_from_filehandle;

    # Read POD from file.pod and write to file.txt.
    $parser->parse_from_file ('file.pod', 'file.txt');

=head1 DESCRIPTION

Pod::Text is a module that can convert documentation in the POD format (the
preferred language for documenting Perl) into formatted ASCII.  It uses no
special formatting controls or codes whatsoever, and its output is therefore
suitable for nearly any device.

As a derived class from Pod::Parser, Pod::Text supports the same methods and
interfaces.  See L<Pod::Parser> for all the details; briefly, one creates a
new parser with C<Pod::Text-E<gt>new()> and then calls either
parse_from_filehandle() or parse_from_file().

new() can take options, in the form of key/value pairs, that control the
behavior of the parser.  The currently recognized options are:

=over 4

=item alt

If set to a true value, selects an alternate output format that, among other
things, uses a different heading style and marks C<=item> entries with a
colon in the left margin.  Defaults to false.

=item indent

The number of spaces to indent regular text, and the default indentation for
C<=over> blocks.  Defaults to 4.

=item loose

If set to a true value, a blank line is printed after a C<=head1> heading.
If set to false (the default), no blank line is printed after C<=head1>,
although one is still printed after C<=head2>.  This is the default because
it's the expected formatting for manual pages; if you're formatting
arbitrary text documents, setting this to true may result in more pleasing
output.

=item quotes

Sets the quote marks used to surround CE<lt>> text.  If the value is a
single character, it is used as both the left and right quote; if it is two
characters, the first character is used as the left quote and the second as
the right quoted; and if it is four characters, the first two are used as
the left quote and the second two as the right quote.

This may also be set to the special value C<none>, in which case no quote
marks are added around CE<lt>> text.

=item sentence

If set to a true value, Pod::Text will assume that each sentence ends in two
spaces, and will try to preserve that spacing.  If set to false, all
consecutive whitespace in non-verbatim paragraphs is compressed into a
single space.  Defaults to true.

=item width

The column at which to wrap text on the right-hand side.  Defaults to 76.

=back

The standard Pod::Parser method parse_from_filehandle() takes up to two
arguments, the first being the file handle to read POD from and the second
being the file handle to write the formatted output to.  The first defaults
to STDIN if not given, and the second defaults to STDOUT.  The method
parse_from_file() is almost identical, except that its two arguments are the
input and output disk files instead.  See L<Pod::Parser> for the specific
details.

=head1 DIAGNOSTICS

=over 4

=item Bizarre space in item

(W) Something has gone wrong in internal C<=item> processing.  This message
indicates a bug in Pod::Text; you should never see it.

=item Can't open %s for reading: %s

(F) Pod::Text was invoked via the compatibility mode pod2text() interface
and the input file it was given could not be opened.

=item Invalid quote specification "%s"

(F) The quote specification given (the quotes option to the constructor) was
invalid.  A quote specification must be one, two, or four characters long.

=item %s:%d: Unknown command paragraph "%s".

(W) The POD source contained a non-standard command paragraph (something of
the form C<=command args>) that Pod::Man didn't know about.  It was ignored.

=item Unknown escape: %s

(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::Text didn't
know about.

=item Unknown sequence: %s

(W) The POD source contained a non-standard internal sequence (something of
the form C<XE<lt>E<gt>>) that Pod::Text didn't know about.

=item Unmatched =back

(W) Pod::Text encountered a C<=back> command that didn't correspond to an
C<=over> command.

=back

=head1 RESTRICTIONS

Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
output, due to an internal implementation detail.

=head1 NOTES

This is a replacement for an earlier Pod::Text module written by Tom
Christiansen.  It has a revamped interface, since it now uses Pod::Parser,
but an interface roughly compatible with the old Pod::Text::pod2text()
function is still available.  Please change to the new calling convention,
though.

The original Pod::Text contained code to do formatting via termcap
sequences, although it wasn't turned on by default and it was problematic to
get it to work at all.  This rewrite doesn't even try to do that, but a
subclass of it does.  Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.

=head1 SEE ALSO

L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
pod2text(1)

=head1 AUTHOR

Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and
its conversion to Pod::Parser by Brad Appleton
E<lt>bradapp@enteract.comE<gt>.

=cut
g conventions:

=over

=item C<++> and C<-->

The routines which implement these operators are expected to actually
I<mutate> their arguments.  So, assuming that $obj is a reference to a
number,

  sub incr { my $n = $ {$_[0]}; ++$n; $_[0] = bless \$n}

is an appropriate implementation of overloaded C<++>.  Note that

  sub incr { ++$ {$_[0]} ; shift }

is OK if used with preincrement and with postincrement. (In the case
of postincrement a copying will be performed                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #############################################################################
# Pod/Usage.pm -- print usage messages for the running script.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::Usage;

use vars qw($VERSION);
$VERSION = 1.14;  ## Current version of this package
require  5.005;    ## requires this Perl version or later

=head1 NAME

Pod::Usage, pod2usage() - print a usage message from embedded pod documentation

=head1 SYNOPSIS

  use Pod::Usage

  my $message_text  = "This text precedes the usage message.";
  my $exit_status   = 2;          ## The exit status to use
  my $verbose_level = 0;          ## The verbose level to use
  my $filehandle    = \*STDERR;   ## The filehandle to write to

  pod2usage($message_text);

  pod2usage($exit_status);

  pod2usage( { -message => $message_text ,
               -exitval => $exit_status  ,  
               -verbose => $verbose_level,  
               -output  => $filehandle } );

  pod2usage(   -msg     => $message_text ,
               -exitval => $exit_status  ,  
               -verbose => $verbose_level,  
               -output  => $filehandle   );

=head1 ARGUMENTS

B<pod2usage> should be given either a single argument, or a list of
arguments corresponding to an associative array (a "hash"). When a single
argument is given, it should correspond to exactly one of the following:

=over 4

=item *

A string containing the text of a message to print I<before> printing
the usage message

=item *

A numeric value corresponding to the desired exit status

=item *

A reference to a hash

=back

If more than one argument is given then the entire argument list is
assumed to be a hash.  If a hash is supplied (either as a reference or
as a list) it should contain one or more elements with the following
keys:

=over 4

=item C<-message>

=item C<-msg>

The text of a message to print immediately prior to printing the
program's usage message. 

=item C<-exitval>

The desired exit status to pass to the B<exit()> function.
This should be an integer, or else the string "NOEXIT" to
indicate that control should simply be returned without
terminating the invoking process.

=item C<-verbose>

The desired level of "verboseness" to use when printing the usage
message. If the corresponding value is 0, then only the "SYNOPSIS"
section of the pod documentation is printed. If the corresponding value
is 1, then the "SYNOPSIS" section, along with any section entitled
"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed.  If the
corresponding value is 2 or more then the entire manpage is printed.

=item C<-output>

A reference to a filehandle, or the pathname of a file to which the
usage message should be written. The default is C<\*STDERR> unless the
exit value is less than 2 (in which case the default is C<\*STDOUT>).

=item C<-input>

A reference to a filehandle, or the pathname of a file from which the
invoking script's pod documentation should be read.  It defaults to the
file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).

=item C<-pathlist>

A list of directory paths. If the input file does not exist, then it
will be searched for in the given directory list (in the order the
directories appear in the list). It defaults to the list of directories
implied by C<$ENV{PATH}>. The list may be specified either by a reference
to an array, or by a string of directory paths which use the same path
separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
MSWin32 and DOS).

=back

=head1 DESCRIPTION

B<pod2usage> will print a usage message for the invoking script (using
its embedded pod documentation) and then exit the script with the
desired exit status. The usage message printed may have any one of three
levels of "verboseness": If the verbose level is 0, then only a synopsis
is printed. If the verbose level is 1, then the synopsis is printed
along with a description (if present) of the command line options and
arguments. If the verbose level is 2, then the entire manual page is
printed.

Unless they are explicitly specified, the default values for the exit
status, verbose level, and output stream to use are determined as
follows:

=over 4

=item *

If neither the exit status nor the verbose level is specified, then the
default is to use an exit status of 2 with a verbose level of 0.

=item *

If an exit status I<is> specified but the verbose level is I<not>, then the
verbose level will default to 1 if the exit status is less than 2 and
will default to 0 otherwise.

=item *

If an exit status is I<not> specified but verbose level I<is> given, then
the exit status will default to 2 if the verbose level is 0 and will
default to 1 otherwise.

=item *

If the exit status used is less than 2, then output is printed on
C<STDOUT>.  Otherwise output is printed on C<STDERR>.

=back

Although the above may seem a bit confusing at first, it generally does
"the right thing" in most situations.  This determination of the default
values to use is based upon the following typical Unix conventions:

=over 4

=item *

An exit status of 0 implies "success". For example, B<diff(1)> exits
with a status of 0 if the two files have the same contents.

=item *

An exit status of 1 implies possibly abnormal, but non-defective, program
termination.  For example, B<grep(1)> exits with a status of 1 if
it did I<not> find a matching line for the given regular expression.

=item *

An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
exits with a status of 2 if you specify an illegal (unknown) option on
the command line.

=item *

Usage messages issued as a result of bad command-line syntax should go
to C<STDERR>.  However, usage messages issued due to an explicit request
to print usage (like specifying B<-help> on the command line) should go
to C<STDOUT>, just in case the user wants to pipe the output to a pager
(such as B<more(1)>).

=item *

If program usage has been explicitly requested by the user, it is often
desireable to exit with a status of 1 (as opposed to 0) after issuing
the user-requested usage message.  It is also desireable to give a
more verbose description of program usage in this case.

=back

B<pod2usage> doesn't force the above conventions upon you, but it will
use them by default if you don't expressly tell it to do otherwise.  The
ability of B<pod2usage()> to accept a single number or a string makes it
convenient to use as an innocent looking error message handling function:

    use Pod::Usage;
    use Getopt::Long;

    ## Parse options
    GetOptions("help", "man", "flag1")  ||  pod2usage(2);
    pod2usage(1)  if ($opt_help);
    pod2usage(-verbose => 2)  if ($opt_man);

    ## Check for too many filenames
    pod2usage("$0: Too many files given.\n")  if (@ARGV > 1);

Some user's however may feel that the above "economy of expression" is
not particularly readable nor consistent and may instead choose to do
something more like the following:

    use Pod::Usage;
    use Getopt::Long;

    ## Parse options
    GetOptions("help", "man", "flag1")  ||  pod2usage(-verbose => 0);
    pod2usage(-verbose => 1)  if ($opt_help);
    pod2usage(-verbose => 2)  if ($opt_man);

    ## Check for too many filenames
    pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
        if (@ARGV > 1);

As with all things in Perl, I<there's more than one way to do it>, and
B<pod2usage()> adheres to this philosophy.  If you are interested in
seeing a number of different ways to invoke B<pod2usage> (although by no
means exhaustive), please refer to L<"EXAMPLES">.

=head1 EXAMPLES

Each of the following invocations of C<pod2usage()> will print just the
"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:

    pod2usage();

    pod2usage(2);

    pod2usage(-verbose => 0);

    pod2usage(-exitval => 2);

    pod2usage({-exitval => 2, -output => \*STDERR});

    pod2usage({-verbose => 0, -output  => \*STDERR});

    pod2usage(-exitval => 2, -verbose => 0);

    pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);

Each of the following invocations of C<pod2usage()> will print a message
of "Syntax error." (followed by a newline) to C<STDERR>, immediately
followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
will exit with a status of 2:

    pod2usage("Syntax error.");

    pod2usage(-message => "Syntax error.", -verbose => 0);

    pod2usage(-msg  => "Syntax error.", -exitval => 2);

    pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});

    pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});

    pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);

    pod2usage(-message => "Syntax error.",
              -exitval => 2,
              -verbose => 0,
              -output  => \*STDERR);

Each of the following invocations of C<pod2usage()> will print the
"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
C<STDOUT> and will exit with a status of 1:

    pod2usage(1);

    pod2usage(-verbose => 1);

    pod2usage(-exitval => 1);

    pod2usage({-exitval => 1, -output => \*STDOUT});

    pod2usage({-verbose => 1, -output => \*STDOUT});

    pod2usage(-exitval => 1, -verbose => 1);

    pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});

Each of the following invocations of C<pod2usage()> will print the
entire manual page to C<STDOUT> and will exit with a status of 1:

    pod2usage(-verbose  => 2);

    pod2usage({-verbose => 2, -output => \*STDOUT});

    pod2usage(-exitval  => 1, -verbose => 2);

    pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});

=head2 Recommended Use

Most scripts should print some type of usage message to C<STDERR> when a
command line syntax error is detected. They should also provide an
option (usually C<-H> or C<-help>) to print a (possibly more verbose)
usage message to C<STDOUT>. Some scripts may even wish to go so far as to
provide a means of printing their complete documentation to C<STDOUT>
(perhaps by allowing a C<-man> option). The following complete example
uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
things:

    use Getopt::Long;
    use Pod::Usage;

    my $man = 0;
    my $help = 0;
    ## Parse options and print usage if there is a syntax error,
    ## or if usage was explicitly requested.
    GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
    pod2usage(1) if $help;
    pod2usage(-verbose => 2) if $man;

    ## If no arguments were given, then allow STDIN to be used only
    ## if it's not connected to a terminal (otherwise print usage)
    pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
    __END__

    =head1 NAME

    sample - Using GetOpt::Long and Pod::Usage

    =head1 SYNOPSIS

    sample [options] [file ...]

     Options:
       -help            brief help message
       -man             full documentation

    =head1 OPTIONS

    =over 8

    =item B<-help>

    Print a brief help message and exits.

    =item B<-man>

    Prints the manual page and exits.

    =back

    =head1 DESCRIPTION

    B<This program> will read the given input file(s) and do something
    useful with the contents thereof.

    =cut

=head1 CAVEATS

By default, B<pod2usage()> will use C<$0> as the path to the pod input
file.  Unfortunately, not all systems on which Perl runs will set C<$0>
properly (although if C<$0> isn't found, B<pod2usage()> will search
C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
If this is the case for your system, you may need to explicitly specify
the path to the pod docs for the invoking script using something
similar to the following:

    pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");

=head1 AUTHOR

Brad Appleton E<lt>bradapp@enteract.comE<gt>

Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>

=head1 ACKNOWLEDGEMENTS

Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
with re-writing this manpage.

=cut

#############################################################################

use strict;
#use diagnostics;
use Carp;
use Config;
use Exporter;
use File::Spec;

use vars qw(@ISA @EXPORT);
@EXPORT = qw(&pod2usage);
BEGIN {
    if ( $] >= 5.005_58 ) {
       require Pod::Text;
       @ISA = qw( Pod::Text );
    }
    else {
       require Pod::PlainText;
       @ISA = qw( Pod::PlainText );
    }
}


##---------------------------------------------------------------------------

##---------------------------------
## Function definitions begin here
##---------------------------------

sub pod2usage {
    local($_) = shift || "";
    my %opts;
    ## Collect arguments
    if (@_ > 0) {
        ## Too many arguments - assume that this is a hash and
        ## the user forgot to pass a reference to it.
        %opts = ($_, @_);
    }
    elsif (ref $_) {
        ## User passed a ref to a hash
        %opts = %{$_}  if (ref($_) eq 'HASH');
    }
    elsif (/^[-+]?\d+$/) {
        ## User passed in the exit value to use
        $opts{"-exitval"} =  $_;
    }
    else {
        ## User passed in a message to print before issuing usage.
        $_  and  $opts{"-message"} = $_;
    }

    ## Need this for backward compatibility since we formerly used
    ## options that were all uppercase words rather than ones that
    ## looked like Unix command-line options.
    ## to be uppercase keywords)
    %opts = map {
        my $val = $opts{$_};
        s/^(?=\w)/-/;
        /^-msg/i   and  $_ = '-message';
        /^-exit/i  and  $_ = '-exitval';
        lc($_) => $val;    
    } (keys %opts);

    ## Now determine default -exitval and -verbose values to use
    if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
        $opts{"-exitval"} = 2;
        $opts{"-verbose"} = 0;
    }
    elsif (! defined $opts{"-exitval"}) {
        $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
    }
    elsif (! defined $opts{"-verbose"}) {
        $opts{"-verbose"} = ($opts{"-exitval"} < 2);
    }

    ## Default the output file
    $opts{"-output"} = ($opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
            unless (defined $opts{"-output"});
    ## Default the input file
    $opts{"-input"} = $0  unless (defined $opts{"-input"});

    ## Look up input file in path if it doesnt exist.
    unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
        my ($dirname, $basename) = ('', $opts{"-input"});
        my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
                            : (($^O eq 'MacOS') ? ',' :  ":");
        my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};

        my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
        for $dirname (@paths) {
            $_ = File::Spec->catfile($dirname, $basename)  if length;
            last if (-e $_) && ($opts{"-input"} = $_);
        }
    }

    ## Now create a pod reader and constrain it to the desired sections.
    my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
    if ($opts{"-verbose"} == 0) {
        $parser->select("SYNOPSIS");
    }
    elsif ($opts{"-verbose"} == 1) {
        my $opt_re = '(?i)' .
                     '(?:OPTIONS|ARGUMENTS)' .
                     '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
        $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
    }

    ## Now translate the pod document and then exit with the desired status
    if ( $opts{"-verbose"} >= 2 
             and  !ref($opts{"-input"})
             and  $opts{"-output"} == \*STDOUT )
    {
       ## spit out the entire PODs. Might as well invoke perldoc
       my $progpath = File::Spec->catfile($Config{bin}, "perldoc");
       system($progpath, $opts{"-input"});
    }
    else {
       $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
    }

    exit($opts{"-exitval"})  unless (lc($opts{"-exitval"}) eq 'noexit');
}

##---------------------------------------------------------------------------

##-------------------------------
## Method definitions begin here
##-------------------------------

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    $self->initialize();
    return $self;
}

sub begin_pod {
    my $self = shift;
    $self->SUPER::begin_pod();  ## Have to call superclass
    my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
    my $out_fh = $self->output_handle();
    print $out_fh "$msg\n";
}

sub preprocess_paragraph {
    my $self = shift;
    local $_ = shift;
    my $line = shift;
    ## See if this is a heading and we arent printing the entire manpage.
    if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
        ## Change the title of the SYNOPSIS section to USAGE
        s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
        ## Try to do some lowercasing instead of all-caps in headings
        s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
        ## Use a colon to end all headings
        s/\s*$/:/  unless (/:\s*$/);
        $_ .= "\n";
    }
    return  $self->SUPER::preprocess_paragraph($_);
}

s the cache table if the package is overloaded.

Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
carried out before any operation that can imply an assignment to the
object $a (or $b) refers to, like C<$a++>.  You can override this
behavior by defining your own copy constructor (see L<"Copy Constructor">).

It is expected that arguments to methods that are not explicitly supposed
to be changed are constant (but this is n                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package POSIX;

our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD) = ();

use AutoLoader;

use XSLoader ();

our $VERSION = "1.03" ;

# Grandfather old foo_h form to new :foo_h form
my $loaded;

sub import {
    load_imports() unless $loaded++;
    my $this = shift;
    my @list = map { m/^\w+_h$/ ? ":$_" : $_ } @_;
    local $Exporter::ExportLevel = 1;
    Exporter::import($this,@list);
}

sub croak { require Carp;  goto &Carp::croak }

XSLoader::load 'POSIX', $VERSION;

my $EINVAL = constant("EINVAL", 0);
my $EAGAIN = constant("EAGAIN", 0);

sub AUTOLOAD {
    if ($AUTOLOAD =~ /::(_?[a-z])/) {
	# require AutoLoader;
	$AutoLoader::AUTOLOAD = $AUTOLOAD;
	goto &AutoLoader::AUTOLOAD
    }
    local $! = 0;
    my $constname = $AUTOLOAD;
    $constname =~ s/.*:://;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! == 0) {
	*$AUTOLOAD = sub { $val };
    }
    elsif ($! == $EAGAIN) {	# Not really a constant, so always call.
	*$AUTOLOAD = sub { constant($constname, $_[0]) };
    }
    elsif ($! == $EINVAL) {
	croak "$constname is not a valid POSIX macro";
    }
    else {
	croak "Your vendor has not defined POSIX macro $constname, used";
    }

    goto &$AUTOLOAD;
}

sub usage { 
    my ($mess) = @_;
    croak "Usage: POSIX::$mess";
}

sub redef { 
    my ($mess) = @_;
    croak "Use method $mess instead";
}

sub unimpl { 
    my ($mess) = @_;
    $mess =~ s/xxx//;
    croak "Unimplemented: POSIX::$mess";
}

############################
package POSIX::SigAction;

sub new {
    bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0}, $_[0];
}

############################
package POSIX; # return to package POSIX so AutoSplit is happy
1;
__END__

sub assert {
    usage "assert(expr)" if @_ != 1;
    if (!$_[0]) {
	croak "Assertion failed";
    }
}

sub tolower {
    usage "tolower(string)" if @_ != 1;
    lc($_[0]);
}

sub toupper {
    usage "toupper(string)" if @_ != 1;
    uc($_[0]);
}

sub closedir {
    usage "closedir(dirhandle)" if @_ != 1;
    CORE::closedir($_[0]);
}

sub opendir {
    usage "opendir(directory)" if @_ != 1;
    my $dirhandle;
    CORE::opendir($dirhandle, $_[0])
	? $dirhandle
	: undef;
}

sub readdir {
    usage "readdir(dirhandle)" if @_ != 1;
    CORE::readdir($_[0]);
}

sub rewinddir {
    usage "rewinddir(dirhandle)" if @_ != 1;
    CORE::rewinddir($_[0]);
}

sub errno {
    usage "errno()" if @_ != 0;
    $! + 0;
}

sub creat {
    usage "creat(filename, mode)" if @_ != 2;
    &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[1]);
}

sub fcntl {
    usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
    CORE::fcntl($_[0], $_[1], $_[2]);
}

sub getgrgid {
    usage "getgrgid(gid)" if @_ != 1;
    CORE::getgrgid($_[0]);
}

sub getgrnam {
    usage "getgrnam(name)" if @_ != 1;
    CORE::getgrnam($_[0]);
}

sub atan2 {
    usage "atan2(x,y)" if @_ != 2;
    CORE::atan2($_[0], $_[1]);
}

sub cos {
    usage "cos(x)" if @_ != 1;
    CORE::cos($_[0]);
}

sub exp {
    usage "exp(x)" if @_ != 1;
    CORE::exp($_[0]);
}

sub fabs {
    usage "fabs(x)" if @_ != 1;
    CORE::abs($_[0]);
}

sub log {
    usage "log(x)" if @_ != 1;
    CORE::log($_[0]);
}

sub pow {
    usage "pow(x,exponent)" if @_ != 2;
    $_[0] ** $_[1];
}

sub sin {
    usage "sin(x)" if @_ != 1;
    CORE::sin($_[0]);
}

sub sqrt {
    usage "sqrt(x)" if @_ != 1;
    CORE::sqrt($_[0]);
}

sub getpwnam {
    usage "getpwnam(name)" if @_ != 1;
    CORE::getpwnam($_[0]);
}

sub getpwuid {
    usage "getpwuid(uid)" if @_ != 1;
    CORE::getpwuid($_[0]);
}

sub longjmp {
    unimpl "longjmp() is C-specific: use die instead";
}

sub setjmp {
    unimpl "setjmp() is C-specific: use eval {} instead";
}

sub siglongjmp {
    unimpl "siglongjmp() is C-specific: use die instead";
}

sub sigsetjmp {
    unimpl "sigsetjmp() is C-specific: use eval {} instead";
}

sub kill {
    usage "kill(pid, sig)" if @_ != 2;
    CORE::kill $_[1], $_[0];
}

sub raise {
    usage "raise(sig)" if @_ != 1;
    CORE::kill $_[0], $$;	# Is this good enough?
}

sub offsetof {
    unimpl "offsetof() is C-specific, stopped";
}

sub clearerr {
    redef "IO::Handle::clearerr()";
}

sub fclose {
    redef "IO::Handle::close()";
}

sub fdopen {
    redef "IO::Handle::new_from_fd()";
}

sub feof {
    redef "IO::Handle::eof()";
}

sub fgetc {
    redef "IO::Handle::getc()";
}

sub fgets {
    redef "IO::Handle::gets()";
}

sub fileno {
    redef "IO::Handle::fileno()";
}

sub fopen {
    redef "IO::File::open()";
}

sub fprintf {
    unimpl "fprintf() is C-specific--use printf instead";
}

sub fputc {
    unimpl "fputc() is C-specific--use print instead";
}

sub fputs {
    unimpl "fputs() is C-specific--use print instead";
}

sub fread {
    unimpl "fread() is C-specific--use read instead";
}

sub freopen {
    unimpl "freopen() is C-specific--use open instead";
}

sub fscanf {
    unimpl "fscanf() is C-specific--use <> and regular expressions instead";
}

sub fseek {
    redef "IO::Seekable::seek()";
}

sub ferror {
    redef "IO::Handle::error()";
}

sub fflush {
    redef "IO::Handle::flush()";
}

sub fgetpos {
    redef "IO::Seekable::getpos()";
}

sub fsetpos {
    redef "IO::Seekable::setpos()";
}

sub ftell {
    redef "IO::Seekable::tell()";
}

sub fwrite {
    unimpl "fwrite() is C-specific--use print instead";
}

sub getc {
    usage "getc(handle)" if @_ != 1;
    CORE::getc($_[0]);
}

sub getchar {
    usage "getchar()" if @_ != 0;
    CORE::getc(STDIN);
}

sub gets {
    usage "gets()" if @_ != 0;
    scalar <STDIN>;
}

sub perror {
    print STDERR "@_: " if @_;
    print STDERR $!,"\n";
}

sub printf {
    usage "printf(pattern, args...)" if @_ < 1;
    CORE::printf STDOUT @_;
}

sub putc {
    unimpl "putc() is C-specific--use print instead";
}

sub putchar {
    unimpl "putchar() is C-specific--use print instead";
}

sub puts {
    unimpl "puts() is C-specific--use print instead";
}

sub remove {
    usage "remove(filename)" if @_ != 1;
    CORE::unlink($_[0]);
}

sub rename {
    usage "rename(oldfilename, newfilename)" if @_ != 2;
    CORE::rename($_[0], $_[1]);
}

sub rewind {
    usage "rewind(filehandle)" if @_ != 1;
    CORE::seek($_[0],0,0);
}

sub scanf {
    unimpl "scanf() is C-specific--use <> and regular expressions instead";
}

sub sprintf {
    usage "sprintf(pattern,args)" if @_ == 0;
    CORE::sprintf(shift,@_);
}

sub sscanf {
    unimpl "sscanf() is C-specific--use regular expressions instead";
}

sub tmpfile {
    redef "IO::File::new_tmpfile()";
}

sub ungetc {
    redef "IO::Handle::ungetc()";
}

sub vfprintf {
    unimpl "vfprintf() is C-specific";
}

sub vprintf {
    unimpl "vprintf() is C-specific";
}

sub vsprintf {
    unimpl "vsprintf() is C-specific";
}

sub abs {
    usage "abs(x)" if @_ != 1;
    CORE::abs($_[0]);
}

sub atexit {
    unimpl "atexit() is C-specific: use END {} instead";
}

sub atof {
    unimpl "atof() is C-specific, stopped";
}

sub atoi {
    unimpl "atoi() is C-specific, stopped";
}

sub atol {
    unimpl "atol() is C-specific, stopped";
}

sub bsearch {
    unimpl "bsearch() not supplied";
}

sub calloc {
    unimpl "calloc() is C-specific, stopped";
}

sub div {
    unimpl "div() is C-specific, stopped";
}

sub exit {
    usage "exit(status)" if @_ != 1;
    CORE::exit($_[0]);
}

sub free {
    unimpl "free() is C-specific, stopped";
}

sub getenv {
    usage "getenv(name)" if @_ != 1;
    $ENV{$_[0]};
}

sub labs {
    unimpl "labs() is C-specific, use abs instead";
}

sub ldiv {
    unimpl "ldiv() is C-specific, use / and int instead";
}

sub malloc {
    unimpl "malloc() is C-specific, stopped";
}

sub qsort {
    unimpl "qsort() is C-specific, use sort instead";
}

sub rand {
    unimpl "rand() is non-portable, use Perl's rand instead";
}

sub realloc {
    unimpl "realloc() is C-specific, stopped";
}

sub srand {
    unimpl "srand()";
}

sub system {
    usage "system(command)" if @_ != 1;
    CORE::system($_[0]);
}

sub memchr {
    unimpl "memchr() is C-specific, use index() instead";
}

sub memcmp {
    unimpl "memcmp() is C-specific, use eq instead";
}

sub memcpy {
    unimpl "memcpy() is C-specific, use = instead";
}

sub memmove {
    unimpl "memmove() is C-specific, use = instead";
}

sub memset {
    unimpl "memset() is C-specific, use x instead";
}

sub strcat {
    unimpl "strcat() is C-specific, use .= instead";
}

sub strchr {
    unimpl "strchr() is C-specific, use index() instead";
}

sub strcmp {
    unimpl "strcmp() is C-specific, use eq instead";
}

sub strcpy {
    unimpl "strcpy() is C-specific, use = instead";
}

sub strcspn {
    unimpl "strcspn() is C-specific, use regular expressions instead";
}

sub strerror {
    usage "strerror(errno)" if @_ != 1;
    local $! = $_[0];
    $! . "";
}

sub strlen {
    unimpl "strlen() is C-specific, use length instead";
}

sub strncat {
    unimpl "strncat() is C-specific, use .= instead";
}

sub strncmp {
    unimpl "strncmp() is C-specific, use eq instead";
}

sub strncpy {
    unimpl "strncpy() is C-specific, use = instead";
}

sub strpbrk {
    unimpl "strpbrk() is C-specific, stopped";
}

sub strrchr {
    unimpl "strrchr() is C-specific, use rindex() instead";
}

sub strspn {
    unimpl "strspn() is C-specific, stopped";
}

sub strstr {
    usage "strstr(big, little)" if @_ != 2;
    CORE::index($_[0], $_[1]);
}

sub strtok {
    unimpl "strtok() is C-specific, stopped";
}

sub chmod {
    usage "chmod(mode, filename)" if @_ != 2;
    CORE::chmod($_[0], $_[1]);
}

sub fstat {
    usage "fstat(fd)" if @_ != 1;
    local *TMP;
    CORE::open(TMP, "<&$_[0]");		# Gross.
    my @l = CORE::stat(TMP);
    CORE::close(TMP);
    @l;
}

sub mkdir {
    usage "mkdir(directoryname, mode)" if @_ != 2;
    CORE::mkdir($_[0], $_[1]);
}

sub stat {
    usage "stat(filename)" if @_ != 1;
    CORE::stat($_[0]);
}

sub umask {
    usage "umask(mask)" if @_ != 1;
    CORE::umask($_[0]);
}

sub wait {
    usage "wait()" if @_ != 0;
    CORE::wait();
}

sub waitpid {
    usage "waitpid(pid, options)" if @_ != 2;
    CORE::waitpid($_[0], $_[1]);
}

sub gmtime {
    usage "gmtime(time)" if @_ != 1;
    CORE::gmtime($_[0]);
}

sub localtime {
    usage "localtime(time)" if @_ != 1;
    CORE::localtime($_[0]);
}

sub time {
    usage "time()" if @_ != 0;
    CORE::time;
}

sub alarm {
    usage "alarm(seconds)" if @_ != 1;
    CORE::alarm($_[0]);
}

sub chdir {
    usage "chdir(directory)" if @_ != 1;
    CORE::chdir($_[0]);
}

sub chown {
    usage "chown(filename, uid, gid)" if @_ != 3;
    CORE::chown($_[0], $_[1], $_[2]);
}

sub execl {
    unimpl "execl() is C-specific, stopped";
}

sub execle {
    unimpl "execle() is C-specific, stopped";
}

sub execlp {
    unimpl "execlp() is C-specific, stopped";
}

sub execv {
    unimpl "execv() is C-specific, stopped";
}

sub execve {
    unimpl "execve() is C-specific, stopped";
}

sub execvp {
    unimpl "execvp() is C-specific, stopped";
}

sub fork {
    usage "fork()" if @_ != 0;
    CORE::fork;
}

sub getcwd
{
    usage "getcwd()" if @_ != 0;
    if ($^O eq 'MSWin32') {
	# this perhaps applies to everyone else also?
	require Cwd;
	$cwd = &Cwd::cwd;
    }
    else {
	chop($cwd = `pwd`);
    }
    $cwd;
}

sub getegid {
    usage "getegid()" if @_ != 0;
    $) + 0;
}

sub geteuid {
    usage "geteuid()" if @_ != 0;
    $> + 0;
}

sub getgid {
    usage "getgid()" if @_ != 0;
    $( + 0;
}

sub getgroups {
    usage "getgroups()" if @_ != 0;
    my %seen;
    grep(!$seen{$_}++, split(' ', $) ));
}

sub getlogin {
    usage "getlogin()" if @_ != 0;
    CORE::getlogin();
}

sub getpgrp {
    usage "getpgrp()" if @_ != 0;
    CORE::getpgrp;
}

sub getpid {
    usage "getpid()" if @_ != 0;
    $$;
}

sub getppid {
    usage "getppid()" if @_ != 0;
    CORE::getppid;
}

sub getuid {
    usage "getuid()" if @_ != 0;
    $<;
}

sub isatty {
    usage "isatty(filehandle)" if @_ != 1;
    -t $_[0];
}

sub link {
    usage "link(oldfilename, newfilename)" if @_ != 2;
    CORE::link($_[0], $_[1]);
}

sub rmdir {
    usage "rmdir(directoryname)" if @_ != 1;
    CORE::rmdir($_[0]);
}

sub setbuf {
    redef "IO::Handle::setbuf()";
}

sub setgid {
    usage "setgid(gid)" if @_ != 1;
    $( = $_[0];
}

sub setuid {
    usage "setuid(uid)" if @_ != 1;
    $< = $_[0];
}

sub setvbuf {
    redef "IO::Handle::setvbuf()";
}

sub sleep {
    usage "sleep(seconds)" if @_ != 1;
    CORE::sleep($_[0]);
}

sub unlink {
    usage "unlink(filename)" if @_ != 1;
    CORE::unlink($_[0]);
}

sub utime {
    usage "utime(filename, atime, mtime)" if @_ != 3;
    CORE::utime($_[1], $_[2], $_[0]);
}

sub load_imports {
%EXPORT_TAGS = (

    assert_h =>	[qw(assert NDEBUG)],

    ctype_h =>	[qw(isalnum isalpha iscntrl isdigit isgraph islower
		isprint ispunct isspace isupper isxdigit tolower toupper)],

    dirent_h =>	[qw()],

    errno_h =>	[qw(E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT
		EAGAIN EALREADY EBADF EBUSY ECHILD ECONNABORTED
		ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT
		EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS
		EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK
		EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH
		ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
		ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
		ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM
		EPFNOSUPPORT EPIPE EPROCLIM EPROTONOSUPPORT EPROTOTYPE
		ERANGE EREMOTE ERESTART EROFS ESHUTDOWN ESOCKTNOSUPPORT
		ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
		EUSERS EWOULDBLOCK EXDEV errno)],

    fcntl_h =>	[qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK
		F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK
		O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK
		O_RDONLY O_RDWR O_TRUNC O_WRONLY
		creat
		SEEK_CUR SEEK_END SEEK_SET
		S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID
		S_IWGRP S_IWOTH S_IWUSR)],

    float_h =>	[qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG
		DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP
		DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
		FLT_DIG FLT_EPSILON FLT_MANT_DIG
		FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP
		FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP
		FLT_RADIX FLT_ROUNDS
		LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG
		LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP
		LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)],

    grp_h =>	[qw()],

    limits_h =>	[qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
		INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON
		MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX
		PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN
		SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX
		ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX
		_POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT
		_POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX
		_POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
		_POSIX_STREAM_MAX _POSIX_TZNAME_MAX)],

    locale_h =>	[qw(LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES LC_MONETARY
		LC_NUMERIC LC_TIME NULL localeconv setlocale)],

    math_h =>	[qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod
		frexp ldexp log10 modf pow sinh tan tanh)],

    pwd_h =>	[qw()],

    setjmp_h =>	[qw(longjmp setjmp siglongjmp sigsetjmp)],

    signal_h =>	[qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK
		SA_RESETHAND SA_RESTART SA_SIGINFO SIGABRT SIGALRM
		SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL
		SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN
		SIGTTOU SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR
		SIG_IGN SIG_SETMASK SIG_UNBLOCK raise sigaction signal
		sigpending sigprocmask sigsuspend)],

    stdarg_h =>	[qw()],

    stddef_h =>	[qw(NULL offsetof)],

    stdio_h =>	[qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid
		L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET
		STREAM_MAX TMP_MAX stderr stdin stdout
		clearerr fclose fdopen feof ferror fflush fgetc fgetpos
		fgets fopen fprintf fputc fputs fread freopen
		fscanf fseek fsetpos ftell fwrite getchar gets
		perror putc putchar puts remove rewind
		scanf setbuf setvbuf sscanf tmpfile tmpnam
		ungetc vfprintf vprintf vsprintf)],

    stdlib_h =>	[qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
		abort atexit atof atoi atol bsearch calloc div
		free getenv labs ldiv malloc mblen mbstowcs mbtowc
		qsort realloc strtod strtol strtoul wcstombs wctomb)],

    string_h =>	[qw(NULL memchr memcmp memcpy memmove memset strcat
		strchr strcmp strcoll strcpy strcspn strerror strlen
		strncat strncmp strncpy strpbrk strrchr strspn strstr
		strtok strxfrm)],

    sys_stat_h => [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU
		S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG
		S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR
		fstat mkfifo)],

    sys_times_h => [qw()],

    sys_types_h => [qw()],

    sys_utsname_h => [qw(uname)],

    sys_wait_h => [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
		WNOHANG WSTOPSIG WTERMSIG WUNTRACED)],

    termios_h => [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400
		B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL
		CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK
		ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR
		INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST
		PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION
		TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
		TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART
		VSTOP VSUSP VTIME
		cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain
		tcflow tcflush tcgetattr tcsendbreak tcsetattr )],

    time_h =>	[qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime
		difftime mktime strftime tzset tzname)],

    unistd_h =>	[qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET
		STDERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK
		_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON
		_PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX
		_PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED
		_POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS
		_POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX
		_SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL
		_SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS
		_SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION
		_exit access ctermid cuserid
		dup2 dup execl execle execlp execv execve execvp
		fpathconf getcwd getegid geteuid getgid getgroups
		getpid getuid isatty lseek pathconf pause setgid setpgid
		setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)],

    utime_h =>	[qw()],

);

# Exporter::export_tags();
for (values %EXPORT_TAGS) {
  push @EXPORT, @$_;
}

@EXPORT_OK = qw(
    closedir opendir readdir rewinddir
    fcntl open
    getgrgid getgrnam
    atan2 cos exp log sin sqrt
    getpwnam getpwuid
    kill
    fileno getc printf rename sprintf
    abs exit rand srand system
    chmod mkdir stat umask
    times
    wait waitpid
    gmtime localtime time 
    alarm chdir chown close fork getlogin getppid getpgrp link
	pipe read rmdir sleep unlink write
    utime
    nice
);

require Exporter;
}
led with names
looking like line-noise.

For the purpose of inheritance every overloaded package behaves as if
C<fallback> is present (p                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                =head1 NAME

POSIX - Perl interface to IEEE Std 1003.1

=head1 SYNOPSIS

    use POSIX;
    use POSIX qw(setsid);
    use POSIX qw(:errno_h :fcntl_h);

    printf "EINTR is %d\n", EINTR;

    $sess_id = POSIX::setsid();

    $fd = POSIX::open($path, O_CREAT|O_EXCL|O_WRONLY, 0644);
	# note: that's a filedescriptor, *NOT* a filehandle

=head1 DESCRIPTION

The POSIX module permits you to access all (or nearly all) the standard
POSIX 1003.1 identifiers.  Many of these identifiers have been given Perl-ish
interfaces.  Things which are C<#defines> in C, like EINTR or O_NDELAY, are
automatically exported into your namespace.  All functions are only exported
if you ask for them explicitly.  Most likely people will prefer to use the
fully-qualified function names.

This document gives a condensed list of the features available in the POSIX
module.  Consult your operating system's manpages for general information on
most features.  Consult L<perlfunc> for functions which are noted as being
identical to Perl's builtin functions.

The first section describes POSIX functions from the 1003.1 specification.
The second section describes some classes for signal objects, TTY objects,
and other miscellaneous objects.  The remaining sections list various
constants and macros in an organization which roughly follows IEEE Std
1003.1b-1993.

=head1 NOTE

The POSIX module is probably the most complex Perl module supplied with
the standard distribution.  It incorporates autoloading, namespace games,
and dynamic loading of code that's in Perl, C, or both.  It's a great
source of wisdom.

=head1 CAVEATS 

A few functions are not implemented because they are C specific.  If you
attempt to call these, they will print a message telling you that they
aren't implemented, and suggest using the Perl equivalent should one
exist.  For example, trying to access the setjmp() call will elicit the
message "setjmp() is C-specific: use eval {} instead".

Furthermore, some evil vendors will claim 1003.1 compliance, but in fact
are not so: they will not pass the PCTS (POSIX Compliance Test Suites).
For example, one vendor may not define EDEADLK, or the semantics of the
errno values set by open(2) might not be quite right.  Perl does not
attempt to verify POSIX compliance.  That means you can currently
successfully say "use POSIX",  and then later in your program you find
that your vendor has been lax and there's no usable ICANON macro after
all.  This could be construed to be a bug.

=head1 FUNCTIONS

=over 8

=item _exit

This is identical to the C function C<_exit()>.  It exits the program
immediately which means among other things buffered I/O is B<not> flushed.

=item abort

This is identical to the C function C<abort()>.  It terminates the
process with a C<SIGABRT> signal unless caught by a signal handler or
if the handler does not return normally (it e.g.  does a C<longjmp>).

=item abs

This is identical to Perl's builtin C<abs()> function, returning
the absolute value of its numerical argument.

=item access

Determines the accessibility of a file.

	if( POSIX::access( "/", &POSIX::R_OK ) ){
		print "have read permission\n";
	}

Returns C<undef> on failure.  Note: do not use C<access()> for
security purposes.  Between the C<access()> call and the operation
you are preparing for the permissions might change: a classic
I<race condition>.

=item acos

This is identical to the C function C<acos()>, returning
the arcus cosine of its numerical argument.  See also L<Math::Trig>.

=item alarm

This is identical to Perl's builtin C<alarm()> function,
either for arming or disarming the C<SIGARLM> timer.

=item asctime

This is identical to the C function C<asctime()>.  It returns
a string of the form

	"Fri Jun  2 18:22:13 2000\n\0"

and it is called thusly

	$asctime = asctime($sec, $min, $hour, $mday, $mon, $year,
			   $wday, $yday, $isdst);

The C<$mon> is zero-based: January equals C<0>.  The C<$year> is
1900-based: 2001 equals C<101>.  The C<$wday>, C<$yday>, and C<$isdst>
default to zero (and the first two are usually ignored anyway).

=item asin

This is identical to the C function C<asin()>, returning
the arcus sine of its numerical argument.  See also L<Math::Trig>.

=item assert

Unimplemented, but you can use L<perlfunc/die> and the L<Carp> module
to achieve similar things.

=item atan

This is identical to the C function C<atan()>, returning the
arcus tangent of its numerical argument.  See also L<Math::Trig>.

=item atan2

This is identical to Perl's builtin C<atan2()> function, returning
the arcus tangent defined by its two numerical arguments, the I<y>
coordinate and the I<x> coordinate.  See also L<Math::Trig>.

=item atexit

atexit() is C-specific: use C<END {}> instead, see L<perlsub>.

=item atof

atof() is C-specific.  Perl converts strings to numbers transparently.
If you need to force a scalar to a number, add a zero to it.

=item atoi

atoi() is C-specific.  Perl converts strings to numbers transparently.
If you need to force a scalar to a number, add a zero to it.
If you need to have just the integer part, see L<perlfunc/int>.

=item atol

atol() is C-specific.  Perl converts strings to numbers transparently.
If you need to force a scalar to a number, add a zero to it.
If you need to have just the integer part, see L<perlfunc/int>.

=item bsearch

bsearch() not supplied.  For doing binary search on wordlists,
see L<Search::Dict>.

=item calloc

calloc() is C-specific.  Perl does memory management transparently.

=item ceil

This is identical to the C function C<ceil()>, returning the smallest
integer value greater than or equal to the given numerical argument.

=item chdir

This is identical to Perl's builtin C<chdir()> function, allowing
one to change the working (default) directory, see L<perlfunc/chdir>.

=item chmod

This is identical to Perl's builtin C<chmod()> function, allowing
one to change file and directory permissions, see L<perlfunc/chmod>.

=item chown

This is identical to Perl's builtin C<chown()> function, allowing one
to change file and directory owners and groups, see L<perlfunc/chown>.

=item clearerr

Use the method L<IO::Handle::clearerr()> instead, to reset the error
state (if any) and EOF state (if any) of the given stream.

=item clock

This is identical to the C function C<clock()>, returning the
amount of spent processor time in microseconds.

=item close

Close the file.  This uses file descriptors such as those obtained by calling
C<POSIX::open>.

	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
	POSIX::close( $fd );

Returns C<undef> on failure.

See also L<perlfunc/close>.

=item closedir

This is identical to Perl's builtin C<closedir()> function for closing
a directory handle, see L<perlfunc/closedir>.

=item cos

This is identical to Perl's builtin C<cos()> function, for returning
the cosine of its numerical argument, see L<perlfunc/cos>.
See also L<Math::Trig>.

=item cosh

This is identical to the C function C<cosh()>, for returning
the hyperbolic cosine of its numeric argument.  See also L<Math::Trig>.

=item creat

Create a new file.  This returns a file descriptor like the ones returned by
C<POSIX::open>.  Use C<POSIX::close> to close the file.

	$fd = POSIX::creat( "foo", 0611 );
	POSIX::close( $fd );

See also L<perlfunc/sysopen> and its C<O_CREAT> flag.

=item ctermid

Generates the path name for the controlling terminal.

	$path = POSIX::ctermid();

=item ctime

This is identical to the C function C<ctime()> and equivalent
to C<asctime(localtime(...))>, see L</asctime> and L</localtime>.

=item cuserid

Get the login name of the owner of the current process.

	$name = POSIX::cuserid();

=item difftime

This is identical to the C function C<difftime()>, for returning
the time difference (in seconds) between two times (as returned
by C<time()>), see L</time>.

=item div

div() is C-specific, use L<perlfunc/int> on the usual C</> division and
the modulus C<%>.

=item dup

This is similar to the C function C<dup()>, for duplicating a file
descriptor.

This uses file descriptors such as those obtained by calling
C<POSIX::open>.

Returns C<undef> on failure.

=item dup2

This is similar to the C function C<dup2()>, for duplicating a file
descriptor to an another known file descriptor.

This uses file descriptors such as those obtained by calling
C<POSIX::open>.

Returns C<undef> on failure.

=item errno

Returns the value of errno.

	$errno = POSIX::errno();

This identical to the numerical values of the C<$!>, see L<perlvar/$ERRNO>.

=item execl

execl() is C-specific, see L<perlfunc/exec>.

=item execle

execle() is C-specific, see L<perlfunc/exec>.

=item execlp

execlp() is C-specific, see L<perlfunc/exec>.

=item execv

execv() is C-specific, see L<perlfunc/exec>.

=item execve

execve() is C-specific, see L<perlfunc/exec>.

=item execvp

execvp() is C-specific, see L<perlfunc/exec>.

=item exit

This is identical to Perl's builtin C<exit()> function for exiting the
program, see L<perlfunc/exit>.

=item exp

This is identical to Perl's builtin C<exp()> function for
returning the exponent (I<e>-based) of the numerical argument,
see L<perlfunc/exp>.

=item fabs

This is identical to Perl's builtin C<abs()> function for returning
the absolute value of the numerical argument, see L<perlfunc/abs>.

=item fclose

Use method C<IO::Handle::close()> instead, or see L<perlfunc/close>.

=item fcntl

This is identical to Perl's builtin C<fcntl()> function,
see L<perlfunc/fcntl>.

=item fdopen

Use method C<IO::Handle::new_from_fd()> instead, or see L<perlfunc/open>.

=item feof

Use method C<IO::Handle::eof()> instead, or see L<perlfunc/eof>.

=item ferror

Use method C<IO::Handle::error()> instead.

=item fflush

Use method C<IO::Handle::flush()> instead.
See also L<perlvar/$OUTPUT_AUTOFLUSH>.

=item fgetc

Use method C<IO::Handle::getc()> instead, or see L<perlfunc/read>.

=item fgetpos

Use method C<IO::Seekable::getpos()> instead, or see L<L/seek>.

=item fgets

Use method C<IO::Handle::gets()> instead.  Similar to E<lt>E<gt>, also known
as L<perlfunc/readline>.

=item fileno

Use method C<IO::Handle::fileno()> instead, or see L<perlfunc/fileno>.

=item floor

This is identical to the C function C<floor()>, returning the largest
integer value less than or equal to the numerical argument.

=item fmod

This is identical to the C function C<fmod()>.

	$r = modf($x, $y);

It returns the remainder C<$r = $x - $n*$y>, where C<$n = trunc($x/$y)>.
The C<$r> has the same sign as C<$x> and magnitude (absolute value)
less than the magnitude of C<$y>.

=item fopen

Use method C<IO::File::open()> instead, or see L<perlfunc/open>.

=item fork

This is identical to Perl's builtin C<fork()> function
for duplicating the current process, see L<perlfunc/fork>
and L<perlfork> if you are in Windows.

=item fpathconf

Retrieves the value of a configurable limit on a file or directory.  This
uses file descriptors such as those obtained by calling C<POSIX::open>.

The following will determine the maximum length of the longest allowable
pathname on the filesystem which holds C</tmp/foo>.

	$fd = POSIX::open( "/tmp/foo", &POSIX::O_RDONLY );
	$path_max = POSIX::fpathconf( $fd, &POSIX::_PC_PATH_MAX );

Returns C<undef> on failure.

=item fprintf

fprintf() is C-specific, see L<perlfunc/printf> instead.

=item fputc

fputc() is C-specific, see L<perlfunc/print> instead.

=item fputs

fputs() is C-specific, see L<perlfunc/print> instead.

=item fread

fread() is C-specific, see L<perlfunc/read> instead.

=item free

free() is C-specific.  Perl does memory management transparently.

=item freopen

freopen() is C-specific, see L<perlfunc/open> instead.

=item frexp

Return the mantissa and exponent of a floating-point number.

	($mantissa, $exponent) = POSIX::frexp( 1.234e56 );

=item fscanf

fscanf() is C-specific, use E<lt>E<gt> and regular expressions instead.

=item fseek

Use method C<IO::Seekable::seek()> instead, or see L<perlfunc/seek>.

=item fsetpos

Use method C<IO::Seekable::setpos()> instead, or seek L<perlfunc/seek>.

=item fstat

Get file status.  This uses file descriptors such as those obtained by
calling C<POSIX::open>.  The data returned is identical to the data from
Perl's builtin C<stat> function.

	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
	@stats = POSIX::fstat( $fd );

=item ftell

Use method C<IO::Seekable::tell()> instead, or see L<perlfunc/tell>.

=item fwrite

fwrite() is C-specific, see L<perlfunc/print> instead.

=item getc

This is identical to Perl's builtin C<getc()> function,
see L<perlfunc/getc>.

=item getchar

Returns one character from STDIN.  Identical to Perl's C<getc()>,
see L<perlfunc/getc>.

=item getcwd

Returns the name of the current working directory.
See also L<Cwd>.

=item getegid

Returns the effective group identifier.  Similar to Perl' s builtin
variable C<$(>, see L<perlvar/$EGID>.

=item getenv

Returns the value of the specified enironment variable.
The same information is available through the C<%ENV> array.

=item geteuid

Returns the effective user identifier.  Identical to Perl's builtin C<$E<gt>>
variable, see L<perlvar/$EUID>.

=item getgid

Returns the user's real group identifier.  Similar to Perl's builtin
variable C<$)>, see L<perlvar/$GID>.

=item getgrgid

This is identical to Perl's builtin C<getgrgid()> function for
returning group entries by group identifiers, see
L<perlfunc/getgrgid>.

=item getgrnam

This is identical to Perl's builtin C<getgrnam()> function for
returning group entries by group names, see L<perlfunc/getgrnam>.

=item getgroups

Returns the ids of the user's supplementary groups.  Similar to Perl's
builtin variable C<$)>, see L<perlvar/$GID>.

=item getlogin

This is identical to Perl's builtin C<getlogin()> function for
returning the user name associated with the current session, see
L<perlfunc/getlogin>.

=item getpgrp

This is identical to Perl's builtin C<getpgrp()> function for
returning the prcess group identifier of the current process, see
L<perlfunc/getpgrp>.

=item getpid

Returns the process identifier.  Identical to Perl's builtin
variable C<$$>, see L<perlvar/$PID>.

=item getppid

This is identical to Perl's builtin C<getppid()> function for
returning the process identifier of the parent process of the current
process , see L<perlfunc/getppid>.

=item getpwnam

This is identical to Perl's builtin C<getpwnam()> function for
returning user entries by user names, see L<perlfunc/getpwnam>.

=item getpwuid

This is identical to Perl's builtin C<getpwuid()> function for
returning user entries by user identifiers, see L<perlfunc/getpwuid>.

=item gets

Returns one line from C<STDIN>, similar to E<lt>E<gt>, also known
as the C<readline()> function, see L<perlfunc/readline>.

B<NOTE>: if you have C programs that still use C<gets()>, be very
afraid.  The C<gets()> function is a source of endless grief because
it has no buffer overrun checks.  It should B<never> be used.  The
C<fgets()> function should be preferred instead.

=item getuid

Returns the user's identifier.  Identical to Perl's builtin C<$E<lt>> variable,
see L<perlvar/$UID>.

=item gmtime

This is identical to Perl's builtin C<gmtime()> function for
converting seconds since the epoch to a date in Greenwich Mean Time,
see L<perlfunc/gmtime>.

=item isalnum

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isalnum:]]/> construct instead, or possibly the C</\w/> construct.

=item isalpha

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isalpha:]]/> construct instead.

=item isatty

Returns a boolean indicating whether the specified filehandle is connected
to a tty.  Similar to the C<-t> operator, see L<perlfunc/-X>.

=item iscntrl

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:iscntrl:]]/> construct instead.

=item isdigit

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isdigit:]]/> construct instead, or the C</\d/> construct.

=item isgraph

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isgraph:]]/> construct instead.

=item islower

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:islower:]]/> construct instead.  Do B<not> use C</a-z/>.

=item isprint

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isprint:]]/> construct instead.

=item ispunct

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:ispunct:]]/> construct instead.

=item isspace

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isspace:]]/> construct instead, or the C</\s/> construct.

=item isupper

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isupper:]]/> construct instead.  Do B<not> use C</A-Z/>.

=item isxdigit

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using regular expressions and the
C</[[:isxdigit:]]/> construct instead, or simply C</[0-9a-f]/i>.

=item kill

This is identical to Perl's builtin C<kill()> function for sending
signals to processes (often to terminate them), see L<perlfunc/kill>.

=item labs

(For returning absolute values of long integers.)
labs() is C-specific, see L<perlfunc/abs> instead.

=item ldexp

This is identical to the C function C<ldexp()>
for multiplying floating point numbers with powers of two.

	$x_quadrupled = POSIX::ldexp($x, 2);

=item ldiv

(For computing dividends of long integers.)
ldiv() is C-specific, use C</> and C<int()> instead.

=item link

This is identical to Perl's builtin C<link()> function
for creating hard links into files, see L<perlfunc/link>.

=item localeconv

Get numeric formatting information.  Returns a reference to a hash
containing the current locale formatting values.

Here is how to query the database for the B<de> (Deutsch or German) locale.

	$loc = POSIX::setlocale( &POSIX::LC_ALL, "de" );
	print "Locale = $loc\n";
	$lconv = POSIX::localeconv();
	print "decimal_point	= ", $lconv->{decimal_point},	"\n";
	print "thousands_sep	= ", $lconv->{thousands_sep},	"\n";
	print "grouping	= ", $lconv->{grouping},	"\n";
	print "int_curr_symbol	= ", $lconv->{int_curr_symbol},	"\n";
	print "currency_symbol	= ", $lconv->{currency_symbol},	"\n";
	print "mon_decimal_point = ", $lconv->{mon_decimal_point}, "\n";
	print "mon_thousands_sep = ", $lconv->{mon_thousands_sep}, "\n";
	print "mon_grouping	= ", $lconv->{mon_grouping},	"\n";
	print "positive_sign	= ", $lconv->{positive_sign},	"\n";
	print "negative_sign	= ", $lconv->{negative_sign},	"\n";
	print "int_frac_digits	= ", $lconv->{int_frac_digits},	"\n";
	print "frac_digits	= ", $lconv->{frac_digits},	"\n";
	print "p_cs_precedes	= ", $lconv->{p_cs_precedes},	"\n";
	print "p_sep_by_space	= ", $lconv->{p_sep_by_space},	"\n";
	print "n_cs_precedes	= ", $lconv->{n_cs_precedes},	"\n";
	print "n_sep_by_space	= ", $lconv->{n_sep_by_space},	"\n";
	print "p_sign_posn	= ", $lconv->{p_sign_posn},	"\n";
	print "n_sign_posn	= ", $lconv->{n_sign_posn},	"\n";

=item localtime

This is identical to Perl's builtin C<localtime()> function for
converting seconds since the epoch to a date see L<perlfunc/localtime>.

=item log

This is identical to Perl's builtin C<log()> function,
returning the natural (I<e>-based) logarithm of the numerical argument,
see L<perlfunc/log>.

=item log10

This is identical to the C function C<log10()>,
returning the 10-base logarithm of the numerical argument.
You can also use

    sub log10 { log($_[0]) / log(10) }

or

    sub log10 { log($_[0]) / 2.30258509299405 }  

or

    sub log10 { log($_[0]) * 0.434294481903252 }

=item longjmp

longjmp() is C-specific: use L<perlfunc/die> instead.

=item lseek

Move the file's read/write position.  This uses file descriptors such as
those obtained by calling C<POSIX::open>.

	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
	$off_t = POSIX::lseek( $fd, 0, &POSIX::SEEK_SET );

Returns C<undef> on failure.

=item malloc

malloc() is C-specific.  Perl does memory management transparently.

=item mblen

This is identical to the C function C<mblen()>.
Perl does not have any support for the wide and multibyte
characters of the C standards, so this might be a rather 
useless function.

=item mbstowcs

This is identical to the C function C<mbstowcs()>.
Perl does not have any support for the wide and multibyte
characters of the C standards, so this might be a rather 
useless function.

=item mbtowc

This is identical to the C function C<mbtowc()>.
Perl does not have any support for the wide and multibyte
characters of the C standards, so this might be a rather 
useless function.

=item memchr

memchr() is C-specific, see L<perlfunc/index> instead.

=item memcmp

memcmp() is C-specific, use C<eq> instead, see L<perlop>.

=item memcpy

memcpy() is C-specific, use C<=>, see L<perlop>, or see L<perlfunc/substr>.

=item memmove

memmove() is C-specific, use C<=>, see L<perlop>, or see L<perlfunc/substr>.

=item memset

memset() is C-specific, use C<x> instead, see L<perlop>.

=item mkdir

This is identical to Perl's builtin C<mkdir()> function
for creating directories, see L<perlfunc/mkdir>.

=item mkfifo

This is similar to the C function C<mkfifo()> for creating
FIFO special files.

	if (mkfifo($path, $mode)) { ....

Returns C<undef> on failure.  The C<$mode> is similar to the
mode of C<mkdir()>, see L<perlfunc/mkdir>.

=item mktime

Convert date/time info to a calendar time.

Synopsis:

	mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)

The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1.  The
year (C<year>) is given in years since 1900.  I.e. The year 1995 is 95; the
year 2001 is 101.  Consult your system's C<mktime()> manpage for details
about these and the other arguments.

Calendar time for December 12, 1995, at 10:30 am.

	$time_t = POSIX::mktime( 0, 30, 10, 12, 11, 95 );
	print "Date = ", POSIX::ctime($time_t);

Returns C<undef> on failure.

=item modf

Return the integral and fractional parts of a floating-point number.

	($fractional, $integral) = POSIX::modf( 3.14 );

=item nice

This is similar to the C function C<nice()>, for changing
the scheduling preference of the current process.  Positive
arguments mean more polite process, negative values more
needy process.  Normal user processes can only be more polite.

Returns C<undef> on failure.

=item offsetof

offsetof() is C-specific, you probably want to see L<perlfunc/pack> instead.

=item open

Open a file for reading for writing.  This returns file descriptors, not
Perl filehandles.  Use C<POSIX::close> to close the file.

Open a file read-only with mode 0666.

	$fd = POSIX::open( "foo" );

Open a file for read and write.

	$fd = POSIX::open( "foo", &POSIX::O_RDWR );

Open a file for write, with truncation.

	$fd = POSIX::open( "foo", &POSIX::O_WRONLY | &POSIX::O_TRUNC );

Create a new file with mode 0640.  Set up the file for writing.

	$fd = POSIX::open( "foo", &POSIX::O_CREAT | &POSIX::O_WRONLY, 0640 );

Returns C<undef> on failure.

See also L<perlfunc/sysopen>.

=item opendir

Open a directory for reading.

	$dir = POSIX::opendir( "/tmp" );
	@files = POSIX::readdir( $dir );
	POSIX::closedir( $dir );

Returns C<undef> on failure.

=item pathconf

Retrieves the value of a configurable limit on a file or directory.

The following will determine the maximum length of the longest allowable
pathname on the filesystem which holds C</tmp>.

	$path_max = POSIX::pathconf( "/tmp", &POSIX::_PC_PATH_MAX );

Returns C<undef> on failure.

=item pause

This is similar to the C function C<pause()>, which suspends
the execution of the current process until a signal is received.

Returns C<undef> on failure.

=item perror

This is identical to the C function C<perror()>, which outputs to the
standard error stream the specified message followed by ": " and the
current error string.  Use the C<warn()> function and the C<$!>
variable instead, see L<perlfunc/warn> and L<perlvar/$ERRNO>.

=item pipe

Create an interprocess channel.  This returns file descriptors like those
returned by C<POSIX::open>.

	($fd0, $fd1) = POSIX::pipe();
	POSIX::write( $fd0, "hello", 5 );
	POSIX::read( $fd1, $buf, 5 );

See also L<perlfunc/pipe>.

=item pow

Computes C<$x> raised to the power C<$exponent>.

	$ret = POSIX::pow( $x, $exponent );

You can also use the C<**> operator, see L<perlop>.

=item printf

Formats and prints the specified arguments to STDOUT.
See also L<perlfunc/printf>.

=item putc

putc() is C-specific, see L<perlfunc/print> instead.

=item putchar

putchar() is C-specific, see L<perlfunc/print> instead.

=item puts

puts() is C-specific, see L<perlfunc/print> instead.

=item qsort

qsort() is C-specific, see L<perlfunc/sort> instead.

=item raise

Sends the specified signal to the current process.
See also L<perlfunc/kill> and the C<$$> in L<perlvar/$PID>.

=item rand

C<rand()> is non-portable, see L<perlfunc/rand> instead.

=item read

Read from a file.  This uses file descriptors such as those obtained by
calling C<POSIX::open>.  If the buffer C<$buf> is not large enough for the
read then Perl will extend it to make room for the request.

	$fd = POSIX::open( "foo", &POSIX::O_RDONLY );
	$bytes = POSIX::read( $fd, $buf, 3 );

Returns C<undef> on failure.

See also L<perlfunc/sysread>.

=item readdir

This is identical to Perl's builtin C<readdir()> function
for reading directory entries, see L<perlfunc/readdir>.

=item realloc

realloc() is C-specific.  Perl does memory management transparently.

=item remove

This is identical to Perl's builtin C<unlink()> function
for removing files, see L<perlfunc/unlink>.

=item rename

This is identical to Perl's builtin C<rename()> function
for renaming files, see L<perlfunc/rename>.

=item rewind

Seeks to the beginning of the file.

=item rewinddir

This is identical to Perl's builtin C<rewinddir()> function for
rewinding directory entry streams, see L<perlfunc/rewinddir>.

=item rmdir

This is identical to Perl's builtin C<rmdir()> function
for removing (empty) directories, see L<perlfunc/rmdir>.

=item scanf

scanf() is C-specific, use E<lt>E<gt> and regular expressions instead,
see L<perlre>.

=item setgid

Sets the real group identifier for this process.
Identical to assigning a value to the Perl's builtin C<$)> variable,
see L<perlvar/$UID>.

=item setjmp

C<setjmp()> is C-specific: use C<eval {}> instead,
see L<perlfunc/eval>.

=item setlocale

Modifies and queries program's locale.  The following examples assume

	use POSIX qw(setlocale LC_ALL LC_CTYPE);

has been issued.

The following will set the traditional UNIX system locale behavior
(the second argument C<"C">).

	$loc = setlocale( LC_ALL, "C" );

The following will query the current LC_CTYPE category.  (No second
argument means 'query'.)

	$loc = setlocale( LC_CTYPE );

The following will set the LC_CTYPE behaviour according to the locale
environment variables (the second argument C<"">).
Please see your systems L<setlocale(3)> documentation for the locale
environment variables' meaning or consult L<perllocale>.

	$loc = setlocale( LC_CTYPE, "" );

The following will set the LC_COLLATE behaviour to Argentinian
Spanish. B<NOTE>: The naming and availability of locales depends on
your operating system. Please consult L<perllocale> for how to find
out which locales are available in your system.

	$loc = setlocale( LC_ALL, "es_AR.ISO8859-1" );

=item setpgid

This is similar to the C function C<setpgid()> for
setting the process group identifier of the current process.

Returns C<undef> on failure.

=item setsid

This is identical to the C function C<setsid()> for
setting the session identifier of the current process.

=item setuid

Sets the real user identifier for this process.
Identical to assigning a value to the Perl's builtin C<$E<lt>> variable,
see L<perlvar/$UID>.

=item sigaction

Detailed signal management.  This uses C<POSIX::SigAction> objects for the
C<action> and C<oldaction> arguments.  Consult your system's C<sigaction>
manpage for details.

Synopsis:

	sigaction(sig, action, oldaction = 0)

Returns C<undef> on failure.

=item siglongjmp

siglongjmp() is C-specific: use L<perlfunc/die> instead.

=item sigpending

Examine signals that are blocked and pending.  This uses C<POSIX::SigSet>
objects for the C<sigset> argument.  Consult your system's C<sigpending>
manpage for details.

Synopsis:

	sigpending(sigset)

Returns C<undef> on failure.

=item sigprocmask

Change and/or examine calling process's signal mask.  This uses
C<POSIX::SigSet> objects for the C<sigset> and C<oldsigset> arguments.
Consult your system's C<sigprocmask> manpage for details.

Synopsis:

	sigprocmask(how, sigset, oldsigset = 0)

Returns C<undef> on failure.

=item sigsetjmp

C<sigsetjmp()> is C-specific: use C<eval {}> instead,
see L<perlfunc/eval>.

=item sigsuspend

Install a signal mask and suspend process until signal arrives.  This uses
C<POSIX::SigSet> objects for the C<signal_mask> argument.  Consult your
system's C<sigsuspend> manpage for details.

Synopsis:

	sigsuspend(signal_mask)

Returns C<undef> on failure.

=item sin

This is identical to Perl's builtin C<sin()> function
for returning the sine of the numerical argument,
see L<perlfunc/sin>.  See also L<Math::Trig>.

=item sinh

This is identical to the C function C<sinh()>
for returning the hyperbolic sine of the numerical argument.
See also L<Math::Trig>.

=item sleep

This is identical to Perl's builtin C<sleep()> function
for suspending the execution of the current for process
for certain number of seconds, see L<perlfunc/sleep>.

=item sprintf

This is similar to Perl's builtin C<sprintf()> function
for returning a string that has the arguments formatted as requested,
see L<perlfunc/sprintf>.

=item sqrt

This is identical to Perl's builtin C<sqrt()> function.
for returning the square root of the numerical argument,
see L<perlfunc/sqrt>.

=item srand

Give a seed the pseudorandom number generator, see L<perlfunc/srand>.

=item sscanf

sscanf() is C-specific, use regular expressions instead,
see L<perlre>.

=item stat

This is identical to Perl's builtin C<stat()> function
for retutning information about files and directories.

=item strcat

strcat() is C-specific, use C<.=> instead, see L<perlop>.

=item strchr

strchr() is C-specific, see L<perlfunc/index> instead.

=item strcmp

strcmp() is C-specific, use C<eq> or C<cmp> instead, see L<perlop>.

=item strcoll

This is identical to the C function C<strcoll()>
for collating (comparing) strings transformed using
the C<strxfrm()> function.  Not really needed since
Perl can do this transparently, see L<perllocale>.

=item strcpy

strcpy() is C-specific, use C<=> instead, see L<perlop>.

=item strcspn

strcspn() is C-specific, use regular expressions instead,
see L<perlre>.

=item strerror

Returns the error string for the specified errno.
Identical to the string form of the C<$!>, see L<perlvar/$ERRNO>.

=item strftime

Convert date and time information to string.  Returns the string.

Synopsis:

	strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)

The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1.  The
year (C<year>) is given in years since 1900.  I.e., the year 1995 is 95; the
year 2001 is 101.  Consult your system's C<strftime()> manpage for details
about these and the other arguments.
If you want your code to be portable, your format (C<fmt>) argument
should use only the conversion specifiers defined by the ANSI C
standard.  These are C<aAbBcdHIjmMpSUwWxXyYZ%>.
The given arguments are made consistent
as though by calling C<mktime()> before calling your system's
C<strftime()> function, except that the C<isdst> value is not affected.

The string for Tuesday, December 12, 1995.

	$str = POSIX::strftime( "%A, %B %d, %Y", 0, 0, 0, 12, 11, 95, 2 );
	print "$str\n";

=item strlen

strlen() is C-specific, use C<length()> instead, see L<perlfunc/length>.

=item strncat

strncat() is C-specific, use C<.=> instead, see L<perlop>.

=item strncmp

strncmp() is C-specific, use C<eq> instead, see L<perlop>.

=item strncpy

strncpy() is C-specific, use C<=> instead, see L<perlop>.

=item strpbrk

strpbrk() is C-specific, use regular expressions instead,
see L<perlre>.

=item strrchr

strrchr() is C-specific, see L<perlfunc/rindex> instead.

=item strspn

strspn() is C-specific, use regular expressions instead,
see L<perlre>.

=item strstr

This is identical to Perl's builtin C<index()> function,
see L<perlfunc/index>.

=item strtod

String to double translation. Returns the parsed number and the number
of characters in the unparsed portion of the string.  Truly
POSIX-compliant systems set $! ($ERRNO) to indicate a translation
error, so clear $! before calling strtod.  However, non-POSIX systems
may not check for overflow, and therefore will never set $!.

strtod should respect any POSIX I<setlocale()> settings.

To parse a string $str as a floating point number use

    $! = 0;
    ($num, $n_unparsed) = POSIX::strtod($str);

The second returned item and $! can be used to check for valid input:

    if (($str eq '') || ($n_unparsed != 0) || !$!) {
        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
    }

When called in a scalar context strtod returns the parsed number.

=item strtok

strtok() is C-specific, use regular expressions instead, see
L<perlre>, or L<perlfunc/split>.

=item strtol

String to (long) integer translation.  Returns the parsed number and
the number of characters in the unparsed portion of the string.  Truly
POSIX-compliant systems set $! ($ERRNO) to indicate a translation
error, so clear $! before calling strtol.  However, non-POSIX systems
may not check for overflow, and therefore will never set $!.

strtol should respect any POSIX I<setlocale()> settings.

To parse a string $str as a number in some base $base use

    $! = 0;
    ($num, $n_unparsed) = POSIX::strtol($str, $base);

The base should be zero or between 2 and 36, inclusive.  When the base
is zero or omitted strtol will use the string itself to determine the
base: a leading "0x" or "0X" means hexadecimal; a leading "0" means
octal; any other leading characters mean decimal.  Thus, "1234" is
parsed as a decimal number, "01234" as an octal number, and "0x1234"
as a hexadecimal number.

The second returned item and $! can be used to check for valid input:

    if (($str eq '') || ($n_unparsed != 0) || !$!) {
        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
    }

When called in a scalar context strtol returns the parsed number.

=item strtoul

String to unsigned (long) integer translation.  strtoul() is identical
to strtol() except that strtoul() only parses unsigned integers.  See
L</strtol> for details.

Note: Some vendors supply strtod() and strtol() but not strtoul().
Other vendors that do supply strtoul() parse "-1" as a valid value.

=item strxfrm

String transformation.  Returns the transformed string.

	$dst = POSIX::strxfrm( $src );

Used in conjunction with the C<strcoll()> function, see L</strcoll>.

Not really needed since Perl can do this transparently, see
L<perllocale>.

=item sysconf

Retrieves values of system configurable variables.

The following will get the machine's clock speed.

	$clock_ticks = POSIX::sysconf( &POSIX::_SC_CLK_TCK );

Returns C<undef> on failure.

=item system

This is identical to Perl's builtin C<system()> function, see
L<perlfunc/system>.

=item tan

This is identical to the C function C<tan()>, returning the
tangent of the numerical argument.  See also L<Math::Trig>.

=item tanh

This is identical to the C function C<tanh()>, returning the
hyperbolic tangent of the numerical argument.   See also L<Math::Trig>.

=item tcdrain

This is similar to the C function C<tcdrain()> for draining
the output queue of its argument stream.

Returns C<undef> on failure.

=item tcflow

This is similar to the C function C<tcflow()> for controlling
the flow of its argument stream.

Returns C<undef> on failure.

=item tcflush

This is similar to the C function C<tcflush()> for flushing
the I/O buffers of its argumeny stream.

Returns C<undef> on failure.

=item tcgetpgrp

This is identical to the C function C<tcgetpgrp()> for returning the
process group identifier of the foreground process group of the controlling
terminal.

=item tcsendbreak

This is similar to the C function C<tcsendbreak()> for sending
a break on its argument stream.

Returns C<undef> on failure.

=item tcsetpgrp

This is similar to the C function C<tcsetpgrp()> for setting the
process group identifier of the foreground process group of the controlling
terminal.

Returns C<undef> on failure.

=item time

This is identical to Perl's builtin C<time()> function
for returning the number of seconds since the epoch
(whatever it is for the system), see L<perlfunc/time>.

=item times

The times() function returns elapsed realtime since some point in the past
(such as system startup), user and system times for this process, and user
and system times used by child processes.  All times are returned in clock
ticks.

    ($realtime, $user, $system, $cuser, $csystem) = POSIX::times();

Note: Perl's builtin C<times()> function returns four values, measured in
seconds.

=item tmpfile

Use method C<IO::File::new_tmpfile()> instead, or see L<File::Temp>.

=item tmpnam

Returns a name for a temporary file.

	$tmpfile = POSIX::tmpnam();

For security reasons, which are probably detailed in your system's
documentation for the C library tmpnam() function, this interface
should not be used; instead see L<File::Temp>.

=item tolower

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using the C<lc()> function,
see L<perlfunc/lc>, or the equivalent C<\L> operator inside doublequotish
strings.

=item toupper

This is identical to the C function, except that it can apply to a single
character or to a whole string.  Consider using the C<uc()> function,
see L<perlfunc/uc>, or the equivalent C<\U> operator inside doublequotish
strings.

=item ttyname

This is identical to the C function C<ttyname()> for returning the
name of the current terminal.

=item tzname

Retrieves the time conversion information from the C<tzname> variable.

	POSIX::tzset();
	($std, $dst) = POSIX::tzname();

=item tzset

This is identical to the C function C<tzset()> for setting
the current timezone based on the environment variable C<TZ>,
to be used by C<ctime()>, C<localtime()>, C<mktime()>, and C<strftime()>
functions.

=item umask

This is identical to Perl's builtin C<umask()> function
for setting (and querying) the file creation permission mask,
see L<perlfunc/umask>.

=item uname

Get name of current operating system.

	($sysname, $nodename, $release, $version, $machine) = POSIX::uname();

Note that the actual meanings of the various fields are not
that well standardized, do not expect any great portability.
The C<$sysname> might be the name of the operating system,
the C<$nodename> might be the name of the host, the C<$release>
might be the (major) release number of the operating system,
the C<$version> might be the (minor) release number of the
operating system, and the C<$machine> might be a hardware identifier.
Maybe.

=item ungetc

Use method C<IO::Handle::ungetc()> instead.

=item unlink

This is identical to Perl's builtin C<unlink()> function
for removing files, see L<perlfunc/unlink>.

=item utime

This is identical to Perl's builtin C<utime()> function
for changing the time stamps of files and directories,
see L<perlfunc/utime>.

=item vfprintf

vfprintf() is C-specific, see L<perlfunc/printf> instead.

=item vprintf

vprintf() is C-specific, see L<perlfunc/printf> instead.

=item vsprintf

vsprintf() is C-specific, see L<perlfunc/sprintf> instead.

=item wait

This is identical to Perl's builtin C<wait()> function,
see L<perlfunc/wait>.

=item waitpid

Wait for a child process to change state.  This is identical to Perl's
builtin C<waitpid()> function, see L<perlfunc/waitpid>.

	$pid = POSIX::waitpid( -1, &POSIX::WNOHANG );
	print "status = ", ($? / 256), "\n";

=item wcstombs

This is identical to the C function C<wcstombs()>.
Perl does not have any support for the wide and multibyte
characters of the C standards, so this might be a rather 
useless function.

=item wctomb

This is identical to the C function C<wctomb()>.
Perl does not have any support for the wide and multibyte
characters of the C standards, so this might be a rather 
useless function.

=item write

Write to a file.  This uses file descriptors such as those obtained by
calling C<POSIX::open>.

	$fd = POSIX::open( "foo", &POSIX::O_WRONLY );
	$buf = "hello";
	$bytes = POSIX::write( $b, $buf, 5 );

Returns C<undef> on failure.

See also L<perlfunc/syswrite>.

=back

=head1 CLASSES

=head2 POSIX::SigAction

=over 8

=item new

Creates a new C<POSIX::SigAction> object which corresponds to the C
C<struct sigaction>.  This object will be destroyed automatically when it is
no longer needed.  The first parameter is the fully-qualified name of a sub
which is a signal-handler.  The second parameter is a C<POSIX::SigSet>
object, it defaults to the empty set.  The third parameter contains the
C<sa_flags>, it defaults to 0.

	$sigset = POSIX::SigSet->new(SIGINT, SIGQUIT);
	$sigaction = POSIX::SigAction->new( 'main::handler', $sigset, &POSIX::SA_NOCLDSTOP );

This C<POSIX::SigAction> object should be used with the C<POSIX::sigaction()>
function.

=back

=head2 POSIX::SigSet

=over 8

=item new

Create a new SigSet object.  This object will be destroyed automatically
when it is no longer needed.  Arguments may be supplied to initialize the
set.

Create an empty set.

	$sigset = POSIX::SigSet->new;

Create a set with SIGUSR1.

	$sigset = POSIX::SigSet->new( &POSIX::SIGUSR1 );

=item addset

Add a signal to a SigSet object.

	$sigset->addset( &POSIX::SIGUSR2 );

Returns C<undef> on failure.

=item delset

Remove a signal from the SigSet object.

	$sigset->delset( &POSIX::SIGUSR2 );

Returns C<undef> on failure.

=item emptyset

Initialize the SigSet object to be empty.

	$sigset->emptyset();

Returns C<undef> on failure.

=item fillset

Initialize the SigSet object to include all signals.

	$sigset->fillset();

Returns C<undef> on failure.

=item ismember

Tests the SigSet object to see if it contains a specific signal.

	if( $sigset->ismember( &POSIX::SIGUSR1 ) ){
		print "contains SIGUSR1\n";
	}

=back

=head2 POSIX::Termios

=over 8

=item new

Create a new Termios object.  This object will be destroyed automatically
when it is no longer needed.  A Termios object corresponds to the termios
C struct.  new() mallocs a new one, getattr() fills it from a file descriptor,
and setattr() sets a file descriptor's parameters to match Termios' contents.

	$termios = POSIX::Termios->new;

=item getattr

Get terminal control attributes.

Obtain the attributes for stdin.

	$termios->getattr()

Obtain the attributes for stdout.

	$termios->getattr( 1 )

Returns C<undef> on failure.

=item getcc

Retrieve a value from the c_cc field of a termios object.  The c_cc field is
an array so an index must be specified.

	$c_cc[1] = $termios->getcc(1);

=item getcflag

Retrieve the c_cflag field of a termios object.

	$c_cflag = $termios->getcflag;

=item getiflag

Retrieve the c_iflag field of a termios object.

	$c_iflag = $termios->getiflag;

=item getispeed

Retrieve the input baud rate.

	$ispeed = $termios->getispeed;

=item getlflag

Retrieve the c_lflag field of a termios object.

	$c_lflag = $termios->getlflag;

=item getoflag

Retrieve the c_oflag field of a termios object.

	$c_oflag = $termios->getoflag;

=item getospeed

Retrieve the output baud rate.

	$ospeed = $termios->getospeed;

=item setattr

Set terminal control attributes.

Set attributes immediately for stdout.

	$termios->setattr( 1, &POSIX::TCSANOW );

Returns C<undef> on failure.

=item setcc

Set a value in the c_cc field of a termios object.  The c_cc field is an
array so an index must be specified.

	$termios->setcc( &POSIX::VEOF, 1 );

=item setcflag

Set the c_cflag field of a termios object.

	$termios->setcflag( $c_cflag | &POSIX::CLOCAL );

=item setiflag

Set the c_iflag field of a termios object.

	$termios->setiflag( $c_iflag | &POSIX::BRKINT );

=item setispeed

Set the input baud rate.

	$termios->setispeed( &POSIX::B9600 );

Returns C<undef> on failure.

=item setlflag

Set the c_lflag field of a termios object.

	$termios->setlflag( $c_lflag | &POSIX::ECHO );

=item setoflag

Set the c_oflag field of a termios object.

	$termios->setoflag( $c_oflag | &POSIX::OPOST );

=item setospeed

Set the output baud rate.

	$termios->setospeed( &POSIX::B9600 );

Returns C<undef> on failure.

=item Baud rate values

B38400 B75 B200 B134 B300 B1800 B150 B0 B19200 B1200 B9600 B600 B4800 B50 B2400 B110

=item Terminal interface values

TCSADRAIN TCSANOW TCOON TCIOFLUSH TCOFLUSH TCION TCIFLUSH TCSAFLUSH TCIOFF TCOOFF

=item c_cc field values

VEOF VEOL VERASE VINTR VKILL VQUIT VSUSP VSTART VSTOP VMIN VTIME NCCS

=item c_cflag field values

CLOCAL CREAD CSIZE CS5 CS6 CS7 CS8 CSTOPB HUPCL PARENB PARODD

=item c_iflag field values

BRKINT ICRNL IGNBRK IGNCR IGNPAR INLCR INPCK ISTRIP IXOFF IXON PARMRK

=item c_lflag field values

ECHO ECHOE ECHOK ECHONL ICANON IEXTEN ISIG NOFLSH TOSTOP

=item c_oflag field values

OPOST

=back

=head1 PATHNAME CONSTANTS

=over 8

=item Constants

_PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE

=back

=head1 POSIX CONSTANTS

=over 8

=item Constants

_POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_CHOWN_RESTRICTED _POSIX_JOB_CONTROL _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_NO_TRUNC _POSIX_OPEN_MAX _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SAVED_IDS _POSIX_SSIZE_MAX _POSIX_STREAM_MAX _POSIX_TZNAME_MAX _POSIX_VDISABLE _POSIX_VERSION

=back

=head1 SYSTEM CONFIGURATION

=over 8

=item Constants

_SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION

=back

=head1 ERRNO

=over 8

=item Constants

E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
EBUSY ECHILD ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ
EDOM EDQUOT EEXIST EFAULT EFBIG EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR
EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG
ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC
ENOLCK ENOMEM ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR
ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE
EPROCLIM EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS
ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS
ETXTBSY EUSERS EWOULDBLOCK EXDEV

=back

=head1 FCNTL

=over 8

=item Constants

FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_OK F_RDLCK F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY

=back

=head1 FLOAT

=over 8

=item Constants

DBL_DIG DBL_EPSILON DBL_MANT_DIG DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP FLT_DIG FLT_EPSILON FLT_MANT_DIG FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX FLT_ROUNDS LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP

=back

=head1 LIMITS

=over 8

=item Constants

ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX ULONG_MAX USHRT_MAX

=back

=head1 LOCALE

=over 8

=item Constants

LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC LC_TIME

=back

=head1 MATH

=over 8

=item Constants

HUGE_VAL

=back

=head1 SIGNAL

=over 8

=item Constants

SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND SA_RESTART
SA_SIGINFO SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT
SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
SIGUSR1 SIGUSR2 SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK
SIG_UNBLOCK

=back

=head1 STAT

=over 8

=item Constants

S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR

=item Macros

S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG

=back

=head1 STDLIB

=over 8

=item Constants

EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX RAND_MAX

=back

=head1 STDIO

=over 8

=item Constants

BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid L_tmpname TMP_MAX

=back

=head1 TIME

=over 8

=item Constants

CLK_TCK CLOCKS_PER_SEC

=back

=head1 UNISTD

=over 8

=item Constants

R_OK SEEK_CUR SEEK_END SEEK_SET STDIN_FILENO STDOUT_FILENO STDERR_FILENO W_OK X_OK

=back

=head1 WAIT

=over 8

=item Constants

WNOHANG WUNTRACED

=item Macros

WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG

=back

_[0] eq 'GLOB'; # A subroutine is compiled.
  # Cannot be done before the file is                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ;# pwd.pl - keeps track of current working directory in PWD environment var
;#
#
# This library is no longer being maintained, and is included for backward
# compatibility with Perl 4 programs which may require it.
#
# In particular, this should not be used as an example of modern Perl
# programming techniques.
#
# Suggested alternative: Cwd
#
;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
;#
;# $Log:	pwd.pl,v $
;#
;# Usage:
;#	require "pwd.pl";
;#	&initpwd;
;#	...
;#	&chdir($newdir);

package pwd;

sub main'initpwd {
    if ($ENV{'PWD'}) {
	local($dd,$di) = stat('.');
	local($pd,$pi) = stat($ENV{'PWD'});
	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
	    chop($ENV{'PWD'} = `pwd`);
	}
    }
    else {
	chop($ENV{'PWD'} = `pwd`);
    }
    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
	local($pd,$pi) = stat($2);
	local($dd,$di) = stat($1);
	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
	    $ENV{'PWD'}="$2$3";
	}
    }
}

sub main'chdir {
    local($newdir) = shift;
    $newdir =~ s|/{2,}|/|g;
    if (chdir $newdir) {
	if ($newdir =~ m#^/#) {
	    $ENV{'PWD'} = $newdir;
	}
	else {
	    local(@curdir) = split(m#/#,$ENV{'PWD'});
	    @curdir = '' unless @curdir;
	    foreach $component (split(m#/#, $newdir)) {
		next if $component eq '.';
		pop(@curdir),next if $component eq '..';
		push(@curdir,$component);
	    }
	    $ENV{'PWD'} = join('/',@curdir) || '/';
	}
    }
    else {
	0;
    }
}

1;
 = $sub[$i]{file};
    $file = $file eq '-e' ? $file : "fi                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package re;

$VERSION = 0.02;

=head1 NAME

re - Perl pragma to alter regular expression behaviour

=head1 SYNOPSIS

    use re 'taint';
    ($x) = ($^X =~ /^(.*)$/s);     # $x is tainted here

    $pat = '(?{ $foo = 1 })';
    use re 'eval';
    /foo${pat}bar/;		   # won't fail (when not under -T switch)

    {
	no re 'taint';		   # the default
	($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here

	no re 'eval';		   # the default
	/foo${pat}bar/;		   # disallowed (with or without -T switch)
    }

    use re 'debug';		   # NOT lexically scoped (as others are)
    /^(.*)$/s;			   # output debugging info during
    				   #     compile and run time

    use re 'debugcolor';	   # same as 'debug', but with colored output
    ...

(We use $^X in these examples because it's tainted by default.)

=head1 DESCRIPTION

When C<use re 'taint'> is in effect, and a tainted string is the target
of a regex, the regex memories (or values returned by the m// operator
in list context) are tainted.  This feature is useful when regex operations
on tainted data aren't meant to extract safe substrings, but to perform
other transformations.

When C<use re 'eval'> is in effect, a regex is allowed to contain
C<(?{ ... })> zero-width assertions even if regular expression contains
variable interpolation.  That is normally disallowed, since it is a 
potential security risk.  Note that this pragma is ignored when the regular
expression is obtained from tainted data, i.e.  evaluation is always
disallowed with tainted regular expresssions.  See L<perlre/(?{ code })>.

For the purpose of this pragma, interpolation of precompiled regular 
expressions (i.e., the result of C<qr//>) is I<not> considered variable
interpolation.  Thus:

    /foo${pat}bar/

I<is> allowed if $pat is a precompiled regular expression, even 
if $pat contains C<(?{ ... })> assertions.

When C<use re 'debug'> is in effect, perl emits debugging messages when 
compiling and using regular expressions.  The output is the same as that
obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the
B<-Dr> switch. It may be quite voluminous depending on the complexity
of the match.  Using C<debugcolor> instead of C<debug> enables a
form of output that can be used to get a colorful display on terminals
that understand termcap color sequences.  Set C<$ENV{PERL_RE_TC}> to a
comma-separated list of C<termcap> properties to use for highlighting
strings on/off, pre-point part on/off.  
See L<perldebug/"Debugging regular expressions"> for additional info.

The directive C<use re 'debug'> is I<not lexically scoped>, as the
other directives are.  It has both compile-time and run-time effects.

See L<perlmodlib/Pragmatic Modules>.

=cut

# N.B. File::Basename contains a literal for 'taint' as a fallback.  If
# taint is changed here, File::Basename must be updated as well.
my %bitmask = (
taint	=> 0x00100000,
eval	=> 0x00200000,
);

sub setcolor {
 eval {				# Ignore errors
  require Term::Cap;

  my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
  my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
  my @props = split /,/, $props;
  my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;

  $colors =~ s/\0//g;
  $ENV{PERL_RE_COLORS} = $colors;
 };
}

sub bits {
    my $on = shift;
    my $bits = 0;
    unless(@_) {
	require Carp;
	Carp::carp("Useless use of \"re\" pragma");
    }
    foreach my $s (@_){
      if ($s eq 'debug' or $s eq 'debugcolor') {
 	  setcolor() if $s eq 'debugcolor';
	  require XSLoader;
	  XSLoader::load('re');
	  install() if $on;
	  uninstall() unless $on;
	  next;
      }
      $bits |= $bitmask{$s} || 0;
    }
    $bits;
}

sub import {
    shift;
    $^H |= bits(1,@_);
}

sub unimport {
    shift;
    $^H &= ~ bits(0,@_);
}

1;
rm::ReadLine::Stub 'perldb', $IN, $OUT;
    } else {
	$term = new Term::ReadLine 'perldb', $IN, $OUT;

	$rl_attribs = $term->Attribs;
	$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}' 
	  if defined $rl_attribs->{basic_word_break_characters} 
	    and index($rl_attribs->{basic_word_break_characters}, ":")                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Safe;

use 5.003_11;
use strict;

our $VERSION = "2.06";

use Carp;

use Opcode 1.01, qw(
    opset opset_to_ops opmask_add
    empty_opset full_opset invert_opset verify_opset
    opdesc opcodes opmask define_optag opset_to_hex
);

*ops_to_opset = \&opset;   # Temporary alias for old Penguins


my $default_root  = 0;
my $default_share = ['*_']; #, '*main::'];

sub new {
    my($class, $root, $mask) = @_;
    my $obj = {};
    bless $obj, $class;

    if (defined($root)) {
	croak "Can't use \"$root\" as root name"
	    if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
	$obj->{Root}  = $root;
	$obj->{Erase} = 0;
    }
    else {
	$obj->{Root}  = "Safe::Root".$default_root++;
	$obj->{Erase} = 1;
    }

    # use permit/deny methods instead till interface issues resolved
    # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...;
    croak "Mask parameter to new no longer supported" if defined $mask;
    $obj->permit_only(':default');

    # We must share $_ and @_ with the compartment or else ops such
    # as split, length and so on won't default to $_ properly, nor
    # will passing argument to subroutines work (via @_). In fact,
    # for reasons I don't completely understand, we need to share
    # the whole glob *_ rather than $_ and @_ separately, otherwise
    # @_ in non default packages within the compartment don't work.
    $obj->share_from('main', $default_share);
    return $obj;
}

sub DESTROY {
    my $obj = shift;
    $obj->erase('DESTROY') if $obj->{Erase};
}

sub erase {
    my ($obj, $action) = @_;
    my $pkg = $obj->root();
    my ($stem, $leaf);

    no strict 'refs';
    $pkg = "main::$pkg\::";	# expand to full symbol table name
    ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;

    # The 'my $foo' is needed! Without it you get an
    # 'Attempt to free unreferenced scalar' warning!
    my $stem_symtab = *{$stem}{HASH};

    #warn "erase($pkg) stem=$stem, leaf=$leaf";
    #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
	# ", join(', ', %$stem_symtab),"\n";

#    delete $stem_symtab->{$leaf};

    my $leaf_glob   = $stem_symtab->{$leaf};
    my $leaf_symtab = *{$leaf_glob}{HASH};
#    warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
    %$leaf_symtab = ();
    #delete $leaf_symtab->{'__ANON__'};
    #delete $leaf_symtab->{'foo'};
    #delete $leaf_symtab->{'main::'};
#    my $foo = undef ${"$stem\::"}{"$leaf\::"};

    if ($action and $action eq 'DESTROY') {
        delete $stem_symtab->{$leaf};
    } else {
        $obj->share_from('main', $default_share);
    }
    1;
}


sub reinit {
    my $obj= shift;
    $obj->erase;
    $obj->share_redo;
}

sub root {
    my $obj = shift;
    croak("Safe root method now read-only") if @_;
    return $obj->{Root};
}


sub mask {
    my $obj = shift;
    return $obj->{Mask} unless @_;
    $obj->deny_only(@_);
}

# v1 compatibility methods
sub trap   { shift->deny(@_)   }
sub untrap { shift->permit(@_) }

sub deny {
    my $obj = shift;
    $obj->{Mask} |= opset(@_);
}
sub deny_only {
    my $obj = shift;
    $obj->{Mask} = opset(@_);
}

sub permit {
    my $obj = shift;
    # XXX needs testing
    $obj->{Mask} &= invert_opset opset(@_);
}
sub permit_only {
    my $obj = shift;
    $obj->{Mask} = invert_opset opset(@_);
}


sub dump_mask {
    my $obj = shift;
    print opset_to_hex($obj->{Mask}),"\n";
}



sub share {
    my($obj, @vars) = @_;
    $obj->share_from(scalar(caller), \@vars);
}

sub share_from {
    my $obj = shift;
    my $pkg = shift;
    my $vars = shift;
    my $no_record = shift || 0;
    my $root = $obj->root();
    croak("vars not an array ref") unless ref $vars eq 'ARRAY';
	no strict 'refs';
    # Check that 'from' package actually exists
    croak("Package \"$pkg\" does not exist")
	unless keys %{"$pkg\::"};
    my $arg;
    foreach $arg (@$vars) {
	# catch some $safe->share($var) errors:
	croak("'$arg' not a valid symbol table name")
	    unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/
	    	or $arg =~ /^\$\W$/;
	my ($var, $type);
	$type = $1 if ($var = $arg) =~ s/^(\W)//;
	# warn "share_from $pkg $type $var";
	*{$root."::$var"} = (!$type)       ? \&{$pkg."::$var"}
			  : ($type eq '&') ? \&{$pkg."::$var"}
			  : ($type eq '$') ? \${$pkg."::$var"}
			  : ($type eq '@') ? \@{$pkg."::$var"}
			  : ($type eq '%') ? \%{$pkg."::$var"}
			  : ($type eq '*') ?  *{$pkg."::$var"}
			  : croak(qq(Can't share "$type$var" of unknown type));
    }
    $obj->share_record($pkg, $vars) unless $no_record or !$vars;
}

sub share_record {
    my $obj = shift;
    my $pkg = shift;
    my $vars = shift;
    my $shares = \%{$obj->{Shares} ||= {}};
    # Record shares using keys of $obj->{Shares}. See reinit.
    @{$shares}{@$vars} = ($pkg) x @$vars if @$vars;
}
sub share_redo {
    my $obj = shift;
    my $shares = \%{$obj->{Shares} ||= {}};
	my($var, $pkg);
    while(($var, $pkg) = each %$shares) {
	# warn "share_redo $pkg\:: $var";
	$obj->share_from($pkg,  [ $var ], 1);
    }
}
sub share_forget {
    delete shift->{Shares};
}

sub varglob {
    my ($obj, $var) = @_;
    no strict 'refs';
    return *{$obj->root()."::$var"};
}


sub reval {
    my ($obj, $expr, $strict) = @_;
    my $root = $obj->{Root};

    # Create anon sub ref in root of compartment.
    # Uses a closure (on $expr) to pass in the code to be executed.
    # (eval on one line to keep line numbers as expected by caller)
	my $evalcode = sprintf('package %s; sub { eval $expr; }', $root);
    my $evalsub;

	if ($strict) { use strict; $evalsub = eval $evalcode; }
	else         {  no strict; $evalsub = eval $evalcode; }

    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
}

sub rdo {
    my ($obj, $file) = @_;
    my $root = $obj->{Root};

    my $evalsub = eval
	    sprintf('package %s; sub { do $file }', $root);
    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
}


1;

__END__

=head1 NAME

Safe - Compile and execute code in restricted compartments

=head1 SYNOPSIS

  use Safe;

  $compartment = new Safe;

  $compartment->permit(qw(time sort :browse));

  $result = $compartment->reval($unsafe_code);

=head1 DESCRIPTION

The Safe extension module allows the creation of compartments
in which perl code can be evaluated. Each compartment has

=over 8

=item a new namespace

The "root" of the namespace (i.e. "main::") is changed to a
different package and code evaluated in the compartment cannot
refer to variables outside this namespace, even with run-time
glob lookups and other tricks.

Code which is compiled outside the compartment can choose to place
variables into (or I<share> variables with) the compartment's namespace
and only that data will be visible to code evaluated in the
compartment.

By default, the only variables shared with compartments are the
"underscore" variables $_ and @_ (and, technically, the less frequently
used %_, the _ filehandle and so on). This is because otherwise perl
operators which default to $_ will not work and neither will the
assignment of arguments to @_ on subroutine entry.

=item an operator mask

Each compartment has an associated "operator mask". Recall that
perl code is compiled into an internal format before execution.
Evaluating perl code (e.g. via "eval" or "do 'file'") causes
the code to be compiled into an internal format and then,
provided there was no error in the compilation, executed.
Code evaluated in a compartment compiles subject to the
compartment's operator mask. Attempting to evaluate code in a
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.

The default operator mask for a newly created compartment is
the ':default' optag.

It is important that you read the Opcode(3) module documentation
for more information, especially for detailed definitions of opnames,
optags and opsets.

Since it is only at the compilation stage that the operator mask
applies, controlled access to potentially unsafe operations can
be achieved by having a handle to a wrapper subroutine (written
outside the compartment) placed into the compartment. For example,

    $cpt = new Safe;
    sub wrapper {
        # vet arguments and perform potentially unsafe operations
    }
    $cpt->share('&wrapper');

=back


=head1 WARNING

The authors make B<no warranty>, implied or otherwise, about the
suitability of this software for safety or security purposes.

The authors shall not in any case be liable for special, incidental,
consequential, indirect or other similar damages arising from the use
of this software.

Your mileage will vary. If in any doubt B<do not use it>.


=head2 RECENT CHANGES

The interface to the Safe module has changed quite dramatically since
version 1 (as supplied with Perl5.002). Study these pages carefully if
you have code written to use Safe version 1 because you will need to
makes changes.


=head2 Methods in class Safe

To create a new compartment, use

    $cpt = new Safe;

Optional argument is (NAMESPACE), where NAMESPACE is the root namespace
to use for the compartment (defaults to "Safe::Root0", incremented for
each new compartment).

Note that version 1.00 of the Safe module supported a second optional
parameter, MASK.  That functionality has been withdrawn pending deeper
consideration. Use the permit and deny methods described below.

The following methods can then be used on the compartment
object returned by the above constructor. The object argument
is implicit in each case.


=over 8

=item permit (OP, ...)

Permit the listed operators to be used when compiling code in the
compartment (in I<addition> to any operators already permitted).

=item permit_only (OP, ...)

Permit I<only> the listed operators to be used when compiling code in
the compartment (I<no> other operators are permitted).

=item deny (OP, ...)

Deny the listed operators from being used when compiling code in the
compartment (other operators may still be permitted).

=item deny_only (OP, ...)

Deny I<only> the listed operators from being used when compiling code
in the compartment (I<all> other operators will be permitted).

=item trap (OP, ...)

=item untrap (OP, ...)

The trap and untrap methods are synonyms for deny and permit
respectfully.

=item share (NAME, ...)

This shares the variable(s) in the argument list with the compartment.
This is almost identical to exporting variables using the L<Exporter(3)>
module.

Each NAME must be the B<name> of a variable, typically with the leading
type identifier included. A bareword is treated as a function name.

Examples of legal names are '$foo' for a scalar, '@foo' for an
array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo'
for a glob (i.e.  all symbol table entries associated with "foo",
including scalar, array, hash, sub and filehandle).

Each NAME is assumed to be in the calling package. See share_from
for an alternative method (which share uses).

=item share_from (PACKAGE, ARRAYREF)

This method is similar to share() but allows you to explicitly name the
package that symbols should be shared from. The symbol names (including
type characters) are supplied as an array reference.

    $safe->share_from('main', [ '$foo', '%bar', 'func' ]);


=item varglob (VARNAME)

This returns a glob reference for the symbol table entry of VARNAME in
the package of the compartment. VARNAME must be the B<name> of a
variable without any leading type marker. For example,

    $cpt = new Safe 'Root';
    $Root::foo = "Hello world";
    # Equivalent version which doesn't need to know $cpt's package name:
    ${$cpt->varglob('foo')} = "Hello world";


=item reval (STRING)

This evaluates STRING as perl code inside the compartment.

The code can only see the compartment's namespace (as returned by the
B<root> method). The compartment's root package appears to be the
C<main::> package to the code inside the compartment.

Any attempt by the code in STRING to use an operator which is not permitted
by the compartment will cause an error (at run-time of the main program
but at compile-time for the code in STRING).  The error is of the form
"%s trapped by operation mask operation...".

If an operation is trapped in this way, then the code in STRING will
not be executed. If such a trapped operation occurs or any other
compile-time or return error, then $@ is set to the error message, just
as with an eval().

If there is no error, then the method returns the value of the last
expression evaluated, or a return statement may be used, just as with
subroutines and B<eval()>. The context (list or scalar) is determined
by the caller as usual.

This behaviour differs from the beta distribution of the Safe extension
where earlier versions of perl made it hard to mimic the return
behaviour of the eval() command and the context was always scalar.

Some points to note:

If the entereval op is permitted then the code can use eval "..." to
'hide' code which might use denied ops. This is not a major problem
since when the code tries to execute the eval it will fail because the
opmask is still in effect. However this technique would allow clever,
and possibly harmful, code to 'probe' the boundaries of what is
possible.

Any string eval which is executed by code executing in a compartment,
or by code called from code executing in a compartment, will be eval'd
in the namespace of the compartment. This is potentially a serious
problem.

Consider a function foo() in package pkg compiled outside a compartment
but shared with it. Assume the compartment has a root package called
'Root'. If foo() contains an eval statement like eval '$foo = 1' then,
normally, $pkg::foo will be set to 1.  If foo() is called from the
compartment (by whatever means) then instead of setting $pkg::foo, the
eval will actually set $Root::pkg::foo.

This can easily be demonstrated by using a module, such as the Socket
module, which uses eval "..." as part of an AUTOLOAD function. You can
'use' the module outside the compartment and share an (autoloaded)
function with the compartment. If an autoload is triggered by code in
the compartment, or by any code anywhere that is called by any means
from the compartment, then the eval in the Socket module's AUTOLOAD
function happens in the namespace of the compartment. Any variables
created or used by the eval'd code are now under the control of
the code in the compartment.

A similar effect applies to I<all> runtime symbol lookups in code
called from a compartment but not compiled within it.



=item rdo (FILENAME)

This evaluates the contents of file FILENAME inside the compartment.
See above documentation on the B<reval> method for further details.

=item root (NAMESPACE)

This method returns the name of the package that is the root of the
compartment's namespace.

Note that this behaviour differs from version 1.00 of the Safe module
where the root module could be used to change the namespace. That
functionality has been withdrawn pending deeper consideration.

=item mask (MASK)

This is a get-or-set method for the compartment's operator mask.

With no MASK argument present, it returns the current operator mask of
the compartment.

With the MASK argument present, it sets the operator mask for the
compartment (equivalent to calling the deny_only method).

=back


=head2 Some Safety Issues

This section is currently just an outline of some of the things code in
a compartment might do (intentionally or unintentionally) which can
have an effect outside the compartment.

=over 8

=item Memory

Consuming all (or nearly all) available memory.

=item CPU

Causing infinite loops etc.

=item Snooping

Copying private information out of your system. Even something as
simple as your user name is of value to others. Much useful information
could be gleaned from your environment variables for example.

=item Signals

Causing signals (especially SIGFPE and SIGALARM) to affect your process.

Setting up a signal handler will need to be carefully considered
and controlled.  What mask is in effect when a signal handler
gets called?  If a user can get an imported function to get an
exception and call the user's signal handler, does that user's
restricted mask get re-instated before the handler is called?
Does an imported handler get called with its original mask or
the user's one?

=item State Changes

Ops such as chdir obviously effect the process as a whole and not just
the code in the compartment. Ops such as rand and srand have a similar
but more subtle effect.

=back

=head2 AUTHOR

Originally designed and implemented by Malcolm Beattie,
mbeattie@sable.ox.ac.uk.

Reworked to use the Opcode module and other changes added by Tim Bunce
E<lt>F<Tim.Bunce@ig.co.uk>E<gt>.

=cut

 break/watch/actions
  B<O> [...]     Set debugger options        B<t> [I<expr>]    Toggle trace [trace expr]
  B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  # Scalar::Util.pm
#
# Copyright (c) 1997-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Scalar::Util;

require Exporter;
require List::Util; # List::Util loads the XS

our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly);
our $VERSION   = $List::Util::VERSION;

1;

__END__

=head1 NAME

Scalar::Util - A selection of general-utility scalar subroutines

=head1 SYNOPSIS

    use Scalar::Util qw(blessed dualvar isweak readonly reftype tainted weaken);

=head1 DESCRIPTION

C<Scalar::Util> contains a selection of subroutines that people have
expressed would be nice to have in the perl core, but the usage would
not really be high enough to warrant the use of a keyword, and the size
so small such that being individual extensions would be wasteful.

By default C<Scalar::Util> does not export any subroutines. The
subroutines defined are

=over 4

=item blessed EXPR

If EXPR evaluates to a blessed reference the name of the package
that it is blessed into is returned. Otherwise C<undef> is returned.

   $scalar = "foo";
   $class  = blessed $scalar;           # undef

   $ref    = [];
   $class  = blessed $ref;              # undef

   $obj    = bless [], "Foo";
   $class  = blessed $obj;              # "Foo"

=item dualvar NUM, STRING

Returns a scalar that has the value NUM in a numeric context and the
value STRING in a string context.

    $foo = dualvar 10, "Hello";
    $num = $foo + 2;                    # 12
    $str = $foo . " world";             # Hello world

=item isweak EXPR

If EXPR is a scalar which is a weak reference the result is true.

    $ref  = \$foo;
    $weak = isweak($ref);               # false
    weaken($ref);
    $weak = isweak($ref);               # true

=item readonly SCALAR

Returns true if SCALAR is readonly.

    sub foo { readonly($_[0]) }

    $readonly = foo($bar);              # false
    $readonly = foo(0);                 # true

=item reftype EXPR

If EXPR evaluates to a reference the type of the variable referenced
is returned. Otherwise C<undef> is returned.

    $type = reftype "string";           # undef
    $type = reftype \$var;              # SCALAR
    $type = reftype [];                 # ARRAY

    $obj  = bless {}, "Foo";
    $type = reftype $obj;               # HASH

=item tainted EXPR

Return true if the result of EXPR is tainted

    $taint = tainted("constant");       # false
    $taint = tainted($ENV{PWD});        # true if running under -T

=item weaken REF

REF will be turned into a weak reference. This means that it will not
hold a reference count on the object it references. Also when the reference
count on that object reaches zero, REF will be set to undef.

This is useful for keeping copies of references , but you don't want to
prevent the object being DESTROY-ed at its usual time.

    {
      my $var;
      $ref = \$var;
      weaken($ref);                     # Make $ref a weak reference
    }
    # $ref is now undef

=back

=head1 COPYRIGHT

Copyright (c) 1997-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

Except weaken and isweak which are

Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

=head1 BLATANT PLUG

The weaken and isweak subroutines in this module and the patch to the core Perl
were written in connection  with the APress book `Tuomas J. Lukka's Definitive
Guide to Object-Oriented Programming in Perl', to avoid explaining why certain
things would have to be done in cumbersome ways.

=cut
WARN__} = '';
  my $i = 0; my $ineval = 0; my $sub;
  if ($dieLevel > 2) {
      local $SIG{__WARN__} = \&dbwarn;
      &warn(@_);		# Yell no matter what
      return;
  }
  if ($dieLevel < 2) {
    die @_ if $^S;		# in eval propagate
  }
  ev                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Search::Dict;
require 5.000;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(look);

=head1 NAME

Search::Dict, look - search for key in dictionary file

=head1 SYNOPSIS

    use Search::Dict;
    look *FILEHANDLE, $key, $dict, $fold;

=head1 DESCRIPTION

Sets file position in FILEHANDLE to be first line greater than or equal
(stringwise) to I<$key>.  Returns the new file position, or -1 if an error
occurs.

The flags specify dictionary order and case folding:

If I<$dict> is true, search by dictionary order (ignore anything but word
characters and whitespace).

If I<$fold> is true, ignore case.

=cut

sub look {
    local(*FH,$key,$dict,$fold) = @_;
    local($_);
    my(@stat) = stat(FH)
	or return -1;
    my($size, $blksize) = @stat[7,11];
    $blksize ||= 8192;
    $key =~ s/[^\w\s]//g if $dict;
    $key = lc $key if $fold;
    my($min, $max, $mid) = (0, int($size / $blksize));
    while ($max - $min > 1) {
	$mid = int(($max + $min) / 2);
	seek(FH, $mid * $blksize, 0)
	    or return -1;
	<FH> if $mid;			# probably a partial line
	$_ = <FH>;
	chop;
	s/[^\w\s]//g if $dict;
	$_ = lc $_ if $fold;
	if (defined($_) && $_ lt $key) {
	    $min = $mid;
	}
	else {
	    $max = $mid;
	}
    }
    $min *= $blksize;
    seek(FH,$min,0)
	or return -1;
    <FH> if $min;
    for (;;) {
	$min = tell(FH);
	defined($_ = <FH>)
	    or last;
	chop;
	s/[^\w\s]//g if $dict;
	$_ = lc $_ if $fold;
	last if $_ ge $key;
    }
    seek(FH,$min,0);
    $min;
}

1;
= \&DB::diesignal;
      $SIG{BUS} = \&DB::diesignal;
    }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 package SelectSaver;

=head1 NAME

SelectSaver - save and restore selected file handle

=head1 SYNOPSIS

    use SelectSaver;

    {
       my $saver = new SelectSaver(FILEHANDLE);
       # FILEHANDLE is selected
    }
    # previous handle is selected

    {
       my $saver = new SelectSaver;
       # new handle may be selected, or not
    }
    # previous handle is selected

=head1 DESCRIPTION

A C<SelectSaver> object contains a reference to the file handle that
was selected when it was created.  If its C<new> method gets an extra
parameter, then that parameter is selected; otherwise, the selected
file handle remains unchanged.

When a C<SelectSaver> is destroyed, it re-selects the file handle
that was selected when it was created.

=cut

require 5.000;
use Carp;
use Symbol;

sub new {
    @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
    my $fh = select;
    my $self = bless [$fh], $_[0];
    select qualify($_[1], caller) if @_ > 1;
    $self;
}

sub DESTROY {
    my $this = $_[0];
    select $$this[0];
}

1;
thods_via {
  my $class = shift;
  return if $packs{$class}++;
  my $prefix = shift;
  my $prepend = $prefix ? "via $prefix: " : '';
  my $name;
  for $name (grep {defined &{${"${class}::"}{$_}}} 
	     sort keys %{"${class}::"}) {
    next if $seen{ $name }++;
    print $DB::OUT "$prepend$name\n";
  }
  return unless shift;		# Recurse?
  for $name (@{"${class}::ISA"}) {
    $prepend = $prefix ? $prefix . " -> $name" : $name;
    methods_via($name, $prepend, 1);
  }
}

sub setman {                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package SelfLoader;
# use Carp;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(AUTOLOAD);
$VERSION = "1.0902";
sub Version {$VERSION}
$DEBUG = 0;

my %Cache;      # private cache for all SelfLoader's client packages

# allow checking for valid ': attrlist' attachments
my $nested;
$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;

sub croak { require Carp; goto &Carp::croak }

AUTOLOAD {
    print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
    my $SL_code = $Cache{$AUTOLOAD};
    my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@
    unless ($SL_code) {
        # Maybe this pack had stubs before __DATA__, and never initialized.
        # Or, this maybe an automatic DESTROY method call when none exists.
        $AUTOLOAD =~ m/^(.*)::/;
        SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
        $SL_code = $Cache{$AUTOLOAD};
        $SL_code = "sub $AUTOLOAD { }"
            if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/);
        croak "Undefined subroutine $AUTOLOAD" unless $SL_code;
    }
    print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG;

    eval $SL_code;
    if ($@) {
        $@ =~ s/ at .*\n//;
        croak $@;
    }
    $@ = $save;
    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
    delete $Cache{$AUTOLOAD};
    goto &$AUTOLOAD
}

sub load_stubs { shift->_load_stubs((caller)[0]) }

sub _load_stubs {
    my($self, $callpack) = @_;
    my $fh = \*{"${callpack}::DATA"};
    my $currpack = $callpack;
    my($line,$name,@lines, @stubs, $protoype);

    print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG;
    croak("$callpack doesn't contain an __DATA__ token")
        unless fileno($fh);
    $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached

    local($/) = "\n";
    while(defined($line = <$fh>) and $line !~ m/^__END__/) {
	if ($line =~ m/^sub\s+([\w:]+)\s*((?:\([\\\$\@\%\&\*\;]*\))?(?:$attr_list)?)/) {
            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
            $protoype = $2;
            @lines = ($line);
            if (index($1,'::') == -1) {         # simple sub name
                $name = "${currpack}::$1";
            } else {                            # sub name with package
                $name = $1;
                $name =~ m/^(.*)::/;
                if (defined(&{"${1}::AUTOLOAD"})) {
                    \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
                        die 'SelfLoader Error: attempt to specify Selfloading',
                            " sub $name in non-selfloading module $1";
                } else {
                    $self->export($1,'AUTOLOAD');
                }
            }
        } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
            $self->_package_defined($line);
            $name = '';
            @lines = ();
            $currpack = $1;
            $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
            if (defined(&{"${1}::AUTOLOAD"})) {
                \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
                    die 'SelfLoader Error: attempt to specify Selfloading',
                        " package $currpack which already has AUTOLOAD";
            } else {
                $self->export($currpack,'AUTOLOAD');
            }
        } else {
            push(@lines,$line);
        }
    }
    close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/;     # __END__
    push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
    eval join('', @stubs) if @stubs;
}


sub _add_to_cache {
    my($self,$fullname,$pack,$lines, $protoype) = @_;
    return () unless $fullname;
    (require Carp), Carp::carp("Redefining sub $fullname")
      if exists $Cache{$fullname};
    $Cache{$fullname} = join('', "package $pack; ",@$lines);
    print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
    # return stub to be eval'd
    defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
}

sub _package_defined {}

1;
__END__

=head1 NAME

SelfLoader - load functions only on demand

=head1 SYNOPSIS

    package FOOBAR;
    use SelfLoader;

    ... (initializing code)

    __DATA__
    sub {....


=head1 DESCRIPTION

This module tells its users that functions in the FOOBAR package are to be
autoloaded from after the C<__DATA__> token.  See also
L<perlsub/"Autoloading">.

=head2 The __DATA__ token

The C<__DATA__> token tells the perl compiler that the perl code
for compilation is finished. Everything after the C<__DATA__> token
is available for reading via the filehandle FOOBAR::DATA,
where FOOBAR is the name of the current package when the C<__DATA__>
token is reached. This works just the same as C<__END__> does in
package 'main', but for other modules data after C<__END__> is not
automatically retrievable, whereas data after C<__DATA__> is.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.

Note that it is possible to have C<__DATA__> tokens in the same package
in multiple files, and that the last C<__DATA__> token in a given
package that is encountered by the compiler is the one accessible
by the filehandle. This also applies to C<__END__> and main, i.e. if
the 'main' program has an C<__END__>, but a module 'require'd (_not_ 'use'd)
by that program has a 'package main;' declaration followed by an 'C<__DATA__>',
then the C<DATA> filehandle is set to access the data after the C<__DATA__>
in the module, _not_ the data after the C<__END__> token in the 'main'
program, since the compiler encounters the 'require'd file later.

=head2 SelfLoader autoloading

The B<SelfLoader> works by the user placing the C<__DATA__>
token I<after> perl code which needs to be compiled and
run at 'require' time, but I<before> subroutine declarations
that can be loaded in later - usually because they may never
be called.

The B<SelfLoader> will read from the FOOBAR::DATA filehandle to
load in the data after C<__DATA__>, and load in any subroutine
when it is called. The costs are the one-time parsing of the
data after C<__DATA__>, and a load delay for the _first_
call of any autoloaded function. The benefits (hopefully)
are a speeded up compilation phase, with no need to load
functions which are never used.

The B<SelfLoader> will stop reading from C<__DATA__> if
it encounters the C<__END__> token - just as you would expect.
If the C<__END__> token is present, and is followed by the
token DATA, then the B<SelfLoader> leaves the FOOBAR::DATA
filehandle open on the line after that token.

The B<SelfLoader> exports the C<AUTOLOAD> subroutine to the
package using the B<SelfLoader>, and this loads the called
subroutine when it is first called.

There is no advantage to putting subroutines which will _always_
be called after the C<__DATA__> token.

=head2 Autoloading and package lexicals

A 'my $pack_lexical' statement makes the variable $pack_lexical
local _only_ to the file up to the C<__DATA__> token. Subroutines
declared elsewhere _cannot_ see these types of variables,
just as if you declared subroutines in the package but in another
file, they cannot see these variables.

So specifically, autoloaded functions cannot see package
lexicals (this applies to both the B<SelfLoader> and the Autoloader).
The C<vars> pragma provides an alternative to defining package-level
globals that will be visible to autoloaded routines. See the documentation
on B<vars> in the pragma section of L<perlmod>.

=head2 SelfLoader and AutoLoader

The B<SelfLoader> can replace the AutoLoader - just change 'use AutoLoader'
to 'use SelfLoader' (though note that the B<SelfLoader> exports
the AUTOLOAD function - but if you have your own AUTOLOAD and
are using the AutoLoader too, you probably know what you're doing),
and the C<__END__> token to C<__DATA__>. You will need perl version 5.001m
or later to use this (version 5.001 with all patches up to patch m).

There is no need to inherit from the B<SelfLoader>.

The B<SelfLoader> works similarly to the AutoLoader, but picks up the
subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
There is a maintenance gain in not needing to run AutoSplit on the module
at installation, and a runtime gain in not needing to keep opening and
closing files to load subs. There is a runtime loss in needing
to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
another view of these distinctions can be found in that module's
documentation.

=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.

This section is only relevant if you want to use
the C<FOOBAR::DATA> together with the B<SelfLoader>.

Data after the C<__DATA__> token in a module is read using the
FOOBAR::DATA filehandle. C<__END__> can still be used to denote the end
of the C<__DATA__> section if followed by the token DATA - this is supported
by the B<SelfLoader>. The C<FOOBAR::DATA> filehandle is left open if an
C<__END__> followed by a DATA is found, with the filehandle positioned at
the start of the line after the C<__END__> token. If no C<__END__> token is
present, or an C<__END__> token with no DATA token on the same line, then
the filehandle is closed.

The B<SelfLoader> reads from wherever the current
position of the C<FOOBAR::DATA> filehandle is, until the
EOF or C<__END__>. This means that if you want to use
that filehandle (and ONLY if you want to), you should either

1. Put all your subroutine declarations immediately after
the C<__DATA__> token and put your own data after those
declarations, using the C<__END__> token to mark the end
of subroutine declarations. You must also ensure that the B<SelfLoader>
reads first by  calling 'SelfLoader-E<gt>load_stubs();', or by using a
function which is selfloaded;

or

2. You should read the C<FOOBAR::DATA> filehandle first, leaving
the handle open and positioned at the first line of subroutine
declarations.

You could conceivably do both.

=head2 Classes and inherited methods.

For modules which are not classes, this section is not relevant.
This section is only relevant if you have methods which could
be inherited.

A subroutine stub (or forward declaration) looks like

  sub stub;

i.e. it is a subroutine declaration without the body of the
subroutine. For modules which are not classes, there is no real
need for stubs as far as autoloading is concerned.

For modules which ARE classes, and need to handle inherited methods,
stubs are needed to ensure that the method inheritance mechanism works
properly. You can load the stubs into the module at 'require' time, by
adding the statement 'SelfLoader-E<gt>load_stubs();' to the module to do
this.

The alternative is to put the stubs in before the C<__DATA__> token BEFORE
releasing the module, and for this purpose the C<Devel::SelfStubber>
module is available.  However this does require the extra step of ensuring
that the stubs are in the module. If this is done I strongly recommend
that this is done BEFORE releasing the module - it should NOT be done
at install time in general.

=head1 Multiple packages and fully qualified subroutine names

Subroutines in multiple packages within the same file are supported - but you
should note that this requires exporting the C<SelfLoader::AUTOLOAD> to
every package which requires it. This is done automatically by the
B<SelfLoader> when it first loads the subs into the cache, but you should
really specify it in the initialization before the C<__DATA__> by putting
a 'use SelfLoader' statement in each package.

Fully qualified subroutine names are also supported. For example,

   __DATA__
   sub foo::bar {23}
   package baz;
   sub dob {32}

will all be loaded correctly by the B<SelfLoader>, and the B<SelfLoader>
will ensure that the packages 'foo' and 'baz' correctly have the
B<SelfLoader> C<AUTOLOAD> method when the data after C<__DATA__> is first
parsed.

=cut
raph

There is some whitespace on a seemingly empty line. POD is very sensitive
to such things, so this is flagged. B<vi> users switch on the B<list>
opt                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Shell;
use 5.005_64;
use strict;
use warnings;
our($capture_stderr, $VERSION, $AUTOLOAD);

$VERSION = '0.3';

sub new { bless \$VERSION, shift } # Nothing better to bless
sub DESTROY { }

sub import {
    my $self = shift;
    my ($callpack, $callfile, $callline) = caller;
    my @EXPORT;
    if (@_) {
	@EXPORT = @_;
    } else {
	@EXPORT = 'AUTOLOAD';
    }
    foreach my $sym (@EXPORT) {
        no strict 'refs';
        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
    }
}

sub AUTOLOAD {
    shift if ref $_[0] && $_[0]->isa( 'Shell' );
    my $cmd = $AUTOLOAD;
    $cmd =~ s/^.*:://;
    eval <<"*END*";
	sub $AUTOLOAD {
	    if (\@_ < 1) {
		\$Shell::capture_stderr ? `$cmd 2>&1` : `$cmd`;
	    } elsif ('$^O' eq 'os2') {
		local(\*SAVEOUT, \*READ, \*WRITE);

		open SAVEOUT, '>&STDOUT' or die;
		pipe READ, WRITE or die;
		open STDOUT, '>&WRITE' or die;
		close WRITE;

		my \$pid = system(1, '$cmd', \@_);
		die "Can't execute $cmd: \$!\\n" if \$pid < 0;

		open STDOUT, '>&SAVEOUT' or die;
		close SAVEOUT;

		if (wantarray) {
		    my \@ret = <READ>;
		    close READ;
		    waitpid \$pid, 0;
		    \@ret;
		} else {
		    local(\$/) = undef;
		    my \$ret = <READ>;
		    close READ;
		    waitpid \$pid, 0;
		    \$ret;
		}
	    } else {
		my \$a;
		my \@arr = \@_;
		if ('$^O' eq 'MSWin32') {
		    # XXX this special-casing should not be needed
		    # if we do quoting right on Windows. :-(
		    #
		    # First, escape all quotes.  Cover the case where we
		    # want to pass along a quote preceded by a backslash
		    # (i.e., C<"param \\""" end">).
		    # Ugly, yup?  You know, windoze.
		    # Enclose in quotes only the parameters that need it:
		    #   try this: c:\> dir "/w"
		    #   and this: c:\> dir /w
		    for (\@arr) {
			s/"/\\\\"/g;
			s/\\\\\\\\"/\\\\\\\\"""/g;
			\$_ = qq["\$_"] if /\\s/;
		    }
		} else {
		    for (\@arr) {
			s/(['\\\\])/\\\\\$1/g;
			\$_ = \$_;
		    }
		}
		push \@arr, '2>&1' if \$Shell::capture_stderr;
		open(SUBPROC, join(' ', '$cmd', \@arr, '|'))
		    or die "Can't exec $cmd: \$!\\n";
		if (wantarray) {
		    my \@ret = <SUBPROC>;
		    close SUBPROC;	# XXX Oughta use a destructor.
		    \@ret;
		} else {
		    local(\$/) = undef;
		    my \$ret = <SUBPROC>;
		    close SUBPROC;
		    \$ret;
		}
	    }
	}
*END*

    die "$@\n" if $@;
    goto &$AUTOLOAD;
}

1;

__END__

=head1 NAME

Shell - run shell commands transparently within perl

=head1 SYNOPSIS

See below.

=head1 DESCRIPTION

  Date: Thu, 22 Sep 94 16:18:16 -0700
  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
  To: perl5-porters@isu.edu
  From: Larry Wall <lwall@scalpel.netlabs.com>
  Subject: a new module I just wrote

Here's one that'll whack your mind a little out.

    #!/usr/bin/perl

    use Shell;

    $foo = echo("howdy", "<funny>", "world");
    print $foo;

    $passwd = cat("</etc/passwd");
    print $passwd;

    sub ps;
    print ps -ww;

    cp("/etc/passwd", "/tmp/passwd");

That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
usage should be

    use Shell qw(echo cat ps cp);

Larry


If you set $Shell::capture_stderr to 1, the module will attempt to
capture the STDERR of the process as well.

The module now should work on Win32.

 Jenda

There seemed to be a problem where all arguments to a shell command were
quoted before being executed.  As in the following example:

 cat('</etc/passwd');
 ls('*.pl');

really turned into:

 cat '</etc/passwd'
 ls '*.pl'

instead of:

  cat </etc/passwd
  ls *.pl

and of course, this is wrong.

I have fixed this bug, it was brought up by Wolfgang Laun [ID 20000326.008]

Casey

=head2 OBJECT ORIENTED SYNTAX

Shell now has an OO interface.  Good for namespace conservation 
and shell representation.

 use Shell;
 my $sh = Shell->new;
 print $sh->ls;

Casey

=head1 AUTHOR

Larry Wall

Changes by Jenda@Krynicky.cz and Dave Cottle <d.cottle@csc.canterbury.ac.nz>

Changes and bug fixes by Casey Tweten <crt@kiski.net>

=cut
   =>  1,
    'begin'  =>  1,
    'end'    =>  1,
);
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ;# shellwords.pl
;#
;# Usage:
;#	require 'shellwords.pl';
;#	@words = &shellwords($line);
;#	or
;#	@words = &shellwords(@lines);
;#	or
;#	@words = &shellwords;		# defaults to $_ (and clobbers it)

sub shellwords {
    package shellwords;
    local($_) = join('', @_) if @_;
    local(@words,$snippet,$field);

    s/^\s+//;
    while ($_ ne '') {
	$field = '';
	for (;;) {
	    if (s/^"(([^"\\]|\\.)*)"//) {
		($snippet = $1) =~ s#\\(.)#$1#g;
	    }
	    elsif (/^"/) {
		die "Unmatched double quote: $_\n";
	    }
	    elsif (s/^'(([^'\\]|\\.)*)'//) {
		($snippet = $1) =~ s#\\(.)#$1#g;
	    }
	    elsif (/^'/) {
		die "Unmatched single quote: $_\n";
	    }
	    elsif (s/^\\(.)//) {
		$snippet = $1;
	    }
	    elsif (s/^([^\s\\'"]+)//) {
		$snippet = $1;
	    }
	    else {
		s/^\s+//;
		last;
	    }
	    $field .= $snippet;
	}
	push(@words, $field);
    }
    @words;
}
1;
accent
 Ecirc	=> '',  # capital E, circumflex accent
 Egrave	=> '',  # capital E, grave accent
 Euml	=> '',  # capital E, dieresis or umlaut                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 package sigtrap;

=head1 NAME

sigtrap - Perl pragma to enable simple signal handling

=cut

use Carp;

$VERSION = 1.02;
$Verbose ||= 0;

sub import {
    my $pkg = shift;
    my $handler = \&handler_traceback;
    my $saw_sig = 0;
    my $untrapped = 0;
    local $_;

  Arg_loop:
    while (@_) {
	$_ = shift;
	if (/^[A-Z][A-Z0-9]*$/) {
	    $saw_sig++;
	    unless ($untrapped and $SIG{$_} and $SIG{$_} ne 'DEFAULT') {
		print "Installing handler $handler for $_\n" if $Verbose;
		$SIG{$_} = $handler;
	    }
	}
	elsif ($_ eq 'normal-signals') {
	    unshift @_, grep(exists $SIG{$_}, qw(HUP INT PIPE TERM));
	}
	elsif ($_ eq 'error-signals') {
	    unshift @_, grep(exists $SIG{$_},
			     qw(ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP));
	}
	elsif ($_ eq 'old-interface-signals') {
	    unshift @_,
	    grep(exists $SIG{$_},
		 qw(ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP));
	}
    	elsif ($_ eq 'stack-trace') {
	    $handler = \&handler_traceback;
	}
	elsif ($_ eq 'die') {
	    $handler = \&handler_die;
	}
	elsif ($_ eq 'handler') {
	    @_ or croak "No argument specified after 'handler'";
	    $handler = shift;
	    unless (ref $handler or $handler eq 'IGNORE'
			or $handler eq 'DEFAULT') {
    	    	require Symbol;
		$handler = Symbol::qualify($handler, (caller)[0]);
	    }
	}
	elsif ($_ eq 'untrapped') {
	    $untrapped = 1;
	}
	elsif ($_ eq 'any') {
	    $untrapped = 0;
	}
	elsif ($_ =~ /^\d/) {
	    $VERSION >= $_ or croak "sigtrap.pm version $_ required,"
		    	    	    	. " but this is only version $VERSION";
	}
	else {
	    croak "Unrecognized argument $_";
	}
    }
    unless ($saw_sig) {
	@_ = qw(old-interface-signals);
	goto Arg_loop;
    }
}

sub handler_die {
    croak "Caught a SIG$_[0]";
}

sub handler_traceback {
    package DB;		# To get subroutine args.
    $SIG{'ABRT'} = DEFAULT;
    kill 'ABRT', $$ if $panic++;
    syswrite(STDERR, 'Caught a SIG', 12);
    syswrite(STDERR, $_[0], length($_[0]));
    syswrite(STDERR, ' at ', 4);
    ($pack,$file,$line) = caller;
    syswrite(STDERR, $file, length($file));
    syswrite(STDERR, ' line ', 6);
    syswrite(STDERR, $line, length($line));
    syswrite(STDERR, "\n", 1);

    # Now go for broke.
    for ($i = 1; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
        @a = ();
	for $arg (@args) {
	    $_ = "$arg";
	    s/([\'\\])/\\$1/g;
	    s/([^\0]*)/'$1'/
	      unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
	    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
	    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
	    push(@a, $_);
	}
	$w = $w ? '@ = ' : '$ = ';
	$a = $h ? '(' . join(', ', @a) . ')' : '';
	$e =~ s/\n\s*\;\s*\Z// if $e;
	$e =~ s/[\\\']/\\$1/g if $e;
	if ($r) {
	    $s = "require '$e'";
	} elsif (defined $r) {
	    $s = "eval '$e'";
	} elsif ($s eq '(eval)') {
	    $s = "eval {...}";
	}
	$f = "file `$f'" unless $f eq '-e';
	$mess = "$w$s$a called from $f line $l\n";
	syswrite(STDERR, $mess, length($mess));
    }
    kill 'ABRT', $$;
}

1;

__END__

=head1 SYNOPSIS

    use sigtrap;
    use sigtrap qw(stack-trace old-interface-signals);	# equivalent
    use sigtrap qw(BUS SEGV PIPE ABRT);
    use sigtrap qw(die INT QUIT);
    use sigtrap qw(die normal-signals);
    use sigtrap qw(die untrapped normal-signals);
    use sigtrap qw(die untrapped normal-signals
		    stack-trace any error-signals);
    use sigtrap 'handler' => \&my_handler, 'normal-signals';
    use sigtrap qw(handler my_handler normal-signals
    	    	    stack-trace error-signals);

=head1 DESCRIPTION

The B<sigtrap> pragma is a simple interface to installing signal
handlers.  You can have it install one of two handlers supplied by
B<sigtrap> itself (one which provides a Perl stack trace and one which
simply C<die()>s), or alternately you can supply your own handler for it
to install.  It can be told only to install a handler for signals which
are either untrapped or ignored.  It has a couple of lists of signals to
trap, plus you can supply your own list of signals.

The arguments passed to the C<use> statement which invokes B<sigtrap>
are processed in order.  When a signal name or the name of one of
B<sigtrap>'s signal lists is encountered a handler is immediately
installed, when an option is encountered it affects subsequently
installed handlers.

=head1 OPTIONS

=head2 SIGNAL HANDLERS

These options affect which handler will be used for subsequently
installed signals.

=over 4

=item B<stack-trace>

The handler used for subsequently installed signals outputs a Perl stack
trace to STDERR and then tries to dump core.  This is the default signal
handler.

=item B<die>

The handler used for subsequently installed signals calls C<die>
(actually C<croak>) with a message indicating which signal was caught.

=item B<handler> I<your-handler>

I<your-handler> will be used as the handler for subsequently installed
signals.  I<your-handler> can be any value which is valid as an
assignment to an element of C<%SIG>.

=back

=head2 SIGNAL LISTS

B<sigtrap> has a few built-in lists of signals to trap.  They are:

=over 4

=item B<normal-signals>

These are the signals which a program might normally expect to encounter
and which by default cause it to terminate.  They are HUP, INT, PIPE and
TERM.

=item B<error-signals>

These signals usually indicate a serious problem with the Perl
interpreter or with your script.  They are ABRT, BUS, EMT, FPE, ILL,
QUIT, SEGV, SYS and TRAP.

=item B<old-interface-signals>

These are the signals which were trapped by default by the old
B<sigtrap> interface, they are ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT,
SEGV, SYS, TERM, and TRAP.  If no signals or signals lists are passed to
B<sigtrap>, this list is used.

=back

For each of these three lists, the collection of signals set to be
trapped is checked before trapping; if your architecture does not
implement a particular signal, it will not be trapped but rather
silently ignored.

=head2 OTHER

=over 4

=item B<untrapped>

This token tells B<sigtrap> to install handlers only for subsequently
listed signals which aren't already trapped or ignored.

=item B<any>

This token tells B<sigtrap> to install handlers for all subsequently
listed signals.  This is the default behavior.

=item I<signal>

Any argument which looks like a signal name (that is,
C</^[A-Z][A-Z0-9]*$/>) indicates that B<sigtrap> should install a
handler for that name.

=item I<number>

Require that at least version I<number> of B<sigtrap> is being used.

=back

=head1 EXAMPLES

Provide a stack trace for the old-interface-signals:

    use sigtrap;

Ditto:

    use sigtrap qw(stack-trace old-interface-signals);

Provide a stack trace on the 4 listed signals only:

    use sigtrap qw(BUS SEGV PIPE ABRT);

Die on INT or QUIT:

    use sigtrap qw(die INT QUIT);

Die on HUP, INT, PIPE or TERM:

    use sigtrap qw(die normal-signals);

Die on HUP, INT, PIPE or TERM, except don't change the behavior for
signals which are already trapped or ignored:

    use sigtrap qw(die untrapped normal-signals);

Die on receipt one of an of the B<normal-signals> which is currently
B<untrapped>, provide a stack trace on receipt of B<any> of the
B<error-signals>:

    use sigtrap qw(die untrapped normal-signals
		    stack-trace any error-signals);

Install my_handler() as the handler for the B<normal-signals>:

    use sigtrap 'handler', \&my_handler, 'normal-signals';

Install my_handler() as the handler for the normal-signals, provide a
Perl stack trace on receipt of one of the error-signals:

    use sigtrap qw(handler my_handler normal-signals
    	    	    stack-trace error-signals);

=cut
des (as defined by C<=headX>
and C<=item>) of the current POD. The nodes are returned in the ord                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Socket;

our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = "1.72";

=head1 NAME

Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load the C socket.h defines and structure manipulators 

=head1 SYNOPSIS

    use Socket;

    $proto = getprotobyname('udp');
    socket(Socket_Handle, PF_INET, SOCK_DGRAM, $proto);
    $iaddr = gethostbyname('hishost.com');
    $port = getservbyname('time', 'udp');
    $sin = sockaddr_in($port, $iaddr);
    send(Socket_Handle, 0, 0, $sin);

    $proto = getprotobyname('tcp');
    socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
    $port = getservbyname('smtp', 'tcp');
    $sin = sockaddr_in($port,inet_aton("127.1"));
    $sin = sockaddr_in(7,inet_aton("localhost"));
    $sin = sockaddr_in(7,INADDR_LOOPBACK);
    connect(Socket_Handle,$sin);

    ($port, $iaddr) = sockaddr_in(getpeername(Socket_Handle));
    $peer_host = gethostbyaddr($iaddr, AF_INET);
    $peer_addr = inet_ntoa($iaddr);

    $proto = getprotobyname('tcp');
    socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto);
    unlink('/tmp/usock');
    $sun = sockaddr_un('/tmp/usock');
    connect(Socket_Handle,$sun);

=head1 DESCRIPTION

This module is just a translation of the C F<socket.h> file.
Unlike the old mechanism of requiring a translated F<socket.ph>
file, this uses the B<h2xs> program (see the Perl source distribution)
and your native C compiler.  This means that it has a 
far more likely chance of getting the numbers right.  This includes
all of the commonly used pound-defines like AF_INET, SOCK_STREAM, etc.

Also, some common socket "newline" constants are provided: the
constants C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and
C<$CRLF>, which map to C<\015>, C<\012>, and C<\015\012>.  If you do
not want to use the literal characters in your programs, then use
the constants provided here.  They are not exported by default, but can
be imported individually, and with the C<:crlf> export tag:

    use Socket qw(:DEFAULT :crlf);

In addition, some structure manipulation functions are available:

=over

=item inet_aton HOSTNAME

Takes a string giving the name of a host, and translates that
to the 4-byte string (structure). Takes arguments of both
the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name
cannot be resolved, returns undef. For multi-homed hosts (hosts
with more than one address), the first address found is returned.

=item inet_ntoa IP_ADDRESS

Takes a four byte ip address (as returned by inet_aton())
and translates it into a string of the form 'd.d.d.d'
where the 'd's are numbers less than 256 (the normal
readable four dotted number notation for internet addresses).

=item INADDR_ANY

Note: does not return a number, but a packed string.

Returns the 4-byte wildcard ip address which specifies any
of the hosts ip addresses. (A particular machine can have
more than one ip address, each address corresponding to
a particular network interface. This wildcard address
allows you to bind to all of them simultaneously.)
Normally equivalent to inet_aton('0.0.0.0').

=item INADDR_BROADCAST

Note: does not return a number, but a packed string.

Returns the 4-byte 'this-lan' ip broadcast address.
This can be useful for some protocols to solicit information
from all servers on the same LAN cable.
Normally equivalent to inet_aton('255.255.255.255').

=item INADDR_LOOPBACK

Note - does not return a number.

Returns the 4-byte loopback address. Normally equivalent
to inet_aton('localhost').

=item INADDR_NONE

Note - does not return a number.

Returns the 4-byte 'invalid' ip address. Normally equivalent
to inet_aton('255.255.255.255').

=item sockaddr_in PORT, ADDRESS

=item sockaddr_in SOCKADDR_IN

In a list context, unpacks its SOCKADDR_IN argument and returns an array
consisting of (PORT, ADDRESS).  In a scalar context, packs its (PORT,
ADDRESS) arguments as a SOCKADDR_IN and returns it.  If this is confusing,
use pack_sockaddr_in() and unpack_sockaddr_in() explicitly.

=item pack_sockaddr_in PORT, IP_ADDRESS

Takes two arguments, a port number and a 4 byte IP_ADDRESS (as returned by
inet_aton()). Returns the sockaddr_in structure with those arguments
packed in with AF_INET filled in.  For internet domain sockets, this
structure is normally what you need for the arguments in bind(),
connect(), and send(), and is also returned by getpeername(),
getsockname() and recv().

=item unpack_sockaddr_in SOCKADDR_IN

Takes a sockaddr_in structure (as returned by pack_sockaddr_in()) and
returns an array of two elements: the port and the 4-byte ip-address.
Will croak if the structure does not have AF_INET in the right place.

=item sockaddr_un PATHNAME

=item sockaddr_un SOCKADDR_UN

In a list context, unpacks its SOCKADDR_UN argument and returns an array
consisting of (PATHNAME).  In a scalar context, packs its PATHNAME
arguments as a SOCKADDR_UN and returns it.  If this is confusing, use
pack_sockaddr_un() and unpack_sockaddr_un() explicitly.
These are only supported if your system has E<lt>F<sys/un.h>E<gt>.

=item pack_sockaddr_un PATH

Takes one argument, a pathname. Returns the sockaddr_un structure with
that path packed in with AF_UNIX filled in. For unix domain sockets, this
structure is normally what you need for the arguments in bind(),
connect(), and send(), and is also returned by getpeername(),
getsockname() and recv().

=item unpack_sockaddr_un SOCKADDR_UN

Takes a sockaddr_un structure (as returned by pack_sockaddr_un())
and returns the pathname.  Will croak if the structure does not
have AF_UNIX in the right place.

=back

=cut

use Carp;
use warnings::register;

require Exporter;
use XSLoader ();
@ISA = qw(Exporter);
@EXPORT = qw(
	inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in
	pack_sockaddr_un unpack_sockaddr_un
	sockaddr_in sockaddr_un
	INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
	AF_802
	AF_APPLETALK
	AF_CCITT
	AF_CHAOS
	AF_DATAKIT
	AF_DECnet
	AF_DLI
	AF_ECMA
	AF_GOSIP
	AF_HYLINK
	AF_IMPLINK
	AF_INET
	AF_LAT
	AF_MAX
	AF_NBS
	AF_NIT
	AF_NS
	AF_OSI
	AF_OSINET
	AF_PUP
	AF_SNA
	AF_UNIX
	AF_UNSPEC
	AF_X25
	IOV_MAX
	MSG_BCAST
	MSG_CTLFLAGS
	MSG_CTLIGNORE
	MSG_CTRUNC
	MSG_DONTROUTE
	MSG_DONTWAIT
	MSG_EOF
	MSG_EOR
	MSG_ERRQUEUE
	MSG_FIN
	MSG_MAXIOVLEN
	MSG_MCAST
	MSG_NOSIGNAL
	MSG_OOB
	MSG_PEEK
	MSG_PROXY
	MSG_RST
	MSG_SYN
	MSG_TRUNC
	MSG_URG
	MSG_WAITALL
	PF_802
	PF_APPLETALK
	PF_CCITT
	PF_CHAOS
	PF_DATAKIT
	PF_DECnet
	PF_DLI
	PF_ECMA
	PF_GOSIP
	PF_HYLINK
	PF_IMPLINK
	PF_INET
	PF_LAT
	PF_MAX
	PF_NBS
	PF_NIT
	PF_NS
	PF_OSI
	PF_OSINET
	PF_PUP
	PF_SNA
	PF_UNIX
	PF_UNSPEC
	PF_X25
	SCM_CONNECT
	SCM_CREDENTIALS
	SCM_CREDS
	SCM_RIGHTS
	SCM_TIMESTAMP
	SHUT_RD
	SHUT_RDWR
	SHUT_WR
	SOCK_DGRAM
	SOCK_RAW
	SOCK_RDM
	SOCK_SEQPACKET
	SOCK_STREAM
	SOL_SOCKET
	SOMAXCONN
	SO_ACCEPTCONN
	SO_BROADCAST
	SO_DEBUG
	SO_DONTLINGER
	SO_DONTROUTE
	SO_ERROR
	SO_KEEPALIVE
	SO_LINGER
	SO_OOBINLINE
	SO_RCVBUF
	SO_RCVLOWAT
	SO_RCVTIMEO
	SO_REUSEADDR
	SO_REUSEPORT
	SO_SNDBUF
	SO_SNDLOWAT
	SO_SNDTIMEO
	SO_TYPE
	SO_USELOOPBACK
	UIO_MAXIOV
);

@EXPORT_OK = qw(CR LF CRLF $CR $LF $CRLF

	       IPPROTO_TCP
	       TCP_KEEPALIVE
	       TCP_MAXRT
	       TCP_MAXSEG
	       TCP_NODELAY
	       TCP_STDURG);

%EXPORT_TAGS = (
    crlf    => [qw(CR LF CRLF $CR $LF $CRLF)],
    all     => [@EXPORT, @EXPORT_OK],
);

BEGIN {
    sub CR   () {"\015"}
    sub LF   () {"\012"}
    sub CRLF () {"\015\012"}
}

*CR   = \CR();
*LF   = \LF();
*CRLF = \CRLF();

sub sockaddr_in {
    if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
	my($af, $port, @quad) = @_;
	warnings::warn "6-ARG sockaddr_in call is deprecated" 
	    if warnings::enabled();
	pack_sockaddr_in($port, inet_aton(join('.', @quad)));
    } elsif (wantarray) {
	croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
        unpack_sockaddr_in(@_);
    } else {
	croak "usage:   sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
        pack_sockaddr_in(@_);
    }
}

sub sockaddr_un {
    if (wantarray) {
	croak "usage:   (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
        unpack_sockaddr_un(@_);
    } else {
	croak "usage:   sun_sv = sockaddr_un(filename)" unless @_ == 1;
        pack_sockaddr_un(@_);
    }
}

sub INADDR_ANY 		();
sub INADDR_BROADCAST	();
sub INADDR_LOOPBACK	();
sub INADDR_LOOPBACK	();

sub AF_802		();
sub AF_APPLETALK	();
sub AF_CCITT		();
sub AF_CHAOS		();
sub AF_DATAKIT		();
sub AF_DECnet		();
sub AF_DLI		();
sub AF_ECMA		();
sub AF_GOSIP		();
sub AF_HYLINK		();
sub AF_IMPLINK		();
sub AF_INET		();
sub AF_LAT		();
sub AF_MAX		();
sub AF_NBS		();
sub AF_NIT		();
sub AF_NS		();
sub AF_OSI		();
sub AF_OSINET		();
sub AF_PUP		();
sub AF_SNA		();
sub AF_UNIX		();
sub AF_UNSPEC		();
sub AF_X25		();
sub IOV_MAX		();
sub MSG_BCAST		();
sub MSG_CTLFLAGS	();
sub MSG_CTLIGNORE	();
sub MSG_CTRUNC		();
sub MSG_DONTROUTE	();
sub MSG_DONTWAIT	();
sub MSG_EOF		();
sub MSG_EOR		();
sub MSG_ERRQUEUE	();
sub MSG_FIN		();
sub MSG_MAXIOVLEN	();
sub MSG_MCAST		();
sub MSG_NOSIGNAL	();
sub MSG_OOB		();
sub MSG_PEEK		();
sub MSG_PROXY		();
sub MSG_RST		();
sub MSG_SYN		();
sub MSG_TRUNC		();
sub MSG_URG		();
sub MSG_WAITALL		();
sub PF_802		();
sub PF_APPLETALK	();
sub PF_CCITT		();
sub PF_CHAOS		();
sub PF_DATAKIT		();
sub PF_DECnet		();
sub PF_DLI		();
sub PF_ECMA		();
sub PF_GOSIP		();
sub PF_HYLINK		();
sub PF_IMPLINK		();
sub PF_INET		();
sub PF_LAT		();
sub PF_MAX		();
sub PF_NBS		();
sub PF_NIT		();
sub PF_NS		();
sub PF_OSI		();
sub PF_OSINET		();
sub PF_PUP		();
sub PF_SNA		();
sub PF_UNIX		();
sub PF_UNSPEC		();
sub PF_X25		();
sub SCM_CONNECT		();
sub SCM_CREDENTIALS	();
sub SCM_CREDS		();
sub SCM_RIGHTS		();
sub SCM_TIMESTAMP	();
sub SHUT_RD		();
sub SHUT_RDWR		();
sub SHUT_WR		();
sub SOCK_DGRAM		();
sub SOCK_RAW		();
sub SOCK_RDM		();
sub SOCK_SEQPACKET	();
sub SOCK_STREAM		();
sub SOL_SOCKET		();
sub SOMAXCONN		();
sub SO_ACCEPTCONN	();
sub SO_BROADCAST	();
sub SO_DEBUG		();
sub SO_DONTLINGER	();
sub SO_DONTROUTE	();
sub SO_ERROR		();
sub SO_KEEPALIVE	();
sub SO_LINGER		();
sub SO_OOBINLINE	();
sub SO_RCVBUF		();
sub SO_RCVLOWAT		();
sub SO_RCVTIMEO		();
sub SO_REUSEADDR	();
sub SO_SNDBUF		();
sub SO_SNDLOWAT		();
sub SO_SNDTIMEO		();
sub SO_TYPE		();
sub SO_USELOOPBACK	();
sub UIO_MAXIOV		();

sub AUTOLOAD {
    my($constname);
    ($constname = $AUTOLOAD) =~ s/.*:://;
    local $! = 0;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	my ($pack,$file,$line) = caller;
	croak "Your vendor has not defined Socket macro $constname, used";
    }
    eval "sub $AUTOLOAD () { $val }";
    goto &$AUTOLOAD;
}

XSLoader::load 'Socket', $VERSION;

1;
lf->node($arg);
            unless(length($arg)) {
                $self->poderror({ -line => $line, -file => $file,
                     -severity => 'ERROR', 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;# $RCSfile: stat.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:13 $

;# Usage:
;#	require 'stat.pl';
;#	@ary = stat(foo);
;#	$st_dev = @ary[$ST_DEV];
;#
$ST_DEV =	0 + $[;
$ST_INO =	1 + $[;
$ST_MODE =	2 + $[;
$ST_NLINK =	3 + $[;
$ST_UID =	4 + $[;
$ST_GID =	5 + $[;
$ST_RDEV =	6 + $[;
$ST_SIZE =	7 + $[;
$ST_ATIME =	8 + $[;
$ST_MTIME =	9 + $[;
$ST_CTIME =	10 + $[;
$ST_BLKSIZE =	11 + $[;
$ST_BLOCKS =	12 + $[;

;# Usage:
;#	require 'stat.pl';
;#	do Stat('foo');		# sets st_* as a side effect
;#
sub Stat {
    ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
	$st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(shift(@_));
}

1;
>interpolate_and_check($paragraph, $line,$file);
                unless($arg && $arg =~ /(\S+)/) {
                    $self->poderror({ -line => $line, -file => $file,
                         -severity => 'ERROR', 
                         -msg => "No argument for =begin"});
                }
                # remember the =begin
                $self->{_have_be                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ;# $Id: Storable.pm,v 1.0.1.13 2001/12/01 13:34:49 ram Exp $
;#
;#  Copyright (c) 1995-2000, Raphael Manfredi
;#  
;#  You may redistribute only under the same terms as Perl 5, as specified
;#  in the README file that comes with the distribution.
;#
;# $Log: Storable.pm,v $
;# Revision 1.0.1.13  2001/12/01 13:34:49  ram
;# patch14: avoid requiring Fcntl upfront, useful to embedded runtimes
;# patch14: store_fd() will now correctly autoflush file if needed
;#
;# Revision 1.0.1.12  2001/08/28 21:51:51  ram
;# patch13: fixed truncation race with lock_retrieve() in lock_store()
;#
;# Revision 1.0.1.11  2001/07/01 11:22:14  ram
;# patch12: systematically use "=over 4" for POD linters
;# patch12: updated version number
;#
;# Revision 1.0.1.10  2001/03/15 00:20:25  ram
;# patch11: updated version number
;#
;# Revision 1.0.1.9  2001/02/17 12:37:32  ram
;# patch10: forgot to increase version number at previous patch
;#
;# Revision 1.0.1.8  2001/02/17 12:24:37  ram
;# patch8: fixed incorrect error message
;#
;# Revision 1.0.1.7  2001/01/03 09:39:02  ram
;# patch7: added CAN_FLOCK to determine whether we can flock() or not
;#
;# Revision 1.0.1.6  2000/11/05 17:20:25  ram
;# patch6: increased version number
;#
;# Revision 1.0.1.5  2000/10/26 17:10:18  ram
;# patch5: documented that store() and retrieve() can return undef
;# patch5: added paragraph explaining the auto require for thaw hooks
;#
;# Revision 1.0.1.4  2000/10/23 18:02:57  ram
;# patch4: protected calls to flock() for dos platform
;# patch4: added logcarp emulation if they don't have Log::Agent
;#
;# Revision 1.0.1.3  2000/09/29 19:49:01  ram
;# patch3: updated version number
;#
;# Revision 1.0.1.2  2000/09/28 21:42:51  ram
;# patch2: added lock_store lock_nstore lock_retrieve
;#
;# Revision 1.0.1.1  2000/09/17 16:46:21  ram
;# patch1: documented that doubles are stringified by nstore()
;# patch1: added Salvador Ortiz Garcia in CREDITS section
;#
;# Revision 1.0  2000/09/01 19:40:41  ram
;# Baseline for first official release.
;#

require DynaLoader;
require Exporter;
package Storable; @ISA = qw(Exporter DynaLoader);

@EXPORT = qw(store retrieve);
@EXPORT_OK = qw(
	nstore store_fd nstore_fd fd_retrieve
	freeze nfreeze thaw
	dclone
	retrieve_fd
	lock_store lock_nstore lock_retrieve
);

use AutoLoader;
use vars qw($forgive_me $VERSION);

$VERSION = '1.014';
*AUTOLOAD = \&AutoLoader::AUTOLOAD;		# Grrr...

#
# Use of Log::Agent is optional
#

eval "use Log::Agent";

unless (defined @Log::Agent::EXPORT) {
	eval q{
		sub logcroak {
			require Carp;
			Carp::croak(@_);
		}
		sub logcarp {
			require Carp;
			Carp::carp(@_);
		}
	};
}

#
# They might miss :flock in Fcntl
#

BEGIN {
	if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
		Fcntl->import(':flock');
	} else {
		eval q{
			sub LOCK_SH ()	{1}
			sub LOCK_EX ()	{2}
		};
	}
}

sub logcroak;
sub logcarp;

sub retrieve_fd { &fd_retrieve }		# Backward compatibility

#
# Determine whether locking is possible, but only when needed.
#

my $CAN_FLOCK;

sub CAN_FLOCK {
	return $CAN_FLOCK if defined $CAN_FLOCK;
	require Config; import Config;
	return $CAN_FLOCK =
		$Config{'d_flock'} ||
		$Config{'d_fcntl_can_lock'} ||
		$Config{'d_lockf'};
}

bootstrap Storable;
1;
__END__

#
# store
#
# Store target object hierarchy, identified by a reference to its root.
# The stored object tree may later be retrieved to memory via retrieve.
# Returns undef if an I/O error occurred, in which case the file is
# removed.
#
sub store {
	return _store(\&pstore, @_, 0);
}

#
# nstore
#
# Same as store, but in network order.
#
sub nstore {
	return _store(\&net_pstore, @_, 0);
}

#
# lock_store
#
# Same as store, but flock the file first (advisory locking).
#
sub lock_store {
	return _store(\&pstore, @_, 1);
}

#
# lock_nstore
#
# Same as nstore, but flock the file first (advisory locking).
#
sub lock_nstore {
	return _store(\&net_pstore, @_, 1);
}

# Internal store to file routine
sub _store {
	my $xsptr = shift;
	my $self = shift;
	my ($file, $use_locking) = @_;
	logcroak "not a reference" unless ref($self);
	logcroak "wrong argument number" unless @_ == 2;	# No @foo in arglist
	local *FILE;
	if ($use_locking) {
		open(FILE, ">>$file") || logcroak "can't write into $file: $!";
		unless (&CAN_FLOCK) {
			logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
			return undef;
		}
		flock(FILE, LOCK_EX) ||
			logcroak "can't get exclusive lock on $file: $!";
		truncate FILE, 0;
		# Unlocking will happen when FILE is closed
	} else {
		open(FILE, ">$file") || logcroak "can't create $file: $!";
	}
	binmode FILE;				# Archaic systems...
	my $da = $@;				# Don't mess if called from exception handler
	my $ret;
	# Call C routine nstore or pstore, depending on network order
	eval { $ret = &$xsptr(*FILE, $self) };
	close(FILE) or $ret = undef;
	unlink($file) or warn "Can't unlink $file: $!\n" if $@ || !defined $ret;
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	$@ = $da;
	return $ret ? $ret : undef;
}

#
# store_fd
#
# Same as store, but perform on an already opened file descriptor instead.
# Returns undef if an I/O error occurred.
#
sub store_fd {
	return _store_fd(\&pstore, @_);
}

#
# nstore_fd
#
# Same as store_fd, but in network order.
#
sub nstore_fd {
	my ($self, $file) = @_;
	return _store_fd(\&net_pstore, @_);
}

# Internal store routine on opened file descriptor
sub _store_fd {
	my $xsptr = shift;
	my $self = shift;
	my ($file) = @_;
	logcroak "not a reference" unless ref($self);
	logcroak "too many arguments" unless @_ == 1;	# No @foo in arglist
	my $fd = fileno($file);
	logcroak "not a valid file descriptor" unless defined $fd;
	my $da = $@;				# Don't mess if called from exception handler
	my $ret;
	# Call C routine nstore or pstore, depending on network order
	eval { $ret = &$xsptr($file, $self) };
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	local $\; print $file '';	# Autoflush the file if wanted
	$@ = $da;
	return $ret ? $ret : undef;
}

#
# freeze
#
# Store oject and its hierarchy in memory and return a scalar
# containing the result.
#
sub freeze {
	_freeze(\&mstore, @_);
}

#
# nfreeze
#
# Same as freeze but in network order.
#
sub nfreeze {
	_freeze(\&net_mstore, @_);
}

# Internal freeze routine
sub _freeze {
	my $xsptr = shift;
	my $self = shift;
	logcroak "not a reference" unless ref($self);
	logcroak "too many arguments" unless @_ == 0;	# No @foo in arglist
	my $da = $@;				# Don't mess if called from exception handler
	my $ret;
	# Call C routine mstore or net_mstore, depending on network order
	eval { $ret = &$xsptr($self) };
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	$@ = $da;
	return $ret ? $ret : undef;
}

#
# retrieve
#
# Retrieve object hierarchy from disk, returning a reference to the root
# object of that tree.
#
sub retrieve {
	_retrieve($_[0], 0);
}

#
# lock_retrieve
#
# Same as retrieve, but with advisory locking.
#
sub lock_retrieve {
	_retrieve($_[0], 1);
}

# Internal retrieve routine
sub _retrieve {
	my ($file, $use_locking) = @_;
	local *FILE;
	open(FILE, $file) || logcroak "can't open $file: $!";
	binmode FILE;							# Archaic systems...
	my $self;
	my $da = $@;							# Could be from exception handler
	if ($use_locking) {
		unless (&CAN_FLOCK) {
			logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
			return undef;
		}
		flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
		# Unlocking will happen when FILE is closed
	}
	eval { $self = pretrieve(*FILE) };		# Call C routine
	close(FILE);
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	$@ = $da;
	return $self;
}

#
# fd_retrieve
#
# Same as retrieve, but perform from an already opened file descriptor instead.
#
sub fd_retrieve {
	my ($file) = @_;
	my $fd = fileno($file);
	logcroak "not a valid file descriptor" unless defined $fd;
	my $self;
	my $da = $@;							# Could be from exception handler
	eval { $self = pretrieve($file) };		# Call C routine
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	$@ = $da;
	return $self;
}

#
# thaw
#
# Recreate objects in memory from an existing frozen image created
# by freeze.  If the frozen image passed is undef, return undef.
#
sub thaw {
	my ($frozen) = @_;
	return undef unless defined $frozen;
	my $self;
	my $da = $@;							# Could be from exception handler
	eval { $self = mretrieve($frozen) };	# Call C routine
	logcroak $@ if $@ =~ s/\.?\n$/,/;
	$@ = $da;
	return $self;
}

=head1 NAME

Storable - persistency for perl data structures

=head1 SYNOPSIS

 use Storable;
 store \%table, 'file';
 $hashref = retrieve('file');

 use Storable qw(nstore store_fd nstore_fd freeze thaw dclone);

 # Network order
 nstore \%table, 'file';
 $hashref = retrieve('file');	# There is NO nretrieve()

 # Storing to and retrieving from an already opened file
 store_fd \@array, \*STDOUT;
 nstore_fd \%table, \*STDOUT;
 $aryref = fd_retrieve(\*SOCKET);
 $hashref = fd_retrieve(\*SOCKET);

 # Serializing to memory
 $serialized = freeze \%table;
 %table_clone = %{ thaw($serialized) };

 # Deep (recursive) cloning
 $cloneref = dclone($ref);

 # Advisory locking
 use Storable qw(lock_store lock_nstore lock_retrieve)
 lock_store \%table, 'file';
 lock_nstore \%table, 'file';
 $hashref = lock_retrieve('file');

=head1 DESCRIPTION

The Storable package brings persistency to your perl data structures
containing SCALAR, ARRAY, HASH or REF objects, i.e. anything that can be
convenientely stored to disk and retrieved at a later time.

It can be used in the regular procedural way by calling C<store> with
a reference to the object to be stored, along with the file name where
the image should be written.
The routine returns C<undef> for I/O problems or other internal error,
a true value otherwise. Serious errors are propagated as a C<die> exception.

To retrieve data stored to disk, use C<retrieve> with a file name,
and the objects stored into that file are recreated into memory for you,
a I<reference> to the root object being returned. In case an I/O error
occurs while reading, C<undef> is returned instead. Other serious
errors are propagated via C<die>.

Since storage is performed recursively, you might want to stuff references
to objects that share a lot of common data into a single array or hash
table, and then store that object. That way, when you retrieve back the
whole thing, the objects will continue to share what they originally shared.

At the cost of a slight header overhead, you may store to an already
opened file descriptor using the C<store_fd> routine, and retrieve
from a file via C<fd_retrieve>. Those names aren't imported by default,
so you will have to do that explicitely if you need those routines.
The file descriptor you supply must be already opened, for read
if you're going to retrieve and for write if you wish to store.

	store_fd(\%table, *STDOUT) || die "can't store to stdout\n";
	$hashref = fd_retrieve(*STDIN);

You can also store data in network order to allow easy sharing across
multiple platforms, or when storing on a socket known to be remotely
connected. The routines to call have an initial C<n> prefix for I<network>,
as in C<nstore> and C<nstore_fd>. At retrieval time, your data will be
correctly restored so you don't have to know whether you're restoring
from native or network ordered data.  Double values are stored stringified
to ensure portability as well, at the slight risk of loosing some precision
in the last decimals.

When using C<fd_retrieve>, objects are retrieved in sequence, one
object (i.e. one recursive tree) per associated C<store_fd>.

If you're more from the object-oriented camp, you can inherit from
Storable and directly store your objects by invoking C<store> as
a method. The fact that the root of the to-be-stored tree is a
blessed reference (i.e. an object) is special-cased so that the
retrieve does not provide a reference to that object but rather the
blessed object reference itself. (Otherwise, you'd get a reference
to that blessed object).

=head1 MEMORY STORE

The Storable engine can also store data into a Perl scalar instead, to
later retrieve them. This is mainly used to freeze a complex structure in
some safe compact memory place (where it can possibly be sent to another
process via some IPC, since freezing the structure also serializes it in
effect). Later on, and maybe somewhere else, you can thaw the Perl scalar
out and recreate the original complex structure in memory.

Surprisingly, the routines to be called are named C<freeze> and C<thaw>.
If you wish to send out the frozen scalar to another machine, use
C<nfreeze> instead to get a portable image.

Note that freezing an object structure and immediately thawing it
actually achieves a deep cloning of that structure:

    dclone(.) = thaw(freeze(.))

Storable provides you with a C<dclone> interface which does not create
that intermediary scalar but instead freezes the structure in some
internal memory space and then immediatly thaws it out.

=head1 ADVISORY LOCKING

The C<lock_store> and C<lock_nstore> routine are equivalent to C<store>
and C<nstore>, only they get an exclusive lock on the file before
writing.  Likewise, C<lock_retrieve> performs as C<retrieve>, but also
gets a shared lock on the file before reading.

Like with any advisory locking scheme, the protection only works if
you systematically use C<lock_store> and C<lock_retrieve>.  If one
side of your application uses C<store> whilst the other uses C<lock_retrieve>,
you will get no protection at all.

The internal advisory locking is implemented using Perl's flock() routine.
If your system does not support any form of flock(), or if you share
your files across NFS, you might wish to use other forms of locking by
using modules like LockFile::Simple which lock a file using a filesystem
entry, instead of locking the file descriptor.

=head1 SPEED

The heart of Storable is written in C for decent speed. Extra low-level
optimization have been made when manipulating perl internals, to
sacrifice encapsulation for the benefit of a greater speed.

=head1 CANONICAL REPRESENTATION

Normally Storable stores elements of hashes in the order they are
stored internally by Perl, i.e. pseudo-randomly.  If you set
C<$Storable::canonical> to some C<TRUE> value, Storable will store
hashes with the elements sorted by their key.  This allows you to
compare data structures by comparing their frozen representations (or
even the compressed frozen representations), which can be useful for
creating lookup tables for complicated queries.

Canonical order does not imply network order, those are two orthogonal
settings.

=head1 ERROR REPORTING

Storable uses the "exception" paradigm, in that it does not try to workaround
failures: if something bad happens, an exception is generated from the
caller's perspective (see L<Carp> and C<croak()>).  Use eval {} to trap
those exceptions.

When Storable croaks, it tries to report the error via the C<logcroak()>
routine from the C<Log::Agent> package, if it is available.

Normal errors are reported by having store() or retrieve() return C<undef>.
Such errors are usually I/O errors (or truncated stream errors at retrieval).

=head1 WIZARDS ONLY

=head2 Hooks

Any class may define hooks that will be called during the serialization
and deserialization process on objects that are instances of that class.
Those hooks can redefine the way serialization is performed (and therefore,
how the symetrical deserialization should be conducted).

Since we said earlier:

    dclone(.) = thaw(freeze(.))

everything we say about hooks should also hold for deep cloning. However,
hooks get to know whether the operation is a mere serialization, or a cloning.

Therefore, when serializing hooks are involved,

    dclone(.) <> thaw(freeze(.))

Well, you could keep them in sync, but there's no guarantee it will always
hold on classes somebody else wrote.  Besides, there is little to gain in
doing so: a serializing hook could only keep one attribute of an object,
which is probably not what should happen during a deep cloning of that
same object.

Here is the hooking interface:

=over 4

=item C<STORABLE_freeze> I<obj>, I<cloning>

The serializing hook, called on the object during serialization.  It can be
inherited, or defined in the class itself, like any other method.

Arguments: I<obj> is the object to serialize, I<cloning> is a flag indicating
whether we're in a dclone() or a regular serialization via store() or freeze().

Returned value: A LIST C<($serialized, $ref1, $ref2, ...)> where $serialized
is the serialized form to be used, and the optional $ref1, $ref2, etc... are
extra references that you wish to let the Storable engine serialize.

At deserialization time, you will be given back the same LIST, but all the
extra references will be pointing into the deserialized structure.

The B<first time> the hook is hit in a serialization flow, you may have it
return an empty list.  That will signal the Storable engine to further
discard that hook for this class and to therefore revert to the default
serialization of the underlying Perl data.  The hook will again be normally
processed in the next serialization.

Unless you know better, serializing hook should always say:

    sub STORABLE_freeze {
        my ($self, $cloning) = @_;
        return if $cloning;         # Regular default serialization
        ....
    }

in order to keep reasonable dclone() semantics.

=item C<STORABLE_thaw> I<obj>, I<cloning>, I<serialized>, ...

The deserializing hook called on the object during deserialization.
But wait. If we're deserializing, there's no object yet... right?

Wrong: the Storable engine creates an empty one for you.  If you know Eiffel,
you can view C<STORABLE_thaw> as an alternate creation routine.

This means the hook can be inherited like any other method, and that
I<obj> is your blessed reference for this particular instance.

The other arguments should look familiar if you know C<STORABLE_freeze>:
I<cloning> is true when we're part of a deep clone operation, I<serialized>
is the serialized string you returned to the engine in C<STORABLE_freeze>,
and there may be an optional list of references, in the same order you gave
them at serialization time, pointing to the deserialized objects (which
have been processed courtesy of the Storable engine).

When the Storable engine does not find any C<STORABLE_thaw> hook routine,
it tries to load the class by requiring the package dynamically (using
the blessed package name), and then re-attempts the lookup.  If at that
time the hook cannot be located, the engine croaks.  Note that this mechanism
will fail if you define several classes in the same file, but perlmod(1)
warned you.

It is up to you to use these information to populate I<obj> the way you want.

Returned value: none.

=back

=head2 Predicates

Predicates are not exportable.  They must be called by explicitely prefixing
them with the Storable package name.

=over 4

=item C<Storable::last_op_in_netorder>

The C<Storable::last_op_in_netorder()> predicate will tell you whether
network order was used in the last store or retrieve operation.  If you
don't know how to use this, just forget about it.

=item C<Storable::is_storing>

Returns true if within a store operation (via STORABLE_freeze hook).

=item C<Storable::is_retrieving>

Returns true if within a retrieve operation, (via STORABLE_thaw hook).

=back

=head2 Recursion

With hooks comes the ability to recurse back to the Storable engine.  Indeed,
hooks are regular Perl code, and Storable is convenient when it comes to
serialize and deserialize things, so why not use it to handle the
serialization string?

There are a few things you need to know however:

=over 4

=item *

You can create endless loops if the things you serialize via freeze()
(for instance) point back to the object we're trying to serialize in the hook.

=item *

Shared references among objects will not stay shared: if we're serializing
the list of object [A, C] where both object A and C refer to the SAME object
B, and if there is a serializing hook in A that says freeze(B), then when
deserializing, we'll get [A', C'] where A' refers to B', but C' refers to D,
a deep clone of B'.  The topology was not preserved.

=back

That's why C<STORABLE_freeze> lets you provide a list of references
to serialize.  The engine guarantees that those will be serialized in the
same context as the other objects, and therefore that shared objects will
stay shared.

In the above [A, C] example, the C<STORABLE_freeze> hook could return:

	("something", $self->{B})

and the B part would be serialized by the engine.  In C<STORABLE_thaw>, you
would get back the reference to the B' object, deserialized for you.

Therefore, recursion should normally be avoided, but is nonetheless supported.

=head2 Deep Cloning

There is a new Clone module available on CPAN which implements deep cloning
natively, i.e. without freezing to memory and thawing the result.  It is
aimed to replace Storable's dclone() some day.  However, it does not currently
support Storable hooks to redefine the way deep cloning is performed.

=head1 EXAMPLES

Here are some code samples showing a possible usage of Storable:

	use Storable qw(store retrieve freeze thaw dclone);

	%color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);

	store(\%color, '/tmp/colors') or die "Can't store %a in /tmp/colors!\n";

	$colref = retrieve('/tmp/colors');
	die "Unable to retrieve from /tmp/colors!\n" unless defined $colref;
	printf "Blue is still %lf\n", $colref->{'Blue'};

	$colref2 = dclone(\%color);

	$str = freeze(\%color);
	printf "Serialization of %%color is %d bytes long.\n", length($str);
	$colref3 = thaw($str);

which prints (on my machine):

	Blue is still 0.100000
	Serialization of %color is 102 bytes long.

=head1 WARNING

If you're using references as keys within your hash tables, you're bound
to disapointment when retrieving your data. Indeed, Perl stringifies
references used as hash table keys. If you later wish to access the
items via another reference stringification (i.e. using the same
reference that was used for the key originally to record the value into
the hash table), it will work because both references stringify to the
same string.

It won't work across a C<store> and C<retrieve> operations however, because
the addresses in the retrieved objects, which are part of the stringified
references, will probably differ from the original addresses. The
topology of your structure is preserved, but not hidden semantics
like those.

On platforms where it matters, be sure to call C<binmode()> on the
descriptors that you pass to Storable functions.

Storing data canonically that contains large hashes can be
significantly slower than storing the same data normally, as
temprorary arrays to hold the keys for each hash have to be allocated,
populated, sorted and freed.  Some tests have shown a halving of the
speed of storing -- the exact penalty will depend on the complexity of
your data.  There is no slowdown on retrieval.

=head1 BUGS

You can't store GLOB, CODE, FORMLINE, etc... If you can define
semantics for those operations, feel free to enhance Storable so that
it can deal with them.

The store functions will C<croak> if they run into such references
unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that
case, the fatal message is turned in a warning and some
meaningless string is stored instead.

Setting C<$Storable::canonical> may not yield frozen strings that
compare equal due to possible stringification of numbers. When the
string version of a scalar exists, it is the form stored, therefore
if you happen to use your numbers as strings between two freezing
operations on the same data structures, you will get different
results.

When storing doubles in network order, their value is stored as text.
However, you should also not expect non-numeric floating-point values
such as infinity and "not a number" to pass successfully through a
nstore()/retrieve() pair.

As Storable neither knows nor cares about character sets (although it
does know that characters may be more than eight bits wide), any difference
in the interpretation of character codes between a host and a target
system is your problem.  In particular, if host and target use different
code points to represent the characters used in the text representation
of floating-point numbers, you will not be able be able to exchange
floating-point data, even with nstore().

=head1 CREDITS

Thank you to (in chronological order):

	Jarkko Hietaniemi <jhi@iki.fi>
	Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
	Benjamin A. Holzman <bah@ecnvantage.com>
	Andrew Ford <A.Ford@ford-mason.co.uk>
	Gisle Aas <gisle@aas.no>
	Jeff Gresham <gresham_jeffrey@jpmorgan.com>
	Murray Nesbitt <murray@activestate.com>
	Marc Lehmann <pcg@opengroup.org>
	Justin Banks <justinb@wamnet.com>
	Jarkko Hietaniemi <jhi@iki.fi> (AGAIN, as perl 5.7.0 Pumpkin!)
	Salvador Ortiz Garcia <sog@msg.com.mx>
	Dominic Dunlop <domo@computer.org>
	Erik Haugan <erik@solbors.no>

for their bug reports, suggestions and contributions.

Benjamin Holzman contributed the tied variable support, Andrew Ford
contributed the canonical order for hashes, and Gisle Aas fixed
a few misunderstandings of mine regarding the Perl internals,
and optimized the emission of "tags" in the output streams by
simply counting the objects instead of tagging them (leading to
a binary incompatibility for the Storable image starting at version
0.6--older images are of course still properly understood).
Murray Nesbitt made Storable thread-safe.  Marc Lehmann added overloading
and reference to tied items support.

=head1 TRANSLATIONS

There is a Japanese translation of this man page available at
http://member.nifty.ne.jp/hippo2000/perltips/storable.htm ,
courtesy of Kawai, Takanori <kawai@nippon-rad.co.jp>.

=head1 AUTHOR

Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>>

=head1 SEE ALSO

Clone(3).

=cut

";
	write;
    } 
}

format = 

^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $typedesc 
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $typedesc 
 ~~  ^<<<<<<                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package strict;

=head1 NAME

strict - Perl pragma to restrict unsafe constructs

=head1 SYNOPSIS

    use strict;

    use strict "vars";
    use strict "refs";
    use strict "subs";

    use strict;
    no strict "vars";

=head1 DESCRIPTION

If no import list is supplied, all possible restrictions are assumed.
(This is the safest mode to operate in, but is sometimes too strict for
casual programming.)  Currently, there are three possible things to be
strict about:  "subs", "vars", and "refs".

=over 6

=item C<strict refs>

This generates a runtime error if you 
use symbolic references (see L<perlref>).

    use strict 'refs';
    $ref = \$foo;
    print $$ref;	# ok
    $ref = "foo";
    print $$ref;	# runtime error; normally ok
    $file = "STDOUT";
    print $file "Hi!";	# error; note: no comma after $file

There is one exception to this rule:

    $bar = \&{'foo'};
    &$bar;

is allowed so that C<goto &$AUTOLOAD> would not break under stricture.


=item C<strict vars>

This generates a compile-time error if you access a variable that wasn't
declared via "our" or C<use vars>,
localized via C<my()>, or wasn't fully qualified.  Because this is to avoid
variable suicide problems and subtle dynamic scoping issues, a merely
local() variable isn't good enough.  See L<perlfunc/my> and
L<perlfunc/local>.

    use strict 'vars';
    $X::foo = 1;	 # ok, fully qualified
    my $foo = 10;	 # ok, my() var
    local $foo = 9;	 # blows up

    package Cinna;
    our $bar;			# Declares $bar in current package
    $bar = 'HgS';		# ok, global declared via pragma

The local() generated a compile-time error because you just touched a global
name without fully qualifying it.

Because of their special use by sort(), the variables $a and $b are
exempted from this check.

=item C<strict subs>

This disables the poetry optimization, generating a compile-time error if
you try to use a bareword identifier that's not a subroutine, unless it
appears in curly braces or on the left hand side of the "=E<gt>" symbol.


    use strict 'subs';
    $SIG{PIPE} = Plumber;   	# blows up
    $SIG{PIPE} = "Plumber"; 	# just fine: bareword in curlies always ok
    $SIG{PIPE} = \&Plumber; 	# preferred form



=back

See L<perlmodlib/Pragmatic Modules>.


=cut

$strict::VERSION = "1.01";

my %bitmask = (
refs => 0x00000002,
subs => 0x00000200,
vars => 0x00000400
);

sub bits {
    my $bits = 0;
    foreach my $s (@_){ $bits |= $bitmask{$s} || 0; };
    $bits;
}

sub import {
    shift;
    $^H |= bits(@_ ? @_ : qw(refs subs vars));
}

sub unimport {
    shift;
    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
}

1;
 hosts record 
getlogin	User	return who logged in at this tty
getnetbyaddr	Network	get network record given its address
getnetbyname	Network	get networks record given name
getnetent	Network	get next networks record 
getpeername	Socket	find the other end of a socket connection
getpgrp	Process	get process group
getppid	Process	get parent process ID
getpriority	Process	get current nice value
getprotobyname	Network	get protocol record given name
ge                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package subs;

=head1 NAME

subs - Perl pragma to predeclare sub names

=head1 SYNOPSIS

    use subs qw(frob);
    frob 3..10;

=head1 DESCRIPTION

This will predeclare all the subroutine whose names are 
in the list, allowing you to use them without parentheses
even before they're declared.

Unlike pragmas that affect the C<$^H> hints variable, the C<use vars> and
C<use subs> declarations are not BLOCK-scoped.  They are thus effective
for the entire file in which they appear.  You may not rescind such
declarations with C<no vars> or C<no subs>.

See L<perlmodlib/Pragmatic Modules> and L<strict/strict subs>.

=cut

require 5.000;

sub import {
    my $callpack = caller;
    my $pack = shift;
    my @imports = @_;
    foreach $sym (@imports) {
	*{"${callpack}::$sym"} = \&{"${callpack}::$sym"};
    }
};

1;
ace	patch a module's namespace into your own
index	String	find a substring within a string
int	Math	get the integer portion of a number
ioctl	File	system-dependent device control system call
join	LIST	join                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 package Switch;

use strict;
use vars qw($VERSION);
use Carp;

$VERSION = '2.06';


# LOAD FILTERING MODULE...
use Filter::Util::Call;

sub __();

# CATCH ATTEMPTS TO CALL case OUTSIDE THE SCOPE OF ANY switch

$::_S_W_I_T_C_H = sub { croak "case/when statement not in switch/given block" };

my $offset;
my $fallthrough;
my ($Perl5, $Perl6) = (0,0);

sub import
{
	$DB::single = 1;
	$fallthrough = grep /\bfallthrough\b/, @_;
	$offset = (caller)[2]+1;
	filter_add({}) unless @_>1 && $_[1] eq 'noimport';
	my $pkg = caller;
	no strict 'refs';
	for ( qw( on_defined on_exists ) )
	{
		*{"${pkg}::$_"} = \&$_;
	}
	*{"${pkg}::__"} = \&__ if grep /__/, @_;
	$Perl6 = 1 if grep(/Perl\s*6/i, @_);
	$Perl5 = 1 if grep(/Perl\s*5/i, @_) || !grep(/Perl\s*6/i, @_);
	1;
}

sub unimport
{	
	filter_del()
}

sub filter
{
	my($self) = @_ ;
	local $Switch::file = (caller)[1];

	my $status = 1;
	$status = filter_read(10_000);
	return $status if $status<0;
    	$_ = filter_blocks($_,$offset);
	$_ = "# line $offset\n" . $_ if $offset; undef $offset;
	# print STDERR $_;
	return $status;
}

use Text::Balanced ':ALL';

sub line
{
	my ($pretext,$offset) = @_;
	($pretext=~tr/\n/\n/)+($offset||0);
}

sub is_block
{
	local $SIG{__WARN__}=sub{die$@};
	local $^W=1;
	my $ishash = defined  eval 'my $hr='.$_[0];
	undef $@;
	return !$ishash;
}


my $EOP = qr/\n\n|\Z/;
my $CUT = qr/\n=cut.*$EOP/;
my $pod_or_DATA = qr/ ^=(?:head[1-4]|item) .*? $CUT
                    | ^=pod .*? $CUT
                    | ^=for .*? $EOP
                    | ^=begin \s* (\S+) .*? \n=end \s* \1 .*? $EOP
                    | ^__(DATA|END)__\n.*
                    /smx;

my $casecounter = 1;
sub filter_blocks
{
	my ($source, $line) = @_;
	return $source unless $Perl5 && $source =~ /case|switch/
			   || $Perl6 && $source =~ /when|given/;
	pos $source = 0;
	my $text = "";
	component: while (pos $source < length $source)
	{
		if ($source =~ m/(\G\s*use\s+Switch\b)/gc)
		{
			$text .= q{use Switch 'noimport'};
			next component;
		}
		my @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0);
		if (defined $pos[0])
		{
			$text .= " " . substr($source,$pos[2],$pos[18]-$pos[2]);
			next component;
		}
		if ($source =~ m/\G\s*($pod_or_DATA)/gc) {
			next component;
		}
		@pos = Text::Balanced::_match_variable(\$source,qr/\s*/);
		if (defined $pos[0])
		{
			$text .= " " . substr($source,$pos[0],$pos[4]-$pos[0]);
			next component;
		}

		if ($Perl5 && $source =~ m/\G(\n*)(\s*)(switch)\b(?=\s*[(])/gc
		 || $Perl6 && $source =~ m/\G(\n*)(\s*)(given)\b(?=\s*[(])/gc)
		{
			my $keyword = $3;
			$text .= $1.$2.'S_W_I_T_C_H: while (1) ';
			@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\(/,qr/\)/,qr/[[{(<]/,qr/[]})>]/,undef) 
			or do {
				die "Bad $keyword statement (problem in the parentheses?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
			};
			my $arg = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
			$arg =~ s {^\s*[(]\s*%}   { ( \\\%}	||
			$arg =~ s {^\s*[(]\s*m\b} { ( qr}	||
			$arg =~ s {^\s*[(]\s*/}   { ( qr/}	||
			$arg =~ s {^\s*[(]\s*qw}  { ( \\qw};
			@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)
			or do {
				die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0, pos $source), $line), "\n";
			};
			my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
			$code =~ s/{/{ local \$::_S_W_I_T_C_H; Switch::switch $arg;/;
			$text .= $code . 'continue {last}';
			next component;
		}
		elsif ($Perl5 && $source =~ m/\G(\s*)(case\b)(?!\s*=>)/gc
		    || $Perl6 && $source =~ m/\G(\s*)(when\b)(?!\s*=>)/gc)
		{
			my $keyword = $2;
			$text .= $1."if (Switch::case";
			if (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)) {
				my $code = substr($source,$pos[0],$pos[4]-$pos[0]);
				$text .= " sub" if is_block $code;
				$text .= " " . filter_blocks($code,line(substr($source,0,$pos[0]),$line)) . ")";
			}
			elsif (@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/[[(]/,qr/[])]/,qr/[[({]/,qr/[])}]/,undef)) {
				my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
				$code =~ s {^\s*[(]\s*%}   { ( \\\%}	||
				$code =~ s {^\s*[(]\s*m\b} { ( qr}	||
				$code =~ s {^\s*[(]\s*/}   { ( qr/}	||
				$code =~ s {^\s*[(]\s*qw}  { ( \\qw};
				$text .= " $code)";
			}
			elsif ($Perl6 && do{@pos = Text::Balanced::_match_variable(\$source,qr/\s*/)}) {
				my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
				$code =~ s {^\s*%}  { \%}	||
				$code =~ s {^\s*@}  { \@};
				$text .= " $code)";
			}
			elsif ( @pos = Text::Balanced::_match_quotelike(\$source,qr/\s*/,1,0)) {
				my $code = substr($source,$pos[2],$pos[18]-$pos[2]);
				$code = filter_blocks($code,line(substr($source,0,$pos[2]),$line));
				$code =~ s {^\s*m}  { qr}	||
				$code =~ s {^\s*/}  { qr/}	||
				$code =~ s {^\s*qw} { \\qw};
				$text .= " $code)";
			}
			elsif ($Perl5 && $source =~ m/\G\s*(([^\$\@{])[^\$\@{]*)(?=\s*{)/gc
			   ||  $Perl6 && $source =~ m/\G\s*([^:;]*)()/gc) {
				my $code = filter_blocks($1,line(substr($source,0,pos $source),$line));
				$text .= ' \\' if $2 eq '%';
				$text .= " $code)";
			}
			else {
				die "Bad $keyword statement (invalid $keyword value?) near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n";
			}

		        die "Missing colon or semi-colon after 'when' value near $Switch::file line ", line(substr($source,0,pos $source), $line), "\n"
				unless !$Perl6 || $source =~ m/\G(\s*)(:|(?=;))/gc;

			do{@pos = Text::Balanced::_match_codeblock(\$source,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef)}
			or do {
				if ($source =~ m/\G\s*(?=([};]|\Z))/gc) {
					$casecounter++;
					next component;
				}
				die "Bad $keyword statement (problem in the code block?) near $Switch::file line ", line(substr($source,0,pos $source),$line), "\n";
			};
			my $code = filter_blocks(substr($source,$pos[0],$pos[4]-$pos[0]),line(substr($source,0,$pos[0]),$line));
			$code =~ s/}(?=\s*\Z)/;last S_W_I_T_C_H }/
				unless $fallthrough;
			$text .= "{ while (1) $code continue { goto C_A_S_E_$casecounter } last S_W_I_T_C_H; C_A_S_E_$casecounter: }";
			$casecounter++;
			next component;
		}

		$source =~ m/\G(\s*(-[sm]\s+|\w+|#.*\n|\W))/gc;
		$text .= $1;
	}
	$text;
}



sub in
{
	my ($x,$y) = @_;
	my @numy;
	for my $nextx ( @$x )
	{
		my $numx = ref($nextx) || defined $nextx && (~$nextx&$nextx) eq 0;
		for my $j ( 0..$#$y )
		{
			my $nexty = $y->[$j];
			push @numy, ref($nexty) || defined $nexty && (~$nexty&$nexty) eq 0
				if @numy <= $j;
			return 1 if $numx && $numy[$j] && $nextx==$nexty
			         || $nextx eq $nexty;
			
		}
	}
	return "";
}

sub on_exists
{
	my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
	[ keys %$ref ]
}

sub on_defined
{
	my $ref = @_==1 && ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
	[ grep { defined $ref->{$_} } keys %$ref ]
}

sub switch(;$)
{
	my ($s_val) = @_ ? $_[0] : $_;
	my $s_ref = ref $s_val;
	
	if ($s_ref eq 'CODE')
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    return $s_val == $c_val  if ref $c_val eq 'CODE';
			    return $s_val->(@$c_val) if ref $c_val eq 'ARRAY';
			    return $s_val->($c_val);
			  };
	}
	elsif ($s_ref eq "" && defined $s_val && (~$s_val&$s_val) eq 0)	# NUMERIC SCALAR
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    my $c_ref = ref $c_val;
			    return $s_val == $c_val 	if $c_ref eq ""
							&& defined $c_val
							&& (~$c_val&$c_val) eq 0;
			    return $s_val eq $c_val 	if $c_ref eq "";
			    return in([$s_val],$c_val)	if $c_ref eq 'ARRAY';
			    return $c_val->($s_val)	if $c_ref eq 'CODE';
			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
			    return scalar $s_val=~/$c_val/
							if $c_ref eq 'Regexp';
			    return scalar $c_val->{$s_val}
							if $c_ref eq 'HASH';
		            return;	
			  };
	}
	elsif ($s_ref eq "")				# STRING SCALAR
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    my $c_ref = ref $c_val;
			    return $s_val eq $c_val 	if $c_ref eq "";
			    return in([$s_val],$c_val)	if $c_ref eq 'ARRAY';
			    return $c_val->($s_val)	if $c_ref eq 'CODE';
			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
			    return scalar $s_val=~/$c_val/
							if $c_ref eq 'Regexp';
			    return scalar $c_val->{$s_val}
							if $c_ref eq 'HASH';
		            return;	
			  };
	}
	elsif ($s_ref eq 'ARRAY')
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    my $c_ref = ref $c_val;
			    return in($s_val,[$c_val]) 	if $c_ref eq "";
			    return in($s_val,$c_val)	if $c_ref eq 'ARRAY';
			    return $c_val->(@$s_val)	if $c_ref eq 'CODE';
			    return $c_val->call(@$s_val)
							if $c_ref eq 'Switch';
			    return scalar grep {$_=~/$c_val/} @$s_val
							if $c_ref eq 'Regexp';
			    return scalar grep {$c_val->{$_}} @$s_val
							if $c_ref eq 'HASH';
		            return;	
			  };
	}
	elsif ($s_ref eq 'Regexp')
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    my $c_ref = ref $c_val;
			    return $c_val=~/s_val/ 	if $c_ref eq "";
			    return scalar grep {$_=~/s_val/} @$c_val
							if $c_ref eq 'ARRAY';
			    return $c_val->($s_val)	if $c_ref eq 'CODE';
			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
			    return $s_val eq $c_val	if $c_ref eq 'Regexp';
			    return grep {$_=~/$s_val/ && $c_val->{$_}} keys %$c_val
							if $c_ref eq 'HASH';
		            return;	
			  };
	}
	elsif ($s_ref eq 'HASH')
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    my $c_ref = ref $c_val;
			    return $s_val->{$c_val} 	if $c_ref eq "";
			    return scalar grep {$s_val->{$_}} @$c_val
							if $c_ref eq 'ARRAY';
			    return $c_val->($s_val)	if $c_ref eq 'CODE';
			    return $c_val->call($s_val)	if $c_ref eq 'Switch';
			    return grep {$_=~/$c_val/ && $s_val->{"$_"}} keys %$s_val
							if $c_ref eq 'Regexp';
			    return $s_val==$c_val	if $c_ref eq 'HASH';
		            return;	
			  };
	}
	elsif ($s_ref eq 'Switch')
	{
		$::_S_W_I_T_C_H =
		      sub { my $c_val = $_[0];
			    return $s_val == $c_val  if ref $c_val eq 'Switch';
			    return $s_val->call(@$c_val)
						     if ref $c_val eq 'ARRAY';
			    return $s_val->call($c_val);
			  };
	}
	else
	{
		croak "Cannot switch on $s_ref";
	}
	return 1;
}

sub case($) { local $SIG{__WARN__} = \&carp;
	      $::_S_W_I_T_C_H->(@_); }

# IMPLEMENT __

my $placeholder = bless { arity=>1, impl=>sub{$_[1+$_[0]]} };

sub __() { $placeholder }

sub __arg($)
{
	my $index = $_[0]+1;
	bless { arity=>0, impl=>sub{$_[$index]} };
}

sub hosub(&@)
{
	# WRITE THIS
}

sub call
{
	my ($self,@args) = @_;
	return $self->{impl}->(0,@args);
}

sub meta_bop(&)
{
	my ($op) = @_;
	sub
	{
		my ($left, $right, $reversed) = @_;
		($right,$left) = @_ if $reversed;

		my $rop = ref $right eq 'Switch'
			? $right
			: bless { arity=>0, impl=>sub{$right} };

		my $lop = ref $left eq 'Switch'
			? $left
			: bless { arity=>0, impl=>sub{$left} };

		my $arity = $lop->{arity} + $rop->{arity};

		return bless {
				arity => $arity,
				impl  => sub { my $start = shift;
					       return $op->($lop->{impl}->($start,@_),
						            $rop->{impl}->($start+$lop->{arity},@_));
					     }
			     };
	};
}

sub meta_uop(&)
{
	my ($op) = @_;
	sub
	{
		my ($left) = @_;

		my $lop = ref $left eq 'Switch'
			? $left
			: bless { arity=>0, impl=>sub{$left} };

		my $arity = $lop->{arity};

		return bless {
				arity => $arity,
				impl  => sub { $op->($lop->{impl}->(@_)) }
			     };
	};
}


use overload
	"+"	=> 	meta_bop {$_[0] + $_[1]},
	"-"	=> 	meta_bop {$_[0] - $_[1]},  
	"*"	=>  	meta_bop {$_[0] * $_[1]},
	"/"	=>  	meta_bop {$_[0] / $_[1]},
	"%"	=>  	meta_bop {$_[0] % $_[1]},
	"**"	=>  	meta_bop {$_[0] ** $_[1]},
	"<<"	=>  	meta_bop {$_[0] << $_[1]},
	">>"	=>  	meta_bop {$_[0] >> $_[1]},
	"x"	=>  	meta_bop {$_[0] x $_[1]},
	"."	=>  	meta_bop {$_[0] . $_[1]},
	"<"	=>  	meta_bop {$_[0] < $_[1]},
	"<="	=>  	meta_bop {$_[0] <= $_[1]},
	">"	=>  	meta_bop {$_[0] > $_[1]},
	">="	=>  	meta_bop {$_[0] >= $_[1]},
	"=="	=>  	meta_bop {$_[0] == $_[1]},
	"!="	=>  	meta_bop {$_[0] != $_[1]},
	"<=>"	=>  	meta_bop {$_[0] <=> $_[1]},
	"lt"	=>  	meta_bop {$_[0] lt $_[1]},
	"le"	=> 	meta_bop {$_[0] le $_[1]},
	"gt"	=> 	meta_bop {$_[0] gt $_[1]},
	"ge"	=> 	meta_bop {$_[0] ge $_[1]},
	"eq"	=> 	meta_bop {$_[0] eq $_[1]},
	"ne"	=> 	meta_bop {$_[0] ne $_[1]},
	"cmp"	=> 	meta_bop {$_[0] cmp $_[1]},
	"\&"	=> 	meta_bop {$_[0] & $_[1]},
	"^"	=> 	meta_bop {$_[0] ^ $_[1]},
	"|"	=>	meta_bop {$_[0] | $_[1]},
	"atan2"	=>	meta_bop {atan2 $_[0], $_[1]},

	"neg"	=>	meta_uop {-$_[0]},
	"!"	=>	meta_uop {!$_[0]},
	"~"	=>	meta_uop {~$_[0]},
	"cos"	=>	meta_uop {cos $_[0]},
	"sin"	=>	meta_uop {sin $_[0]},
	"exp"	=>	meta_uop {exp $_[0]},
	"abs"	=>	meta_uop {abs $_[0]},
	"log"	=>	meta_uop {log $_[0]},
	"sqrt"  =>	meta_uop {sqrt $_[0]},
	"bool"  =>	sub { croak "Can't use && or || in expression containing __" },

	#	"&()"	=>	sub { $_[0]->{impl} },

	#	"||"	=>	meta_bop {$_[0] || $_[1]},
	#	"&&"	=>	meta_bop {$_[0] && $_[1]},
	# fallback => 1,
	;
1;

__END__


=head1 NAME

Switch - A switch statement for Perl

=head1 VERSION

This document describes version 2.06 of Switch,
released November 14, 2001.

=head1 SYNOPSIS

	use Switch;

	switch ($val) {

		case 1		{ print "number 1" }
		case "a"	{ print "string a" }
		case [1..10,42]	{ print "number in list" }
		case (@array)	{ print "number in list" }
		case /\w+/	{ print "pattern" }
		case qr/\w+/	{ print "pattern" }
		case (%hash)	{ print "entry in hash" }
		case (\%hash)	{ print "entry in hash" }
		case (\&sub)	{ print "arg to subroutine" }
		else		{ print "previous case not true" }
	}

=head1 BACKGROUND

[Skip ahead to L<"DESCRIPTION"> if you don't care about the whys
and wherefores of this control structure]

In seeking to devise a "Swiss Army" case mechanism suitable for Perl,
it is useful to generalize this notion of distributed conditional
testing as far as possible. Specifically, the concept of "matching"
between the switch value and the various case values need not be
restricted to numeric (or string or referential) equality, as it is in other 
languages. Indeed, as Table 1 illustrates, Perl
offers at least eighteen different ways in which two values could
generate a match.

	Table 1: Matching a switch value ($s) with a case value ($c)

        Switch  Case    Type of Match Implied   Matching Code
        Value   Value   
        ======  =====   =====================   =============

        number  same    numeric or referential  match if $s == $c;
        or ref          equality

	object  method	result of method call   match if $s->$c();
	ref     name 				match if defined $s->$c();
		or ref

        other   other   string equality         match if $s eq $c;
        non-ref non-ref
        scalar  scalar

        string  regexp  pattern match           match if $s =~ /$c/;

        array   scalar  array entry existence   match if 0<=$c && $c<@$s;
        ref             array entry definition  match if defined $s->[$c];
                        array entry truth       match if $s->[$c];

        array   array   array intersection      match if intersects(@$s, @$c);
        ref     ref     (apply this table to
                         all pairs of elements
                         $s->[$i] and
                         $c->[$j])

        array   regexp  array grep              match if grep /$c/, @$s;
        ref     

        hash    scalar  hash entry existence    match if exists $s->{$c};
        ref             hash entry definition   match if defined $s->{$c};
                        hash entry truth        match if $s->{$c};

        hash    regexp  hash grep               match if grep /$c/, keys %$s;
        ref     

        sub     scalar  return value defn       match if defined $s->($c);
        ref             return value truth      match if $s->($c);

        sub     array   return value defn       match if defined $s->(@$c);
        ref     ref     return value truth      match if $s->(@$c);


In reality, Table 1 covers 31 alternatives, because only the equality and
intersection tests are commutative; in all other cases, the roles of
the C<$s> and C<$c> variables could be reversed to produce a
different test. For example, instead of testing a single hash for
the existence of a series of keys (C<match if exists $s-E<gt>{$c}>),
one could test for the existence of a single key in a series of hashes
(C<match if exists $c-E<gt>{$s}>).

As L<perltodo> observes, a Perl case mechanism must support all these
"ways to do it".


=head1 DESCRIPTION

The Switch.pm module implements a generalized case mechanism that covers
the numerous possible combinations of switch and case values described above.

The module augments the standard Perl syntax with two new control
statements: C<switch> and C<case>. The C<switch> statement takes a
single scalar argument of any type, specified in parentheses.
C<switch> stores this value as the
current switch value in a (localized) control variable.
The value is followed by a block which may contain one or more
Perl statements (including the C<case> statement described below).
The block is unconditionally executed once the switch value has
been cached.

A C<case> statement takes a single scalar argument (in mandatory
parentheses if it's a variable; otherwise the parens are optional) and
selects the appropriate type of matching between that argument and the
current switch value. The type of matching used is determined by the
respective types of the switch value and the C<case> argument, as
specified in Table 1. If the match is successful, the mandatory
block associated with the C<case> statement is executed.

In most other respects, the C<case> statement is semantically identical
to an C<if> statement. For example, it can be followed by an C<else>
clause, and can be used as a postfix statement qualifier. 

However, when a C<case> block has been executed control is automatically
transferred to the statement after the immediately enclosing C<switch>
block, rather than to the next statement within the block. In other
words, the success of any C<case> statement prevents other cases in the
same scope from executing. But see L<"Allowing fall-through"> below.

Together these two new statements provide a fully generalized case
mechanism:

        use Switch;

        # AND LATER...

        %special = ( woohoo => 1,  d'oh => 1 );

        while (<>) {
            switch ($_) {

                case (%special) { print "homer\n"; }      # if $special{$_}
                case /a-z/i     { print "alpha\n"; }      # if $_ =~ /a-z/i
                case [1..9]     { print "small num\n"; }  # if $_ in [1..9]

                case { $_[0] >= 10 } {                    # if $_ >= 10
                    my $age = <>;
                    switch (sub{ $_[0] < $age } ) {

                        case 20  { print "teens\n"; }     # if 20 < $age
                        case 30  { print "twenties\n"; }  # if 30 < $age
                        else     { print "history\n"; }
                    }
                }

                print "must be punctuation\n" case /\W/;  # if $_ ~= /\W/
        }

Note that C<switch>es can be nested within C<case> (or any other) blocks,
and a series of C<case> statements can try different types of matches
-- hash membership, pattern match, array intersection, simple equality,
etc. -- against the same switch value.

The use of intersection tests against an array reference is particularly
useful for aggregating integral cases:

        sub classify_digit
        {
                switch ($_[0]) { case 0            { return 'zero' }
                                 case [2,4,6,8]    { return 'even' }
                                 case [1,3,4,7,9]  { return 'odd' }
                                 case /[A-F]/i     { return 'hex' }
                               }
        }


=head2 Allowing fall-through

Fall-though (trying another case after one has already succeeded)
is usually a Bad Idea in a switch statement. However, this
is Perl, not a police state, so there I<is> a way to do it, if you must.

If a C<case> block executes an untargetted C<next>, control is
immediately transferred to the statement I<after> the C<case> statement
(i.e. usually another case), rather than out of the surrounding
C<switch> block.

For example:

        switch ($val) {
                case 1      { handle_num_1(); next }    # and try next case...
                case "1"    { handle_str_1(); next }    # and try next case...
                case [0..9] { handle_num_any(); }       # and we're done
                case /\d/   { handle_dig_any(); next }  # and try next case...
                case /.*/   { handle_str_any(); next }  # and try next case...
        }

If $val held the number C<1>, the above C<switch> block would call the
first three C<handle_...> subroutines, jumping to the next case test
each time it encountered a C<next>. After the thrid C<case> block
was executed, control would jump to the end of the enclosing
C<switch> block.

On the other hand, if $val held C<10>, then only the last two C<handle_...>
subroutines would be called.

Note that this mechanism allows the notion of I<conditional fall-through>.
For example:

        switch ($val) {
                case [0..9] { handle_num_any(); next if $val < 7; }
                case /\d/   { handle_dig_any(); }
        }

If an untargetted C<last> statement is executed in a case block, this
immediately transfers control out of the enclosing C<switch> block
(in other words, there is an implicit C<last> at the end of each
normal C<case> block). Thus the previous example could also have been
written:

        switch ($val) {
                case [0..9] { handle_num_any(); last if $val >= 7; next; }
                case /\d/   { handle_dig_any(); }
        }


=head2 Automating fall-through

In situations where case fall-through should be the norm, rather than an
exception, an endless succession of terminal C<next>s is tedious and ugly.
Hence, it is possible to reverse the default behaviour by specifying
the string "fallthrough" when importing the module. For example, the 
following code is equivalent to the first example in L<"Allowing fall-through">:

        use Switch 'fallthrough';

        switch ($val) {
                case 1      { handle_num_1(); }
                case "1"    { handle_str_1(); }
                case [0..9] { handle_num_any(); last }
                case /\d/   { handle_dig_any(); }
                case /.*/   { handle_str_any(); }
        }

Note the explicit use of a C<last> to preserve the non-fall-through
behaviour of the third case.



=head2 Alternative syntax

Perl 6 will provide a built-in switch statement with essentially the
same semantics as those offered by Switch.pm, but with a different
pair of keywords. In Perl 6 C<switch> with be spelled C<given>, and
C<case> will be pronounced C<when>. In addition, the C<when> statement
will use a colon between its case value and its block (removing the
need to parenthesize variables.

This future syntax is also available via the Switch.pm module, by
importing it with the argument C<"Perl6">.  For example:

        use Switch 'Perl6';

        given ($val) {
                when 1 :      { handle_num_1(); }
                when $str1 :  { handle_str_1(); }
                when [0..9] : { handle_num_any(); last }
                when /\d/ :   { handle_dig_any(); }
                when /.*/ :   { handle_str_any(); }
        }

Note that you can mix and match both syntaxes by importing the module
with:

	use Switch 'Perl5', 'Perl6';


=head2 Higher-order Operations

One situation in which C<switch> and C<case> do not provide a good
substitute for a cascaded C<if>, is where a switch value needs to
be tested against a series of conditions. For example:

        sub beverage {
            switch (shift) {

                case sub { $_[0] < 10 }  { return 'milk' }
                case sub { $_[0] < 20 }  { return 'coke' }
                case sub { $_[0] < 30 }  { return 'beer' }
                case sub { $_[0] < 40 }  { return 'wine' }
                case sub { $_[0] < 50 }  { return 'malt' }
                case sub { $_[0] < 60 }  { return 'Moet' }
                else                     { return 'milk' }
            }
        }

The need to specify each condition as a subroutine block is tiresome. To
overcome this, when importing Switch.pm, a special "placeholder"
subroutine named C<__> [sic] may also be imported. This subroutine
converts (almost) any expression in which it appears to a reference to a
higher-order function. That is, the expression:

        use Switch '__';

        __ < 2 + __

is equivalent to:

        sub { $_[0] < 2 + $_[1] }

With C<__>, the previous ugly case statements can be rewritten:

        case  __ < 10  { return 'milk' }
        case  __ < 20  { return 'coke' }
        case  __ < 30  { return 'beer' }
        case  __ < 40  { return 'wine' }
        case  __ < 50  { return 'malt' }
        case  __ < 60  { return 'Moet' }
        else           { return 'milk' }

The C<__> subroutine makes extensive use of operator overloading to
perform its magic. All operations involving __ are overloaded to
produce an anonymous subroutine that implements a lazy version
of the original operation.

The only problem is that operator overloading does not allow the
boolean operators C<&&> and C<||> to be overloaded. So a case statement
like this:

        case  0 <= __ && __ < 10  { return 'digit' }  

doesn't act as expected, because when it is
executed, it constructs two higher order subroutines
and then treats the two resulting references as arguments to C<&&>:

        sub { 0 <= $_[0] } && sub { $_[0] < 10 }

This boolean expression is inevitably true, since both references are
non-false. Fortunately, the overloaded C<'bool'> operator catches this
situation and flags it as a error. 

=head1 DEPENDENCIES

The module is implemented using Filter::Util::Call and Text::Balanced
and requires both these modules to be installed. 

=head1 AUTHOR

Damian Conway (damian@conway.org)

=head1 BUGS

There are undoubtedly serious bugs lurking somewhere in code this funky :-)
Bug reports and other feedback are most welcome.

=head1 LIMITATION

Due to the heuristic nature of Switch.pm's source parsing, the presence
of regexes specified with raw C<?...?> delimiters may cause mysterious
errors. The workaround is to use C<m?...?> instead.

=head1 COPYRIGHT

    Copyright (c) 1997-2001, Damian Conway. All Rights Reserved.
    This module is free software. It may be used, redistributed
        and/or modified under the same terms as Perl itself.
if (!$tests) {
	warn "scanning directories in pod-path\n" if $verbose;
	scan_podpath($podroot, $recurse, 0);
    }
    $saved_cache_key = cache_key(@cache_key_args);
}

sub cache_key {
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  package Symbol;

=head1 NAME

Symbol - manipulate Perl symbols and their names

=head1 SYNOPSIS

    use Symbol;

    $sym = gensym;
    open($sym, "filename");
    $_ = <$sym>;
    # etc.

    ungensym $sym;      # no effect

    print qualify("x"), "\n";              # "Test::x"
    print qualify("x", "FOO"), "\n"        # "FOO::x"
    print qualify("BAR::x"), "\n";         # "BAR::x"
    print qualify("BAR::x", "FOO"), "\n";  # "BAR::x"
    print qualify("STDOUT", "FOO"), "\n";  # "main::STDOUT" (global)
    print qualify(\*x), "\n";              # returns \*x
    print qualify(\*x, "FOO"), "\n";       # returns \*x

    use strict refs;
    print { qualify_to_ref $fh } "foo!\n";
    $ref = qualify_to_ref $name, $pkg;

    use Symbol qw(delete_package);
    delete_package('Foo::Bar');
    print "deleted\n" unless exists $Foo::{'Bar::'};


=head1 DESCRIPTION

C<Symbol::gensym> creates an anonymous glob and returns a reference
to it.  Such a glob reference can be used as a file or directory
handle.

For backward compatibility with older implementations that didn't
support anonymous globs, C<Symbol::ungensym> is also provided.
But it doesn't do anything.

C<Symbol::qualify> turns unqualified symbol names into qualified
variable names (e.g. "myvar" -E<gt> "MyPackage::myvar").  If it is given a
second parameter, C<qualify> uses it as the default package;
otherwise, it uses the package of its caller.  Regardless, global
variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
"main::".

Qualification applies only to symbol names (strings).  References are
left unchanged under the assumption that they are glob references,
which are qualified by their nature.

C<Symbol::qualify_to_ref> is just like C<Symbol::qualify> except that it
returns a glob ref rather than a symbol name, so you can use the result
even if C<use strict 'refs'> is in effect.

C<Symbol::delete_package> wipes out a whole package namespace.  Note
this routine is not exported by default--you may want to import it
explicitly.

=cut

BEGIN { require 5.002; }

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(gensym ungensym qualify qualify_to_ref);
@EXPORT_OK = qw(delete_package);

$VERSION = 1.02;

my $genpkg = "Symbol::";
my $genseq = 0;

my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT);

#
# Note that we never _copy_ the glob; we just make a ref to it.
# If we did copy it, then SVf_FAKE would be set on the copy, and
# glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work.
#
sub gensym () {
    my $name = "GEN" . $genseq++;
    my $ref = \*{$genpkg . $name};
    delete $$genpkg{$name};
    $ref;
}

sub ungensym ($) {}

sub qualify ($;$) {
    my ($name) = @_;
    if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
	my $pkg;
	# Global names: special character, "^x", or other. 
	if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
	    $pkg = "main";
	}
	else {
	    $pkg = (@_ > 1) ? $_[1] : caller;
	}
	$name = $pkg . "::" . $name;
    }
    $name;
}

sub qualify_to_ref ($;$) {
    return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
}

#
# of Safe.pm lineage
#
sub delete_package ($) {
    my $pkg = shift;

    # expand to full symbol table name if needed

    unless ($pkg =~ /^main::.*::$/) {
        $pkg = "main$pkg"	if	$pkg =~ /^::/;
        $pkg = "main::$pkg"	unless	$pkg =~ /^main::/;
        $pkg .= '::'		unless	$pkg =~ /::$/;
    }

    my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
    my $stem_symtab = *{$stem}{HASH};
    return unless defined $stem_symtab and exists $stem_symtab->{$leaf};


    # free all the symbols in the package

    my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
    foreach my $name (keys %$leaf_symtab) {
        undef *{$pkg . $name};
    }

    # delete the symbol table

    %$leaf_symtab = ();
    delete $stem_symtab->{$leaf};
}

1;
n't be here (line ".__LINE__."\n";
	}
    }
    @poddata = ();	# clean-up a bit

    chdir($pwd)
	|| die "$0: error changing to directory $pwd: $!\n";

    # cache the item list for later use
    warn "caching items for                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 package Sys::Hostname;

use strict;

use Carp;

require Exporter;
use XSLoader ();
require AutoLoader;

our @ISA     = qw/ Exporter AutoLoader /;
our @EXPORT  = qw/ hostname /;

our $VERSION = '1.1';

our $host;

XSLoader::load 'Sys::Hostname', $VERSION;

sub hostname {

  # method 1 - we already know it
  return $host if defined $host;

  # method 1' - try to ask the system
  $host = ghname();
  return $host if defined $host;

  if ($^O eq 'VMS') {

    # method 2 - no sockets ==> return DECnet node name
    eval { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] };
    if ($@) { return $host = $ENV{'SYS$NODE'}; }

    # method 3 - has someone else done the job already?  It's common for the
    #    TCP/IP stack to advertise the hostname via a logical name.  (Are
    #    there any other logicals which TCP/IP stacks use for the host name?)
    $host = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
            $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
            $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
    return $host if $host;

    # method 4 - does hostname happen to work?
    my($rslt) = `hostname`;
    if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; }
    return $host if $host;

    # rats!
    $host = '';
    Carp::croak "Cannot get host name of local machine";  

  }
  elsif ($^O eq 'MSWin32') {
    ($host) = gethostbyname('localhost');
    chomp($host = `hostname 2> NUL`) unless defined $host;
    return $host;
  }
  elsif ($^O eq 'epoc') {
    $host = 'localhost';
    return $host;
  }
  else {  # Unix
    # is anyone going to make it here?

    # method 2 - syscall is preferred since it avoids tainting problems
    # XXX: is it such a good idea to return hostname untainted?
    eval {
	local $SIG{__DIE__};
	require "syscall.ph";
	$host = "\0" x 65; ## preload scalar
	syscall(&SYS_gethostname, $host, 65) == 0;
    }

    # method 2a - syscall using systeminfo instead of gethostname
    #           -- needed on systems like Solaris
    || eval {
	local $SIG{__DIE__};
	require "sys/syscall.ph";
	require "sys/systeminfo.ph";
	$host = "\0" x 65; ## preload scalar
	syscall(&SYS_systeminfo, &SI_HOSTNAME, $host, 65) != -1;
    }

    # method 3 - trusty old hostname command
    || eval {
	local $SIG{__DIE__};
	local $SIG{CHLD};
	$host = `(hostname) 2>/dev/null`; # bsdish
    }

    # method 4 - use POSIX::uname(), which strictly can't be expected to be
    # correct
    || eval {
	local $SIG{__DIE__};
	require POSIX;
	$host = (POSIX::uname())[1];
    }

    # method 5 - sysV uname command (may truncate)
    || eval {
	local $SIG{__DIE__};
	$host = `uname -n 2>/dev/null`; ## sysVish
    }

    # method 6 - Apollo pre-SR10
    || eval {
	local $SIG{__DIE__};
        my($a,$b,$c,$d);
	($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
    }

    # bummer
    || Carp::croak "Cannot get host name of local machine";  

    # remove garbage 
    $host =~ tr/\0\r\n//d;
    $host;
  }
}

1;

__END__

=head1 NAME

Sys::Hostname - Try every conceivable way to get hostname

=head1 SYNOPSIS

    use Sys::Hostname;
    $host = hostname;

=head1 DESCRIPTION

Attempts several methods of getting the system hostname and
then caches the result.  It tries the first available of the C
library's gethostname(), C<`$Config{aphostname}`>, uname(2),
C<syscall(SYS_gethostname)>, C<`hostname`>, C<`uname -n`>,
and the file F</com/host>.  If all that fails it C<croak>s.

All NULs, returns, and newlines are removed from the result.

=head1 AUTHOR

David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>

Texas Instruments

XS code added by Greg Bacon E<lt>F<gbacon@cs.uah.edu>E<gt>

=cut

 $pod;

    foreach $i (0..$#poddata) {
	my $txt = depod( $poddata[$i] );

	# figure out what kind of item it is.
	# Build string for referencing this item.
	if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
	    next unless $1;
	    $item = $1;
        } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
	    $item = $1;
	} elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
	    $item = $1;
	} el                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                #
# syslog.pl
#
# $Log:	syslog.pl,v $
# 
# tom christiansen <tchrist@convex.com>
# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
# NOTE: openlog now takes three arguments, just like openlog(3)
#
# call syslog() with a string priority and a list of printf() args
# like syslog(3)
#
#  usage: require 'syslog.pl';
#
#  then (put these all in a script to test function)
#		
#
#	do openlog($program,'cons,pid','user');
#	do syslog('info','this is another test');
#	do syslog('mail|warning','this is a better test: %d', time);
#	do closelog();
#	
#	do syslog('debug','this is the last test');
#	do openlog("$program $$",'ndelay','user');
#	do syslog('notice','fooprogram: this is really done');
#
#	$! = 55;
#	do syslog('info','problem was %m'); # %m == $! in syslog(3)

package syslog;

use warnings::register;

$host = 'localhost' unless $host;	# set $syslog'host to change

if ($] >= 5 && warnings::enabled()) {
    warnings::warn("You should 'use Sys::Syslog' instead; continuing");
} 

require 'syslog.ph';

 eval 'use Socket; 1' 			||
     eval { require "socket.ph" } 	||
     require "sys/socket.ph";

$maskpri = &LOG_UPTO(&LOG_DEBUG);

sub main'openlog {
    ($ident, $logopt, $facility) = @_;  # package vars
    $lo_pid = $logopt =~ /\bpid\b/;
    $lo_ndelay = $logopt =~ /\bndelay\b/;
    $lo_cons = $logopt =~ /\bcons\b/;
    $lo_nowait = $logopt =~ /\bnowait\b/;
    &connect if $lo_ndelay;
} 

sub main'closelog {
    $facility = $ident = '';
    &disconnect;
} 

sub main'setlogmask {
    local($oldmask) = $maskpri;
    $maskpri = shift;
    $oldmask;
}
 
sub main'syslog {
    local($priority) = shift;
    local($mask) = shift;
    local($message, $whoami);
    local(@words, $num, $numpri, $numfac, $sum);
    local($facility) = $facility;	# may need to change temporarily.

    die "syslog: expected both priority and mask" unless $mask && $priority;

    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
    undef $numpri;
    undef $numfac;
    foreach (@words) {
	$num = &xlate($_);		# Translate word to number.
	if (/^kern$/ || $num < 0) {
	    die "syslog: invalid level/facility: $_\n";
	}
	elsif ($num <= &LOG_PRIMASK) {
	    die "syslog: too many levels given: $_\n" if defined($numpri);
	    $numpri = $num;
	    return 0 unless &LOG_MASK($numpri) & $maskpri;
	}
	else {
	    die "syslog: too many facilities given: $_\n" if defined($numfac);
	    $facility = $_;
	    $numfac = $num;
	}
    }

    die "syslog: level must be given\n" unless defined($numpri);

    if (!defined($numfac)) {	# Facility not specified in this call.
	$facility = 'user' unless $facility;
	$numfac = &xlate($facility);
    }

    &connect unless $connected;

    $whoami = $ident;

    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
	$whoami = $1;
	$mask = $2;
    } 

    unless ($whoami) {
	($whoami = getlogin) ||
	    ($whoami = getpwuid($<)) ||
		($whoami = 'syslog');
    }

    $whoami .= "[$$]" if $lo_pid;

    $mask =~ s/%m/$!/g;
    $mask .= "\n" unless $mask =~ /\n$/;
    $message = sprintf ($mask, @_);

    $sum = $numpri + $numfac;
    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
	if ($lo_cons) {
	    if ($pid = fork) {
		unless ($lo_nowait) {
		    do {$died = wait;} until $died == $pid || $died < 0;
		}
	    }
	    else {
		open(CONS,">/dev/console");
		print CONS "<$facility.$priority>$whoami: $message\r";
		exit if defined $pid;		# if fork failed, we're parent
		close CONS;
	    }
	}
    }
}

sub xlate {
    local($name) = @_;
    $name = uc $name;
    $name = "LOG_$name" unless $name =~ /^LOG_/;
    $name = "syslog'$name";
    defined &$name ? &$name : -1;
}

sub connect {
    $pat = 'S n C4 x8';

    $af_unix = &AF_UNIX;
    $af_inet = &AF_INET;

    $stream = &SOCK_STREAM;
    $datagram = &SOCK_DGRAM;

    ($name,$aliases,$proto) = getprotobyname('udp');
    $udp = $proto;

    ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
    $syslog = $port;

    if (chop($myname = `hostname`)) {
	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
	die "Can't lookup $myname\n" unless $name;
	@bytes = unpack("C4",$addrs[0]);
    }
    else {
	@bytes = (0,0,0,0);
    }
    $this = pack($pat, $af_inet, 0, @bytes);

    if ($host =~ /^\d+\./) {
	@bytes = split(/\./,$host);
    }
    else {
	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
	die "Can't lookup $host\n" unless $name;
	@bytes = unpack("C4",$addrs[0]);
    }
    $that = pack($pat,$af_inet,$syslog,@bytes);

    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
    bind(SYSLOG,$this) || die "bind: $!\n";
    connect(SYSLOG,$that) || die "connect: $!\n";

    local($old) = select(SYSLOG); $| = 1; select($old);
    $connected = 1;
}

sub disconnect {
    close SYSLOG;
    $connected = 0;
}

1;
 if there's a
# begin stack, we only print if it us.
#
sub process_begin {
    my($whom, $text) = @_;
    $whom = lc($whom);
    push (@begin_stack, $whom);
    if ( $whom =~ /^(pod2)?html$/) {
	print HTML $text if $text;
    }
}

#
# process_end - process a =end pod tag.  pop the
# begin stack.  die if we're mis                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                # This subroutine returns true if its argument is tainted, false otherwise.

sub tainted {
    local($@);
    eval { kill 0 * $_[0] };
    $@ =~ /^Insecure/;
}

1;
    } 
    pop( @begin_stack );
}

#
# process_pre - indented paragraph, made into <PRE></PRE>
#
sub process_pre {
    my( $text ) = @_;
    my( $rest );
    return if $ignore;

    $rest = $$text;

    # insert spaces in place of tabs
    $rest =~ s#.*#
	    my $line = $&;
	    1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
	                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 # Term::ANSIColor -- Color screen output using ANSI escape sequences.
# $Id: ANSIColor.pm,v 1.3 2000/08/06 18:28:10 eagle Exp $
#
# Copyright 1996, 1997, 1998, 2000
#   by Russ Allbery <rra@stanford.edu> and Zenin <zenin@best.com>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# Ah, September, when the sysadmins turn colors and fall off the trees....
#                               -- Dave Van Domelen

############################################################################
# Modules and declarations
############################################################################

package Term::ANSIColor;
require 5.001;

use strict;
use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION $AUTOLOAD %attributes
            $AUTORESET $EACHLINE);

use Exporter ();
@ISA         = qw(Exporter);
@EXPORT      = qw(color colored);
%EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD UNDERLINE UNDERSCORE BLINK
                                 REVERSE CONCEALED BLACK RED GREEN YELLOW
                                 BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED
                                 ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA
                                 ON_CYAN ON_WHITE)]);
Exporter::export_ok_tags ('constants');

# Don't use the CVS revision as the version, since this module is also in
# Perl core and too many things could munge CVS magic revision strings.
$VERSION = 1.03;


############################################################################
# Internal data structures
############################################################################

%attributes = ('clear'      => 0,
               'reset'      => 0,
               'bold'       => 1,
               'dark'       => 2,
               'underline'  => 4,
               'underscore' => 4,
               'blink'      => 5,
               'reverse'    => 7,
               'concealed'  => 8,

               'black'      => 30,   'on_black'   => 40, 
               'red'        => 31,   'on_red'     => 41, 
               'green'      => 32,   'on_green'   => 42, 
               'yellow'     => 33,   'on_yellow'  => 43, 
               'blue'       => 34,   'on_blue'    => 44, 
               'magenta'    => 35,   'on_magenta' => 45, 
               'cyan'       => 36,   'on_cyan'    => 46, 
               'white'      => 37,   'on_white'   => 47);


############################################################################
# Implementation (constant form)
############################################################################

# Time to have fun!  We now want to define the constant subs, which are
# named the same as the attributes above but in all caps.  Each constant sub
# needs to act differently depending on whether $AUTORESET is set.  Without
# autoreset:
#
#   BLUE "text\n"  ==>  "\e[34mtext\n"
#
# If $AUTORESET is set, we should instead get:
#
#   BLUE "text\n"  ==>  "\e[34mtext\n\e[0m"
#
# The sub also needs to handle the case where it has no arguments correctly.
# Maintaining all of this as separate subs would be a major nightmare, as
# well as duplicate the %attributes hash, so instead we define an AUTOLOAD
# sub to define the constant subs on demand.  To do that, we check the name
# of the called sub against the list of attributes, and if it's an all-caps
# version of one of them, we define the sub on the fly and then run it.
sub AUTOLOAD {
    my $sub;
    ($sub = $AUTOLOAD) =~ s/^.*:://;
    my $attr = $attributes{lc $sub};
    if ($sub =~ /^[A-Z_]+$/ && defined $attr) {
        $attr = "\e[" . $attr . 'm';
        eval qq {
            sub $AUTOLOAD {
                if (\$AUTORESET && \@_) {
                    '$attr' . "\@_" . "\e[0m";
                } else {
                    ('$attr' . "\@_");
                }
            }
        };
        goto &$AUTOLOAD;
    } else {
        require Carp;
        Carp::croak ("undefined subroutine &$AUTOLOAD called");
    }
}


############################################################################
# Implementation (attribute string form)
############################################################################

# Return the escape code for a given set of color attributes.
sub color {
    my @codes = map { split } @_;
    my $attribute = '';
    foreach (@codes) {
        $_ = lc $_;
        unless (defined $attributes{$_}) {
            require Carp;
            Carp::croak ("Invalid attribute name $_");
        }
        $attribute .= $attributes{$_} . ';';
    }
    chop $attribute;
    ($attribute ne '') ? "\e[${attribute}m" : undef;
}

# Given a string and a set of attributes, returns the string surrounded by
# escape codes to set those attributes and then clear them at the end of the
# string.  The attributes can be given either as an array ref as the first
# argument or as a list as the second and subsequent arguments.  If
# $EACHLINE is set, insert a reset before each occurrence of the string
# $EACHLINE and the starting attribute code after the string $EACHLINE, so
# that no attribute crosses line delimiters (this is often desirable if the
# output is to be piped to a pager or some other program).
sub colored {
    my ($string, @codes);
    if (ref $_[0]) {
        @codes = @{+shift};
        $string = join ('', @_);
    } else {
        $string = shift;
        @codes = @_;
    }
    if (defined $EACHLINE) {
        my $attr = color (@codes);
        join '', 
            map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ }
                split (/(\Q$EACHLINE\E)/, $string);
    } else {
        color (@codes) . $string . "\e[0m";
    }
}


############################################################################
# Module return value and documentation
############################################################################

# Ensure we evaluate to true.
1;
__END__

=head1 NAME

Term::ANSIColor - Color screen output using ANSI escape sequences

=head1 SYNOPSIS

    use Term::ANSIColor;
    print color 'bold blue';
    print "This text is bold blue.\n";
    print color 'reset';
    print "This text is normal.\n";
    print colored ("Yellow on magenta.\n", 'yellow on_magenta');
    print "This text is normal.\n";
    print colored ['yellow on_magenta'], "Yellow on magenta.\n";

    use Term::ANSIColor qw(:constants);
    print BOLD, BLUE, "This text is in bold blue.\n", RESET;

    use Term::ANSIColor qw(:constants);
    $Term::ANSIColor::AUTORESET = 1;
    print BOLD BLUE "This text is in bold blue.\n";
    print "This text is normal.\n";

=head1 DESCRIPTION

This module has two interfaces, one through color() and colored() and the
other through constants.
    
color() takes any number of strings as arguments and considers them to be
space-separated lists of attributes.  It then forms and returns the escape
sequence to set those attributes.  It doesn't print it out, just returns
it, so you'll have to print it yourself if you want to (this is so that
you can save it as a string, pass it to something else, send it to a file
handle, or do anything else with it that you might care to).

The recognized attributes (all of which should be fairly intuitive) are
clear, reset, dark, bold, underline, underscore, blink, reverse,
concealed, black, red, green, yellow, blue, magenta, on_black, on_red,
on_green, on_yellow, on_blue, on_magenta, on_cyan, and on_white.  Case is
not significant.  Underline and underscore are equivalent, as are clear
and reset, so use whichever is the most intuitive to you.  The color alone
sets the foreground color, and on_color sets the background color.

Note that not all attributes are supported by all terminal types, and some
terminals may not support any of these sequences.  Dark, blink, and
concealed in particular are frequently not implemented.

Attributes, once set, last until they are unset (by sending the attribute
"reset").  Be careful to do this, or otherwise your attribute will last
after your script is done running, and people get very annoyed at having
their prompt and typing changed to weird colors.

As an aid to help with this, colored() takes a scalar as the first
argument and any number of attribute strings as the second argument and
returns the scalar wrapped in escape codes so that the attributes will be
set as requested before the string and reset to normal after the string.
Alternately, you can pass a reference to an array as the first argument,
and then the contents of that array will be taken as attributes and color
codes and the remainder of the arguments as text to colorize.

Normally, colored() just puts attribute codes at the beginning and end of
the string, but if you set $Term::ANSIColor::EACHLINE to some string,
that string will be considered the line delimiter and the attribute will
be set at the beginning of each line of the passed string and reset at the
end of each line.  This is often desirable if the output is being sent to
a program like a pager that can be confused by attributes that span lines.
Normally you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use
this feature.

Alternately, if you import C<:constants>, you can use the constants CLEAR,
RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED,
BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, ON_BLACK, ON_RED, ON_GREEN,
ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly.  These are
the same as color('attribute') and can be used if you prefer typing:

    print BOLD BLUE ON_WHITE "Text\n", RESET;

to

    print colored ("Text\n", 'bold blue on_white');

When using the constants, if you don't want to have to remember to add the
C<, RESET> at the end of each print line, you can set
$Term::ANSIColor::AUTORESET to a true value.  Then, the display mode will
automatically be reset if there is no comma after the constant.  In other
words, with that variable set:

    print BOLD BLUE "Text\n";

will reset the display mode afterwards, whereas:

    print BOLD, BLUE, "Text\n";

will not.

The subroutine interface has the advantage over the constants interface in
that only two subroutines are exported into your namespace, versus
twenty-two in the constants interface.  On the flip side, the constants
interface has the advantage of better compile time error checking, since
misspelled names of colors or attributes in calls to color() and colored()
won't be caught until runtime whereas misspelled names of constants will
be caught at compile time.  So, polute your namespace with almost two
dozen subroutines that you may not even use that often, or risk a silly
bug by mistyping an attribute.  Your choice, TMTOWTDI after all.

=head1 DIAGNOSTICS

=over 4

=item Invalid attribute name %s

(F) You passed an invalid attribute name to either color() or colored().

=item Name "%s" used only once: possible typo

(W) You probably mistyped a constant color name such as:

    print FOOBAR "This text is color FOOBAR\n";

It's probably better to always use commas after constant names in order to
force the next error.

=item No comma allowed after filehandle

(F) You probably mistyped a constant color name such as:

    print FOOBAR, "This text is color FOOBAR\n";

Generating this fatal compile error is one of the main advantages of using
the constants interface, since you'll immediately know if you mistype a
color name.

=item Bareword "%s" not allowed while "strict subs" in use

(F) You probably mistyped a constant color name such as:

    $Foobar = FOOBAR . "This line should be blue\n";

or:

    @Foobar = FOOBAR, "This line should be blue\n";

This will only show up under use strict (another good reason to run under
use strict).

=back

=head1 RESTRICTIONS

It would be nice if one could leave off the commas around the constants
entirely and just say:

    print BOLD BLUE ON_WHITE "Text\n" RESET;

but the syntax of Perl doesn't allow this.  You need a comma after the
string.  (Of course, you may consider it a bug that commas between all the
constants aren't required, in which case you may feel free to insert
commas unless you're using $Term::ANSIColor::AUTORESET.)

For easier debuging, you may prefer to always use the commas when not
setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile
error rather than a warning.

=head1 NOTES

Jean Delvare provided the following table of different common terminal
emulators and their support for the various attributes:

              clear    bold     dark    under    blink   reverse  conceal
 ------------------------------------------------------------------------
 xterm         yes      yes      no      yes     bold      yes      yes
 linux         yes      yes      yes    bold      yes      yes      no
 rxvt          yes      yes      no      yes  bold/black   yes      no
 dtterm        yes      yes      yes     yes    reverse    yes      yes
 teraterm      yes    reverse    no      yes    rev/red    yes      no
 aixterm      kinda   normal     no      yes      no       yes      yes

Where the entry is other than yes or no, that emulator interpret the given
attribute as something else instead.  Note that on an aixterm, clear
doesn't reset colors; you have to explicitly set the colors back to what
you want.  More entries in this table are welcome.

=head1 AUTHORS

Original idea (using constants) by Zenin (zenin@best.com), reimplemented
using subs by Russ Allbery (rra@stanford.edu), and then combined with the
original idea by Russ with input from Zenin.

=cut
t   =~ s/</&lt;/g;
    $rest   =~ s/>/&gt;/g;
    $rest   =~ s/"/&quot;/g;
    return $rest;
} 


#
# dosify - convert filenames to 8.3
#
sub dosify {
    my($str) = @_;
    return lc($str) if $^O eq 'VMS';     # VMS just needs casing
    if ($Is83) {
        $str = lc $str;
        $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
        $st                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                package Term::Cap;
use Carp;

# Last updated: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com

# TODO:
# support Berkeley DB termcaps
# should probably be a .xs module
# force $FH into callers package?
# keep $FH in object at Tgetent time?

=head1 NAME

Term::Cap - Perl termcap interface

=head1 SYNOPSIS

    require Term::Cap;
    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
    $terminal->Trequire(qw/ce ku kd/);
    $terminal->Tgoto('cm', $col, $row, $FH);
    $terminal->Tputs('dl', $count, $FH);
    $terminal->Tpad($string, $count, $FH);

=head1 DESCRIPTION

These are low-level functions to extract and use capabilities from
a terminal capability (termcap) database.

The B<Tgetent> function extracts the entry of the specified terminal
type I<TERM> (defaults to the environment variable I<TERM>) from the
database.

It will look in the environment for a I<TERMCAP> variable.  If
found, and the value does not begin with a slash, and the terminal
type name is the same as the environment string I<TERM>, the
I<TERMCAP> string is used instead of reading a termcap file.  If
it does begin with a slash, the string is used as a path name of
the termcap file to search.  If I<TERMCAP> does not begin with a
slash and name is different from I<TERM>, B<Tgetent> searches the
files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
in that order, unless the environment variable I<TERMPATH> exists,
in which case it specifies a list of file pathnames (separated by
spaces or colons) to be searched B<instead>.  Whenever multiple
files are searched and a tc field occurs in the requested entry,
the entry it names must be found in the same file or one of the
succeeding files.  If there is a C<:tc=...:> in the I<TERMCAP>
environment variable string it will continue the search in the
files as above.

I<OSPEED> is the terminal output bit rate (often mistakenly called
the baud rate).  I<OSPEED> can be specified as either a POSIX
termios/SYSV termio speeds (where 9600 equals 9600) or an old
BSD-style speeds (where 13 equals 9600).

B<Tgetent> returns a blessed object reference which the user can
then use to send the control strings to the terminal using B<Tputs>
and B<Tgoto>.  It calls C<croak> on failure.

B<Tgoto> decodes a cursor addressing string with the given parameters.

The output strings for B<Tputs> are cached for counts of 1 for performance.
B<Tgoto> and B<Tpad> do not cache.  C<$self-E<gt>{_xx}> is the raw termcap
data and C<$self-E<gt>{xx}> is the cached version.

    print $terminal->Tpad($self->{_xx}, 1);

B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
output the string to $FH if specified.

The extracted termcap entry is available in the object
as C<$self-E<gt>{TERMCAP}>.

=head1 EXAMPLES

    # Get terminal output speed
    require POSIX;
    my $termios = new POSIX::Termios;
    $termios->getattr;
    my $ospeed = $termios->getospeed;

    # Old-style ioctl code to get ospeed:
    #     require 'ioctl.pl';
    #     ioctl(TTY,$TIOCGETP,$sgtty);
    #     ($ispeed,$ospeed) = unpack('cc',$sgtty);

    # allocate and initialize a terminal structure
    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };

    # require certain capabilities to be available
    $terminal->Trequire(qw/ce ku kd/);

    # Output Routines, if $FH is undefined these just return the string

    # Tgoto does the % expansion stuff with the given args
    $terminal->Tgoto('cm', $col, $row, $FH);

    # Tputs doesn't do any % expansion.
    $terminal->Tputs('dl', $count = 1, $FH);

=cut

# Returns a list of termcap files to check.
sub termcap_path { ## private
    my @termcap_path;
    # $TERMCAP, if it's a filespec
    push(@termcap_path, $ENV{TERMCAP})
	if ((exists $ENV{TERMCAP}) &&
	    (($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos')
	     ? $ENV{TERMCAP} =~ /^[a-z]:[\\\/]/is
	     : $ENV{TERMCAP} =~ /^\//s));
    if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
	# Add the users $TERMPATH
	push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH}))
    }
    else {
	# Defaults
	push(@termcap_path,
	    $ENV{'HOME'} . '/.termcap',
	    '/etc/termcap',
	    '/usr/share/misc/termcap',
	);
    }
    # return the list of those termcaps that exist
    grep(-f, @termcap_path);
}

sub Tgetent { ## public -- static method
    my $class = shift;
    my $self = bless shift, $class;
    my($term,$cap,$search,$field,$max,$tmp_term,$TERMCAP);
    local($termpat,$state,$first,$entry);	# used inside eval
    local $_;

    # Compute PADDING factor from OSPEED (to be used by Tpad)
    if (! $self->{OSPEED}) {
	carp "OSPEED was not set, defaulting to 9600";
	$self->{OSPEED} = 9600;
    }
    if ($self->{OSPEED} < 16) {
	# delays for old style speeds
	my @pad = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
	$self->{PADDING} = $pad[$self->{OSPEED}];
    }
    else {
	$self->{PADDING} = 10000 / $self->{OSPEED};
    }

    $self->{TERM} = ($self->{TERM} || $ENV{TERM} || croak "TERM not set");
    $term = $self->{TERM};	# $term is the term type we are looking for

    # $tmp_term is always the next term (possibly :tc=...:) we are looking for
    $tmp_term = $self->{TERM};
    # protect any pattern metacharacters in $tmp_term 
    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;

    my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '');

    # $entry is the extracted termcap entry
    if (($foo !~ m:^/:s) && ($foo =~ m/(^|\|)${termpat}[:|]/s)) {
	$entry = $foo;
    }

    my @termcap_path = termcap_path;
    croak "Can't find a valid termcap file" unless @termcap_path || $entry;

    $state = 1;					# 0 == finished
						# 1 == next file
						# 2 == search again

    $first = 0;					# first entry (keeps term name)

    $max = 32;					# max :tc=...:'s

    if ($entry) {
	# ok, we're starting with $TERMCAP
	$first++;				# we're the first entry
	# do we need to continue?
	if ($entry =~ s/:tc=([^:]+):/:/) {
	    $tmp_term = $1;
	    # protect any pattern metacharacters in $tmp_term 
	    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
	}
	else {
	    $state = 0;				# we're already finished
	}
    }

    # This is eval'ed inside the while loop for each file
    $search = q{
	while (<TERMCAP>) {
	    next if /^\\t/ || /^#/;
	    if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
		chomp;
		s/^[^:]*:// if $first++;
		$state = 0;
		while ($_ =~ s/\\\\$//) {
		    defined(my $x = <TERMCAP>) or last;
		    $_ .= $x; chomp;
		}
		last;
	    }
	}
	defined $entry or $entry = '';
	$entry .= $_;
    };

    while ($state != 0) {
	if ($state == 1) {
	    # get the next TERMCAP
	    $TERMCAP = shift @termcap_path
		|| croak "failed termcap lookup on $tmp_term";
	}
	else {
	    # do the same file again
	    # prevent endless recursion
	    $max-- || croak "failed termcap loop at $tmp_term";
	    $state = 1;		# ok, maybe do a new file next time
	}

	open(TERMCAP,"< $TERMCAP\0") || croak "open $TERMCAP: $!";
	eval $search;
	die $@ if $@;
	close TERMCAP;

	# If :tc=...: found then search this file again
	$entry =~ s/:tc=([^:]+):/:/ && ($tmp_term = $1, $state = 2);
	# protect any pattern metacharacters in $tmp_term 
	$termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
    }

    croak "Can't find $term" if $entry eq '';
    $entry =~ s/:+\s*:+/:/g;				# cleanup $entry
    $entry =~ s/:+/:/g;					# cleanup $entry
    $self->{TERMCAP} = $entry;				# save it
    # print STDERR "DEBUG: $entry = ", $entry, "\n";

    # Precompile $entry into the object
    $entry =~ s/^[^:]*://;
    foreach $field (split(/:[\s:\\]*/,$entry)) {
	if ($field =~ /^(\w\w)$/) {
	    $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
	    # print STDERR "DEBUG: flag $1\n";
	}
	elsif ($field =~ /^(\w\w)\@/) {
	    $self->{'_' . $1} = "";
	    # print STDERR "DEBUG: unset $1\n";
	}
	elsif ($field =~ /^(\w\w)#(.*)/) {
	    $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
	    # print STDERR "DEBUG: numeric $1 = $2\n";
	}
	elsif ($field =~ /^(\w\w)=(.*)/) {
	    # print STDERR "DEBUG: string $1 = $2\n";
	    next if defined $self->{'_' . ($cap = $1)};
	    $_ = $2;
	    s/\\E/\033/g;
	    s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
	    s/\\n/\n/g;
	    s/\\r/\r/g;
	    s/\\t/\t/g;
	    s/\\b/\b/g;
	    s/\\f/\f/g;
	    s/\\\^/\377/g;
	    s/\^\?/\177/g;
	    s/\^(.)/pack('c',ord($1) & 31)/eg;
	    s/\\(.)/$1/g;
	    s/\377/^/g;
	    $self->{'_' . $cap} = $_;
	}
	# else { carp "junk in $term ignored: $field"; }
    }
    $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
    $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
    $self;
}

# $terminal->Tpad($string, $cnt, $FH);
sub Tpad { ## public
    my $self = shift;
    my($string, $cnt, $FH) = @_;
    my($decr, $ms);

    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
	$ms = $1;
	$ms *= $cnt if $2;
	$string = $3;
	$decr = $self->{PADDING};
	if ($decr > .1) {
	    $ms += $decr / 2;
	    $string .= $self->{'_pc'} x ($ms / $decr);
	}
    }
    print $FH $string if $FH;
    $string;
}

# $terminal->Tputs($cap, $cnt, $FH);
sub Tputs { ## public
    my $self = shift;
    my($cap, $cnt, $FH) = @_;
    my $string;

    if ($cnt > 1) {
	$string = Tpad($self, $self->{'_' . $cap}, $cnt);
    } else {
	# cache result because Tpad can be slow
	$string = defined $self->{$cap} ? $self->{$cap} :
	    ($self->{$cap} = Tpad($self, $self->{'_' . $cap}, 1));
    }
    print $FH $string if $FH;
    $string;
}

# %%   output `%'
# %d   output value as in printf %d
# %2   output value as in printf %2d
# %3   output value as in printf %3d
# %.   output value as in printf %c
# %+x  add x to value, then do %.
#
# %>xy if value > x then add y, no output
# %r   reverse order of two parameters, no output
# %i   increment by one, no output
# %B   BCD (16*(value/10)) + (value%10), no output
#
# %n   exclusive-or all parameters with 0140 (Datamedia 2500)
# %D   Reverse coding (value - 2*(value%16)), no output (Delta Data)
#
# $terminal->Tgoto($cap, $col, $row, $FH);
sub Tgoto { ## public
    my $self = shift;
    my($cap, $code, $tmp, $FH) = @_;
    my $string = $self->{'_' . $cap};
    my $result = '';
    my $after = '';
    my $online = 0;
    my @tmp = ($tmp,$code);
    my $cnt = $code;

    while ($string =~ /^([^%]*)%(.)(.*)/) {
	$result .= $1;
	$code = $2;
	$string = $3;
	if ($code eq 'd') {
	    $result .= sprintf("%d",shift(@tmp));
	}
	elsif ($code eq '.') {
	    $tmp = shift(@tmp);
	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
		if ($online) {
		    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
		}
		else {
		    ++$tmp, $after .= $self->{'_bc'};
		}
	    }
	    $result .= sprintf("%c",$tmp);
	    $online = !$online;
	}
	elsif ($code eq '+') {
	    $result .= sprintf("%c",shift(@tmp)+ord($string));
	    $string = substr($string,1,99);
	    $online = !$online;
	}
	elsif ($code eq 'r') {
	    ($code,$tmp) = @tmp;
	    @tmp = ($tmp,$code);
	    $online = !$online;
	}
	elsif ($code eq '>') {
	    ($code,$tmp,$string) = unpack("CCa99",$string);
	    if ($tmp[$[] > $code) {
		$tmp[$[] += $tmp;
	    }
	}
	elsif ($code eq '2') {
	    $result .= sprintf("%02d",shift(@tmp));
	    $online = !$online;
	}
	elsif ($code eq '3') {
	    $result .= sprintf("%03d",shift(@tmp));
	    $online = !$online;
	}
	elsif ($code eq 'i') {
	    ($code,$tmp) = @tmp;
	    @tmp = ($code+1,$tmp+1);
	}
	else {
	    return "OOPS";
	}
    }
    $string = Tpad($self, $result . $string . $after, $cnt);
    print $FH $string if $FH;
    $string;
}

# $terminal->Trequire(qw/ce ku kd/);
sub Trequire { ## public
    my $self = shift;
    my($cap,@undefined);
    foreach $cap (@_) {
	push(@undefined, $cap)
	    unless defined $self->{'_' . $cap} && $self->{'_' . $cap};
    }
    croak "Terminal does not support: (@undefined)" if @undefined;
}

1;

of POD input text. It may be a
package Term::Complete;
require 5.000;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(Complete);

#      @(#)complete.pl,v1.2            (me@anywhere.EBay.Sun.COM) 09/23/91

=head1 NAME

Term::Complete - Perl word completion module

=head1 SYNOPSIS

    $input = Complete('prompt_string', \@completion_list);
    $input = Complete('prompt_string', @completion_list);

=head1 DESCRIPTION

This routine provides word completion on the list of words in
the array (or array ref).

The tty driver is put into raw mode using the system command
C<stty raw -echo> and restored using C<stty -raw echo>.

The following command characters are defined:

=over 4

=item E<lt>tabE<gt>

Attempts word completion.
Cannot be changed.

=item ^D

Prints completion list.
Defined by I<$Term::Complete::complete>.

=item ^U

Erases the current input.
Defined by I<$Term::Complete::kill>.

=item E<lt>delE<gt>, E<lt>bsE<gt>

Erases one character.
Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.

=back

=head1 DIAGNOSTICS

Bell sounds when word completion fails.

=head1 BUGS

The completion character E<lt>tabE<gt> cannot be changed.

=head1 AUTHOR

Wayne Thompson

=cut

CONFIG: {
    $complete = "\004";
    $kill     = "\025";
    $erase1 =   "\177";
    $erase2 =   "\010";
}

sub Complete {
    my($prompt, @cmp_list, $cmp, $test, $l, @match);
    my ($return, $r) = ("", 0);

    $return = "";
    $r      = 0;

    $prompt = shift;
    if (ref $_[0] || $_[0] =~ /^\*/) {
	@cmp_lst = sort @{$_[0]};
    }
    else {
	@cmp_lst = sort(@_);
    }

    system('stty raw -echo');
    LOOP: {
        print($prompt, $return);
        while (($_ = getc(STDIN)) ne "\r") {
            CASE: {
                # (TAB) attempt completion
                $_ eq "\t" && do {
                    @match = grep(/^$return/, @cmp_lst);
                    unless ($#match < 0) {
                        $l = length($test = shift(@match));
                        foreach $cmp (@match) {
                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
                                $l--;
                            }
                        }
                        print("\a");
                        print($test = substr($test, $r, $l - $r));
                        $r = length($return .= $test);
                    }
                    last CASE;
                };

                # (^D) completion list
                $_ eq $complete && do {
                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
                    redo LOOP;
                };

                # (^U) kill
                $_ eq $kill && do {
                    if ($r) {
                        $r	= 0;
			$return	= "";
                        print("\r\n");
                        redo LOOP;
                    }
                    last CASE;
                };

                # (DEL) || (BS) erase
                ($_ eq $erase1 || $_ eq $erase2) && do {
                    if($r) {
                        print("\b \b");
                        chop($return);
                        $r--;
                    }
                    last CASE;
                };

                # printable char
                ord >= 32 && do {
                    $return .= $_;
                    $r++;
                    print;
                    last CASE;
                };
            }
        }
    }
    system('stty -raw echo');
    print("\n");
    $return;
}

1;

e name of the input source to the
contents of the given argument.

=end __PRIVATE__                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                