[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);
use Cwd;

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
$origdir = cwd;
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{startperl}
    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	if 0;

use strict;
my \@pagers = ();
push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

#
# Perldoc revision #1 -- look up a piece of documentation in .pod format that
# is embedded in the perl installation tree.
#
# This is not to be confused with Tom Christianson's perlman, which is a
# man replacement, written in perl. This perldoc is strictly for reading
# the perl manuals, though it too is written in perl.

if(@ARGV<1) {
	my $me = $0;		# Editing $0 is unportable
	$me =~ s,.*/,,;
	die <<EOF;
Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
       $me -f PerlFunc
       $me -q FAQKeywords

The -h option prints more help.  Also try "perldoc perldoc" to get
aquainted with the system.
EOF
}

use Getopt::Std;
use Config '%Config';

my @global_found = ();
my $global_target = "";

my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_Dos = $^O eq 'dos';

sub usage{
    warn "@_\n" if @_;
    # Erase evidence of previous errors (if any), so exit status is simple.
    $! = 0;
    die <<EOF;
perldoc [options] PageName|ModuleName|ProgramName...
perldoc [options] -f BuiltinFunction
perldoc [options] -q FAQRegex

Options:
    -h   Display this help message
    -r   Recursive search (slow)
    -i   Ignore case 
    -t   Display pod using pod2text instead of pod2man and nroff
             (-t is the default on win32)
    -u	 Display unformatted pod text
    -m   Display module's file in its entirety
    -l   Display the module's file name
    -F   Arguments are file names, not modules
    -v	 Verbosely describe what's going on
    -X	 use index if present (looks for pod.idx at $Config{archlib})


PageName|ModuleName...
         is the name of a piece of documentation that you want to look at. You 
         may either give a descriptive name of the page (as in the case of
         `perlfunc') the name of a module, either like `Term::Info', 
         `Term/Info', the partial name of a module, like `info', or 
         `makemaker', or the name of a program, like `perldoc'.

BuiltinFunction
         is the name of a perl function.  Will extract documentation from
         `perlfunc'.

FAQRegex
         is a regex. Will search perlfaq[1-9] for and extract any
         questions that match.

Any switches in the PERLDOC environment variable will be used before the 
command line arguments.  The optional pod index file contains a list of
filenames, one per line.

EOF
}

if( defined $ENV{"PERLDOC"} ) {
    require Text::ParseWords;
    unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
}
!NO!SUBS!

my $getopts = "mhtluvriFf:Xq:";
print OUT <<"!GET!OPTS!";

use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );

getopts("$getopts") || usage;
!GET!OPTS!

print OUT <<'!NO!SUBS!';

usage if $opt_h;

my $podidx;
if( $opt_X ) {
    $podidx = "$Config{'archlib'}/pod.idx";
    $podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
}

if( (my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
    usage("only one of -t, -u, -m or -l")
} elsif ($Is_MSWin32 || $Is_Dos) {
    $opt_t = 1 unless $opts
}

if ($opt_t) { require Pod::Text; import Pod::Text; }

my @pages;
if ($opt_f) {
   @pages = ("perlfunc");
} elsif ($opt_q) {
   @pages = ("perlfaq1" .. "perlfaq9");
} else {
   @pages = @ARGV;
}

# Does this look like a module or extension directory?
if (-f "Makefile.PL") {
	# Add ., lib and blib/* libs to @INC (if they exist)
	unshift(@INC, '.');
	unshift(@INC, 'lib') if -d 'lib';
	require ExtUtils::testlib;
}


sub containspod {
    my($file, $readit) = @_;
    return 1 if !$readit && $file =~ /\.pod$/i;
    local($_);
    open(TEST,"<$file");
    while(<TEST>) {
	if(/^=head/) {
	    close(TEST);
	    return 1;
	}
    }
    close(TEST);
    return 0;
}

sub minus_f_nocase {
     my($dir,$file) = @_;
     my $path = join('/',$dir,$file);
     return $path if -f $path and -r _;
     if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
        # on a case-forgiving file system or if case is important 
	# that is it all we can do
	warn "Ignored $file: unreadable\n" if -f _;
	return '';
     }
     local *DIR;
     local($")="/";
     my @p = ($dir);
     my($p,$cip);
     foreach $p (split(/\//, $file)){
	my $try = "@p/$p";
	stat $try;
 	if (-d _){
 	    push @p, $p;
	    if ( $p eq $global_target) {
		my $tmp_path = join ('/', @p);
		my $path_f = 0;
		for (@global_found) {
		    $path_f = 1 if $_ eq $tmp_path;
		}
		push (@global_found, $tmp_path) unless $path_f;
		print STDERR "Found as @p but directory\n" if $opt_v;
	    }
 	} elsif (-f _ && -r _) {
 	    return $try;
 	} elsif (-f _) {
	    warn "Ignored $try: unreadable\n";
 	} else {
 	    my $found=0;
 	    my $lcp = lc $p;
 	    opendir DIR, "@p";
 	    while ($cip=readdir(DIR)) {
 		if (lc $cip eq $lcp){
 		    $found++;
 		    last;
 		}
 	    }
 	    closedir DIR;
 	    return "" unless $found;
 	    push @p, $cip;
 	    return "@p" if -f "@p" and -r _;
	    warn "Ignored $file: unreadable\n" if -f _;
 	}
     }
     return "";
}
 

sub check_file {
    my($dir,$file) = @_;
    if ($opt_m) {
	return minus_f_nocase($dir,$file);
    } else {
	my $path = minus_f_nocase($dir,$file);
        return $path if length $path and containspod($path);
    }
    return "";
}


sub searchfor {
    my($recurse,$s,@dirs) = @_;
    $s =~ s!::!/!g;
    $s = VMS::Filespec::unixify($s) if $Is_VMS;
    return $s if -f $s && containspod($s);
    printf STDERR "Looking for $s in @dirs\n" if $opt_v;
    my $ret;
    my $i;
    my $dir;
    $global_target = (split('/', $s))[-1];
    for ($i=0; $i<@dirs; $i++) {
	$dir = $dirs[$i];
	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
	if (       ( $ret = check_file $dir,"$s.pod")
		or ( $ret = check_file $dir,"$s.pm")
		or ( $ret = check_file $dir,$s)
		or ( $Is_VMS and
		     $ret = check_file $dir,"$s.com")
		or ( $^O eq 'os2' and 
		     $ret = check_file $dir,"$s.cmd")
		or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
		     $ret = check_file $dir,"$s.bat")
		or ( $ret = check_file "$dir/pod","$s.pod")
		or ( $ret = check_file "$dir/pod",$s)
	) {
	    return $ret;
	}
	
	if ($recurse) {
	    opendir(D,$dir);
	    my @newdirs = map "$dir/$_", grep {
		not /^\.\.?$/ and
		not /^auto$/  and   # save time! don't search auto dirs
		-d  "$dir/$_"
	    } readdir D;
	    closedir(D);
	    next unless @newdirs;
	    @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
	    print STDERR "Also looking in @newdirs\n" if $opt_v;
	    push(@dirs,@newdirs);
	}
    }
    return ();
}

my @found;
foreach (@pages) {
        if ($podidx && open(PODIDX, $podidx)) {
	    my $searchfor = $_;
	    local($_);
	    $searchfor =~ s,::,/,g;
	    print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
	    while (<PODIDX>) {
		chomp;
		push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
	    }
	    close(PODIDX);
	    next;
        }
	print STDERR "Searching for $_\n" if $opt_v;
	# We must look both in @INC for library modules and in PATH
	# for executables, like h2xs or perldoc itself.
	my @searchdirs = @INC;
	if ($opt_F) {
	  next unless -r;
	  push @found, $_ if $opt_m or containspod($_);
	  next;
	}
	unless ($opt_m) { 
	    if ($Is_VMS) {
		my($i,$trn);
		for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
		    push(@searchdirs,$trn);
		}
		push(@searchdirs,'perl_root:[lib.pod]')  # installed pods
	    } else {
	        push(@searchdirs, grep(-d, split($Config{path_sep}, 
						 $ENV{'PATH'})));
	    }
	}
	my @files = searchfor(0,$_,@searchdirs);
	if( @files ) {
		print STDERR "Found as @files\n" if $opt_v;
	} else {
		# no match, try recursive search
		
		@searchdirs = grep(!/^\.$/,@INC);
		
		@files= searchfor(1,$_,@searchdirs) if $opt_r;
		if( @files ) {
			print STDERR "Loosely found as @files\n" if $opt_v;
		} else {
			print STDERR "No documentation found for \"$_\".\n";
			if (@global_found) {
			    print STDERR "However, try\n";
			    for my $dir (@global_found) {
				opendir(DIR, $dir) or die "$!";
				while (my $file = readdir(DIR)) {
				    next if ($file =~ /^\./);
				    $file =~ s/\.(pm|pod)$//;
				    print STDERR "\tperldoc $_\::$file\n";
				}
				closedir DIR;
			    }
			}
		}
	}
	push(@found,@files);
}

if(!@found) {
	exit ($Is_VMS ? 98962 : 1);
}

if ($opt_l) {
    print join("\n", @found), "\n";
    exit;
}

my $lines = $ENV{LINES} || 24;

my $no_tty;
if( ! -t STDOUT ) { $no_tty = 1 }

my $tmp;
if ($Is_MSWin32) {
	$tmp = "$ENV{TEMP}\\perldoc1.$$";
	push @pagers, qw( more< less notepad );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
} elsif ($Is_VMS) {
	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
	push @pagers, qw( most more less type/page );
} elsif ($Is_Dos) {
	$tmp = "$ENV{TEMP}/perldoc1.$$";
	$tmp =~ tr!\\/!//!s;
	push @pagers, qw( less.exe more.com< );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
} else {
	if ($^O eq 'os2') {
	  require POSIX;
	  $tmp = POSIX::tmpnam();
	  unshift @pagers, 'less', 'cmd /c more <';
	} else {
	  $tmp = "/tmp/perldoc1.$$";	  
	}
	push @pagers, qw( more less pg view cat );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
}
unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};

if ($opt_m) {
	foreach my $pager (@pagers) {
		system("$pager @found") or exit;
	}
	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
	exit 1;
} 

if ($opt_f) {
   my $perlfunc = shift @found;
   open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";

   # Skip introduction
   while (<PFUNC>) {
       last if /^=head2 Alphabetical Listing of Perl Functions/;
   }

   # Look for our function
   my $found = 0;
   my @pod;
   while (<PFUNC>) {
       if (/^=item\s+\Q$opt_f\E\b/o)  {
	   $found = 1;
       } elsif (/^=item/) {
	   last if $found > 1;
       }
       next unless $found;
       push @pod, $_;
       ++$found if /^\w/;	# found descriptive text
   }
   if (@pod) {
       if ($opt_t) {
	   open(FORMATTER, "| pod2text") || die "Can't start filter";
	   print FORMATTER "=over 8\n\n";
	   print FORMATTER @pod;
	   print FORMATTER "=back\n";
	   close(FORMATTER);
       } elsif (@pod < $lines-2) {
	   print @pod;
       } else {
	   foreach my $pager (@pagers) {
		open (PAGER, "| $pager") or next;
		print PAGER @pod ;
		close(PAGER) or next;
		last;
	   }
       }
   } else {
       die "No documentation for perl function `$opt_f' found\n";
   }
   exit;
}

if ($opt_q) {
   local @ARGV = @found;	# I'm lazy, sue me.
   my $found = 0;
   my %found_in;
   my @pod;

   while (<>) {
      if (/^=head2\s+.*$opt_q/oi) {
	 $found = 1;
	 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
      } elsif (/^=head2/) {
	 $found = 0;
      }
      next unless $found;
      push @pod, $_;
   }
   
   if (@pod) {
      if ($opt_t) {
	 open(FORMATTER, "| pod2text") || die "Can't start filter";
	 print FORMATTER "=over 8\n\n";
	 print FORMATTER @pod;
	 print FORMATTER "=back\n";
	 close(FORMATTER);
      } elsif (@pod < $lines-2) {
	 print @pod;
      } else {
	 foreach my $pager (@pagers) {
	    open (PAGER, "| $pager") or next;
	    print PAGER @pod ;
	    close(PAGER) or next;
	    last;
	 }
      }
   } else {
      die "No documentation for perl FAQ keyword `$opt_q' found\n";
   }
   exit;
}

foreach (@found) {

	my $err;
	if($opt_t) {
		open(TMP,">>$tmp");
		Pod::Text::pod2text($_,*TMP);
		close(TMP);
	} elsif(not $opt_u) {
		my $cmd = "pod2man --lax $_ | nroff -man";
		$cmd .= " | col -x" if $^O =~ /hpux/;
		my $rslt = `$cmd`;
		unless(($err = $?)) {
			open(TMP,">>$tmp");
			print TMP $rslt;
			close TMP;
		}
	}
	                                                
	if( $opt_u or $err or -z $tmp) {
		open(OUT,">>$tmp");
		open(IN,"<$_");
		my $cut = 1;
		while (<IN>) {
			$cut = $1 eq 'cut' if /^=(\w+)/;
			next if $cut;
			print OUT;
		}
		close(IN);
		close(OUT);
	}
}

if( $no_tty ) {
	open(TMP,"<$tmp");
	print while <TMP>;
	close(TMP);
} else {
	foreach my $pager (@pagers) {
		system("$pager $tmp") or last;
	}
}

1 while unlink($tmp); #Possibly pointless VMSism

exit 0;

__END__

=head1 NAME

perldoc - Look up Perl documentation in pod format.

=head1 SYNOPSIS

B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>]  [B<-X>] PageName|ModuleName|ProgramName

B<perldoc> B<-f> BuiltinFunction

B<perldoc> B<-q> FAQ Keyword

=head1 DESCRIPTION

I<perldoc> looks up a piece of documentation in .pod format that is embedded
in the perl installation tree or in a perl script, and displays it via
C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
C<col -x> will be used.) This is primarily used for the documentation for
the perl library modules.

Your system may also have man pages installed for those modules, in
which case you can probably just use the man(1) command.

=head1 OPTIONS

=over 5

=item B<-h> help

Prints out a brief help message.

=item B<-v> verbose

Describes search for the item in detail.

=item B<-t> text output

Display docs using plain text converter, instead of nroff. This may be faster,
but it won't look as nice.

=item B<-u> unformatted

Find docs only; skip reformatting by pod2*

=item B<-m> module

Display the entire module: both code and unformatted pod documentation.
This may be useful if the docs don't explain a function in the detail
you need, and you'd like to inspect the code directly; perldoc will find
the file for you and simply hand it off for display.

=item B<-l> file name only

Display the file name of the module found.

=item B<-F> file names

Consider arguments as file names, no search in directories will be performed.

=item B<-f> perlfunc

The B<-f> option followed by the name of a perl built in function will
extract the documentation of this function from L<perlfunc>.

=item B<-q> perlfaq

The B<-q> option takes a regular expression as an argument.  It will search
the question headings in perlfaq[1-9] and print the entries matching
the regular expression.

=item B<-X> use an index if present

The B<-X> option looks for a entry whose basename matches the name given on the
command line in the file C<$Config{archlib}/pod.idx>.  The pod.idx file should
contain fully qualified filenames, one per line.

=item B<PageName|ModuleName|ProgramName>

The item you want to look up.  Nested modules (such as C<File::Basename>)
are specified either as C<File::Basename> or C<File/Basename>.  You may also
give a descriptive name of a page, such as C<perlfunc>. You make also give a
partial or wrong-case name, such as "basename" for "File::Basename", but
this will be slower, if there is more then one page with the same partial
name, you will only get the first one.

=back

=head1 ENVIRONMENT

Any switches in the C<PERLDOC> environment variable will be used before the 
command line arguments.  C<perldoc> also searches directories
specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
defined) and C<PATH> environment variables.
(The latter is so that embedded pods for executables, such as
C<perldoc> itself, are available.)  C<perldoc> will use, in order of
preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
used if C<perldoc> was told to display plain text or unformatted pod.)

=head1 AUTHOR

Kenneth Albanowski <kjahds@kjahds.com>

Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>

=cut

#
# Version 1.14: Wed Jul 15 01:50:20 EST 1998
#       Robin Barker <rmb1@cise.npl.co.uk>
#	-strict, -w cleanups
# Version 1.13: Fri Feb 27 16:20:50 EST 1997
#       Gurusamy Sarathy <gsar@umich.edu>
#	-doc tweaks for -F and -X options
# Version 1.12: Sat Apr 12 22:41:09 EST 1997
#       Gurusamy Sarathy <gsar@umich.edu>
#	-various fixes for win32
# Version 1.11: Tue Dec 26 09:54:33 EST 1995
#       Kenneth Albanowski <kjahds@kjahds.com>
#   -added Charles Bailey's further VMS patches, and -u switch
#   -added -t switch, with pod2text support
# 
# Version 1.10: Thu Nov  9 07:23:47 EST 1995
#		Kenneth Albanowski <kjahds@kjahds.com>
#	-added VMS support
#	-added better error recognition (on no found pages, just exit. On
#	 missing nroff/pod2man, just display raw pod.)
#	-added recursive/case-insensitive matching (thanks, Andreas). This
#	 slows things down a bit, unfortunately. Give a precise name, and
#	 it'll run faster.
#
# Version 1.01:	Tue May 30 14:47:34 EDT 1995
#		Andy Dougherty  <doughera@lafcol.lafayette.edu>
#   -added pod documentation.
#   -added PATH searching.
#   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
#    and friends.
#
#
# TODO:
#
#	Cache directories read during sloppy match
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;
Commit	Line	Data
4633a7c4	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
8a5546a1	5	use Cwd;
4633a7c4	6
85880f03	7	# List explicitly here the variables you want Configure to
	8	# generate. Metaconfig only looks for shell variables, so you
	9	# have to mention them as if they were shell variables, not
	10	# %Config entries. Thus you write
4633a7c4	11	# $startperl
85880f03	12	# to ensure Configure will look for $Config{startperl}.
4633a7c4	13
	14	# This forces PL files to create target in same directory as PL file.
	15	# This is so that make depend always knows where to find PL derivatives.
8a5546a1	16	$origdir = cwd;
44a8e56a	17	chdir dirname($0);
44a8e56a	18	$file = basename($0, '.PL');
774d564b	19	$file .= '.com' if $^O eq 'VMS';
4633a7c4	20
	21	open OUT,">$file" or die "Can't create $file: $!";
	22
	23	print "Extracting $file (with variable substitutions)\n";
	24
	25	# In this section, perl variables will be expanded during extraction.
	26	# You can use $Config{...} to use Configure variables.
	27
85880f03	28	print OUT <<"!GROK!THIS!";
5f05dabc	29	$Config{startperl}
5f05dabc	30	eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
c5ae3962	31	if 0;
55497cff	32
c5ae3962	33	use strict;
c5ae3962	34	my \@pagers = ();
55497cff	35	push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
4633a7c4	36	!GROK!THIS!
	37
	38	# In the following, perl variables are not expanded during extraction.
	39
	40	print OUT <<'!NO!SUBS!';
	41
	42	#
	43	# Perldoc revision #1 -- look up a piece of documentation in .pod format that
	44	# is embedded in the perl installation tree.
	45	#
	46	# This is not to be confused with Tom Christianson's perlman, which is a
	47	# man replacement, written in perl. This perldoc is strictly for reading
	48	# the perl manuals, though it too is written in perl.
4633a7c4	49
4633a7c4	50	if(@ARGV<1) {
c5ae3962	51	my $me = $0; # Editing $0 is unportable
fb73857a	52	$me =~ s,.*/,,;
4633a7c4	53	die <<EOF;
5315ba28	54	Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName\|ModuleName\|ProgramName
0b166b66	55	$me -f PerlFunc
a3cb178b	56	$me -q FAQKeywords
4633a7c4	57
89b8affa	58	The -h option prints more help. Also try "perldoc perldoc" to get
89b8affa	59	aquainted with the system.
4633a7c4	60	EOF
	61	}
	62
	63	use Getopt::Std;
59586d77	64	use Config '%Config';
59586d77	65
c5ae3962	66	my @global_found = ();
c5ae3962	67	my $global_target = "";
fb73857a	68
c5ae3962	69	my $Is_VMS = $^O eq 'VMS';
	70	my $Is_MSWin32 = $^O eq 'MSWin32';
	71	my $Is_Dos = $^O eq 'dos';
4633a7c4	72
4633a7c4	73	sub usage{
ff0cee69	74	warn "@_\n" if @_;
	75	# Erase evidence of previous errors (if any), so exit status is simple.
	76	$! = 0;
4633a7c4	77	die <<EOF;
31bdbec1	78	perldoc [options] PageName\|ModuleName\|ProgramName...
31bdbec1	79	perldoc [options] -f BuiltinFunction
a3cb178b	80	perldoc [options] -q FAQRegex
31bdbec1	81
31bdbec1	82	Options:
137443ea	83	-h Display this help message
5315ba28	84	-r Recursive search (slow)
5315ba28	85	-i Ignore case
137443ea	86	-t Display pod using pod2text instead of pod2man and nroff
137443ea	87	(-t is the default on win32)
85880f03	88	-u Display unformatted pod text
a3cb178b	89	-m Display module's file in its entirety
a3cb178b	90	-l Display the module's file name
cce34969	91	-F Arguments are file names, not modules
137443ea	92	-v Verbosely describe what's going on
89b8affa	93	-X use index if present (looks for pod.idx at $Config{archlib})
31bdbec1	94
a3cb178b	95
4633a7c4	96	PageName\|ModuleName...
	97	is the name of a piece of documentation that you want to look at. You
	98	may either give a descriptive name of the page (as in the case of
	99	`perlfunc') the name of a module, either like `Term::Info',
	100	`Term/Info', the partial name of a module, like `info', or
	101	`makemaker', or the name of a program, like `perldoc'.
31bdbec1	102
	103	BuiltinFunction
	104	is the name of a perl function. Will extract documentation from
	105	`perlfunc'.
a3cb178b	106
	107	FAQRegex
	108	is a regex. Will search perlfaq[1-9] for and extract any
	109	questions that match.
	110
4633a7c4	111	Any switches in the PERLDOC environment variable will be used before the
89b8affa	112	command line arguments. The optional pod index file contains a list of
89b8affa	113	filenames, one per line.
4633a7c4	114
	115	EOF
	116	}
	117
c5ae3962	118	if( defined $ENV{"PERLDOC"} ) {
	119	require Text::ParseWords;
	120	unshift(@ARGV, Text::ParseWords::shellwords($ENV{"PERLDOC"}));
	121	}
	122	!NO!SUBS!
	123
	124	my $getopts = "mhtluvriFf:Xq:";
	125	print OUT <<"!GET!OPTS!";
4633a7c4	126
c5ae3962	127	use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
4633a7c4	128
c5ae3962	129	getopts("$getopts") \|\| usage;
c5ae3962	130	!GET!OPTS!
4633a7c4	131
c5ae3962	132	print OUT <<'!NO!SUBS!';
85880f03	133
c5ae3962	134	usage if $opt_h;
4633a7c4	135
c5ae3962	136	my $podidx;
0d3da1c8	137	if( $opt_X ) {
	138	$podidx = "$Config{'archlib'}/pod.idx";
	139	$podidx = "" unless -f $podidx && -r _ && -M _ <= 7;
	140	}
89b8affa	141
c5ae3962	142	if( (my $opts = do{ local $^W; $opt_t + $opt_u + $opt_m + $opt_l }) > 1) {
137443ea	143	usage("only one of -t, -u, -m or -l")
0151c6ef	144	} elsif ($Is_MSWin32 \|\| $Is_Dos) {
c5ae3962	145	$opt_t = 1 unless $opts
137443ea	146	}
4633a7c4	147
7eda7aea	148	if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4	149
c5ae3962	150	my @pages;
31bdbec1	151	if ($opt_f) {
31bdbec1	152	@pages = ("perlfunc");
a3cb178b	153	} elsif ($opt_q) {
a3cb178b	154	@pages = ("perlfaq1" .. "perlfaq9");
31bdbec1	155	} else {
	156	@pages = @ARGV;
	157	}
	158
fb73857a	159	# Does this look like a module or extension directory?
	160	if (-f "Makefile.PL") {
	161	# Add ., lib and blib/* libs to @INC (if they exist)
	162	unshift(@INC, '.');
	163	unshift(@INC, 'lib') if -d 'lib';
	164	require ExtUtils::testlib;
	165	}
	166
31bdbec1	167
85880f03	168
4633a7c4	169	sub containspod {
fb73857a	170	my($file, $readit) = @_;
	171	return 1 if !$readit && $file =~ /\.pod$/i;
	172	local($_);
	173	open(TEST,"<$file");
	174	while(<TEST>) {
	175	if(/^=head/) {
	176	close(TEST);
	177	return 1;
4633a7c4	178	}
fb73857a	179	}
	180	close(TEST);
	181	return 0;
4633a7c4	182	}
4633a7c4	183
84902520	184	sub minus_f_nocase {
5315ba28	185	my($dir,$file) = @_;
	186	my $path = join('/',$dir,$file);
	187	return $path if -f $path and -r _;
	188	if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
	189	# on a case-forgiving file system or if case is important
	190	# that is it all we can do
2d7a9237	191	warn "Ignored $file: unreadable\n" if -f _;
fb73857a	192	return '';
84902520	193	}
4633a7c4	194	local *DIR;
4633a7c4	195	local($")="/";
5315ba28	196	my @p = ($dir);
5315ba28	197	my($p,$cip);
4633a7c4	198	foreach $p (split(/\//, $file)){
fb73857a	199	my $try = "@p/$p";
	200	stat $try;
	201	if (-d _){
4633a7c4	202	push @p, $p;
fb73857a	203	if ( $p eq $global_target) {
c5ae3962	204	my $tmp_path = join ('/', @p);
fb73857a	205	my $path_f = 0;
	206	for (@global_found) {
	207	$path_f = 1 if $_ eq $tmp_path;
	208	}
	209	push (@global_found, $tmp_path) unless $path_f;
	210	print STDERR "Found as @p but directory\n" if $opt_v;
	211	}
	212	} elsif (-f _ && -r _) {
	213	return $try;
	214	} elsif (-f _) {
	215	warn "Ignored $try: unreadable\n";
4633a7c4	216	} else {
	217	my $found=0;
	218	my $lcp = lc $p;
	219	opendir DIR, "@p";
	220	while ($cip=readdir(DIR)) {
	221	if (lc $cip eq $lcp){
	222	$found++;
	223	last;
	224	}
	225	}
	226	closedir DIR;
	227	return "" unless $found;
	228	push @p, $cip;
fb73857a	229	return "@p" if -f "@p" and -r _;
fb73857a	230	warn "Ignored $file: unreadable\n" if -f _;
4633a7c4	231	}
4633a7c4	232	}
5315ba28	233	return "";
fb73857a	234	}
4633a7c4	235
fb73857a	236
fb73857a	237	sub check_file {
5315ba28	238	my($dir,$file) = @_;
3046dd9f	239	if ($opt_m) {
5315ba28	240	return minus_f_nocase($dir,$file);
3046dd9f	241	} else {
5315ba28	242	my $path = minus_f_nocase($dir,$file);
249edfdf	243	return $path if length $path and containspod($path);
3046dd9f	244	}
5315ba28	245	return "";
fb73857a	246	}
	247
	248
	249	sub searchfor {
	250	my($recurse,$s,@dirs) = @_;
	251	$s =~ s!::!/!g;
	252	$s = VMS::Filespec::unixify($s) if $Is_VMS;
	253	return $s if -f $s && containspod($s);
	254	printf STDERR "Looking for $s in @dirs\n" if $opt_v;
	255	my $ret;
	256	my $i;
	257	my $dir;
	258	$global_target = (split('/', $s))[-1];
	259	for ($i=0; $i<@dirs; $i++) {
	260	$dir = $dirs[$i];
	261	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
5315ba28	262	if ( ( $ret = check_file $dir,"$s.pod")
	263	or ( $ret = check_file $dir,"$s.pm")
	264	or ( $ret = check_file $dir,$s)
fb73857a	265	or ( $Is_VMS and
5315ba28	266	$ret = check_file $dir,"$s.com")
59586d77	267	or ( $^O eq 'os2' and
5315ba28	268	$ret = check_file $dir,"$s.cmd")
0151c6ef	269	or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
5315ba28	270	$ret = check_file $dir,"$s.bat")
	271	or ( $ret = check_file "$dir/pod","$s.pod")
	272	or ( $ret = check_file "$dir/pod",$s)
fb73857a	273	) {
	274	return $ret;
	275	}
	276
	277	if ($recurse) {
	278	opendir(D,$dir);
	279	my @newdirs = map "$dir/$_", grep {
	280	not /^\.\.?$/ and
	281	not /^auto$/ and # save time! don't search auto dirs
	282	-d "$dir/$_"
	283	} readdir D;
	284	closedir(D);
	285	next unless @newdirs;
	286	@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
	287	print STDERR "Also looking in @newdirs\n" if $opt_v;
	288	push(@dirs,@newdirs);
	289	}
	290	}
	291	return ();
	292	}
4633a7c4	293
c5ae3962	294	my @found;
4633a7c4	295	foreach (@pages) {
89b8affa	296	if ($podidx && open(PODIDX, $podidx)) {
	297	my $searchfor = $_;
	298	local($_);
	299	$searchfor =~ s,::,/,g;
	300	print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
	301	while (<PODIDX>) {
	302	chomp;
	303	push(@found, $_) if m,/$searchfor(?:\.(?:pod\|pm))?$,i;
	304	}
	305	close(PODIDX);
	306	next;
	307	}
4633a7c4	308	print STDERR "Searching for $_\n" if $opt_v;
	309	# We must look both in @INC for library modules and in PATH
	310	# for executables, like h2xs or perldoc itself.
c5ae3962	311	my @searchdirs = @INC;
cce34969	312	if ($opt_F) {
	313	next unless -r;
	314	push @found, $_ if $opt_m or containspod($_);
	315	next;
	316	}
7eda7aea	317	unless ($opt_m) {
	318	if ($Is_VMS) {
	319	my($i,$trn);
	320	for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
	321	push(@searchdirs,$trn);
	322	}
877622ba	323	push(@searchdirs,'perl_root:[lib.pod]') # installed pods
7eda7aea	324	} else {
59586d77	325	push(@searchdirs, grep(-d, split($Config{path_sep},
59586d77	326	$ENV{'PATH'})));
7eda7aea	327	}
85880f03	328	}
c5ae3962	329	my @files = searchfor(0,$_,@searchdirs);
4633a7c4	330	if( @files ) {
	331	print STDERR "Found as @files\n" if $opt_v;
	332	} else {
	333	# no match, try recursive search
	334
	335	@searchdirs = grep(!/^\.$/,@INC);
	336
5315ba28	337	@files= searchfor(1,$_,@searchdirs) if $opt_r;
4633a7c4	338	if( @files ) {
85880f03	339	print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4	340	} else {
fb73857a	341	print STDERR "No documentation found for \"$_\".\n";
	342	if (@global_found) {
	343	print STDERR "However, try\n";
c5ae3962	344	for my $dir (@global_found) {
fb73857a	345	opendir(DIR, $dir) or die "$!";
c5ae3962	346	while (my $file = readdir(DIR)) {
fb73857a	347	next if ($file =~ /^\./);
	348	$file =~ s/\.(pm\|pod)$//;
	349	print STDERR "\tperldoc $_\::$file\n";
	350	}
	351	closedir DIR;
	352	}
	353	}
4633a7c4	354	}
	355	}
	356	push(@found,@files);
	357	}
	358
	359	if(!@found) {
85880f03	360	exit ($Is_VMS ? 98962 : 1);
4633a7c4	361	}
4633a7c4	362
44a8e56a	363	if ($opt_l) {
	364	print join("\n", @found), "\n";
	365	exit;
	366	}
	367
877622ba	368	my $lines = $ENV{LINES} \|\| 24;
877622ba	369
c5ae3962	370	my $no_tty;
31bdbec1	371	if( ! -t STDOUT ) { $no_tty = 1 }
4633a7c4	372
c5ae3962	373	my $tmp;
137443ea	374	if ($Is_MSWin32) {
	375	$tmp = "$ENV{TEMP}\\perldoc1.$$";
	376	push @pagers, qw( more< less notepad );
55497cff	377	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea	378	} elsif ($Is_VMS) {
4633a7c4	379	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
55497cff	380	push @pagers, qw( most more less type/page );
0151c6ef	381	} elsif ($Is_Dos) {
	382	$tmp = "$ENV{TEMP}/perldoc1.$$";
	383	$tmp =~ tr!\\/!//!s;
	384	push @pagers, qw( less.exe more.com< );
	385	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea	386	} else {
59586d77	387	if ($^O eq 'os2') {
	388	require POSIX;
	389	$tmp = POSIX::tmpnam();
491527d0	390	unshift @pagers, 'less', 'cmd /c more <';
59586d77	391	} else {
	392	$tmp = "/tmp/perldoc1.$$";
	393	}
137443ea	394	push @pagers, qw( more less pg view cat );
137443ea	395	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4	396	}
44a8e56a	397	unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4	398
7eda7aea	399	if ($opt_m) {
c5ae3962	400	foreach my $pager (@pagers) {
1e422769	401	system("$pager @found") or exit;
	402	}
	403	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
	404	exit 1;
7eda7aea	405	}
7eda7aea	406
31bdbec1	407	if ($opt_f) {
	408	my $perlfunc = shift @found;
	409	open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
	410
	411	# Skip introduction
	412	while (<PFUNC>) {
	413	last if /^=head2 Alphabetical Listing of Perl Functions/;
	414	}
	415
	416	# Look for our function
	417	my $found = 0;
fb73857a	418	my @pod;
31bdbec1	419	while (<PFUNC>) {
31bdbec1	420	if (/^=item\s+\Q$opt_f\E\b/o) {
fb73857a	421	$found = 1;
31bdbec1	422	} elsif (/^=item/) {
fb73857a	423	last if $found > 1;
31bdbec1	424	}
fb73857a	425	next unless $found;
	426	push @pod, $_;
	427	++$found if /^\w/; # found descriptive text
31bdbec1	428	}
	429	if (@pod) {
	430	if ($opt_t) {
	431	open(FORMATTER, "\| pod2text") \|\| die "Can't start filter";
	432	print FORMATTER "=over 8\n\n";
	433	print FORMATTER @pod;
	434	print FORMATTER "=back\n";
	435	close(FORMATTER);
43051805	436	} elsif (@pod < $lines-2) {
31bdbec1	437	print @pod;
43051805	438	} else {
c5ae3962	439	foreach my $pager (@pagers) {
43051805	440	open (PAGER, "\| $pager") or next;
	441	print PAGER @pod ;
	442	close(PAGER) or next;
	443	last;
	444	}
31bdbec1	445	}
31bdbec1	446	} else {
ed5c9e50	447	die "No documentation for perl function `$opt_f' found\n";
31bdbec1	448	}
	449	exit;
	450	}
	451
a3cb178b	452	if ($opt_q) {
	453	local @ARGV = @found; # I'm lazy, sue me.
	454	my $found = 0;
	455	my %found_in;
	456	my @pod;
	457
	458	while (<>) {
	459	if (/^=head2\s+.*$opt_q/oi) {
	460	$found = 1;
	461	push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
	462	} elsif (/^=head2/) {
	463	$found = 0;
	464	}
	465	next unless $found;
	466	push @pod, $_;
	467	}
	468
	469	if (@pod) {
	470	if ($opt_t) {
	471	open(FORMATTER, "\| pod2text") \|\| die "Can't start filter";
	472	print FORMATTER "=over 8\n\n";
	473	print FORMATTER @pod;
	474	print FORMATTER "=back\n";
	475	close(FORMATTER);
877622ba	476	} elsif (@pod < $lines-2) {
a3cb178b	477	print @pod;
877622ba	478	} else {
c5ae3962	479	foreach my $pager (@pagers) {
877622ba	480	open (PAGER, "\| $pager") or next;
	481	print PAGER @pod ;
	482	close(PAGER) or next;
	483	last;
	484	}
a3cb178b	485	}
a3cb178b	486	} else {
877622ba	487	die "No documentation for perl FAQ keyword `$opt_q' found\n";
a3cb178b	488	}
	489	exit;
	490	}
	491
4633a7c4	492	foreach (@found) {
7eda7aea	493
c5ae3962	494	my $err;
85880f03	495	if($opt_t) {
	496	open(TMP,">>$tmp");
	497	Pod::Text::pod2text($_,*TMP);
	498	close(TMP);
	499	} elsif(not $opt_u) {
1e422769	500	my $cmd = "pod2man --lax $_ \| nroff -man";
1e422769	501	$cmd .= " \| col -x" if $^O =~ /hpux/;
c5ae3962	502	my $rslt = `$cmd`;
1e422769	503	unless(($err = $?)) {
	504	open(TMP,">>$tmp");
	505	print TMP $rslt;
	506	close TMP;
40fc7247	507	}
85880f03	508	}
4633a7c4	509
85880f03	510	if( $opt_u or $err or -z $tmp) {
4633a7c4	511	open(OUT,">>$tmp");
4633a7c4	512	open(IN,"<$_");
c5ae3962	513	my $cut = 1;
85880f03	514	while (<IN>) {
	515	$cut = $1 eq 'cut' if /^=(\w+)/;
	516	next if $cut;
	517	print OUT;
	518	}
4633a7c4	519	close(IN);
	520	close(OUT);
	521	}
	522	}
	523
31bdbec1	524	if( $no_tty ) {
4633a7c4	525	open(TMP,"<$tmp");
	526	print while <TMP>;
	527	close(TMP);
	528	} else {
c5ae3962	529	foreach my $pager (@pagers) {
1e422769	530	system("$pager $tmp") or last;
4633a7c4	531	}
	532	}
	533
	534	1 while unlink($tmp); #Possibly pointless VMSism
	535
	536	exit 0;
7eda7aea	537
	538	__END__
	539
	540	=head1 NAME
	541
	542	perldoc - Look up Perl documentation in pod format.
	543
	544	=head1 SYNOPSIS
	545
89b8affa	546	B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName\|ModuleName\|ProgramName
7eda7aea	547
31bdbec1	548	B<perldoc> B<-f> BuiltinFunction
31bdbec1	549
c8950503	550	B<perldoc> B<-q> FAQ Keyword
c8950503	551
7eda7aea	552	=head1 DESCRIPTION
7eda7aea	553
40fc7247	554	I<perldoc> looks up a piece of documentation in .pod format that is embedded
	555	in the perl installation tree or in a perl script, and displays it via
	556	C<pod2man \| nroff -man \| $PAGER>. (In addition, if running under HP-UX,
	557	C<col -x> will be used.) This is primarily used for the documentation for
	558	the perl library modules.
7eda7aea	559
	560	Your system may also have man pages installed for those modules, in
	561	which case you can probably just use the man(1) command.
	562
	563	=head1 OPTIONS
	564
	565	=over 5
	566
	567	=item B<-h> help
	568
	569	Prints out a brief help message.
	570
	571	=item B<-v> verbose
	572
	573	Describes search for the item in detail.
	574
	575	=item B<-t> text output
	576
	577	Display docs using plain text converter, instead of nroff. This may be faster,
	578	but it won't look as nice.
	579
	580	=item B<-u> unformatted
	581
	582	Find docs only; skip reformatting by pod2*
	583
	584	=item B<-m> module
	585
	586	Display the entire module: both code and unformatted pod documentation.
	587	This may be useful if the docs don't explain a function in the detail
	588	you need, and you'd like to inspect the code directly; perldoc will find
	589	the file for you and simply hand it off for display.
	590
44a8e56a	591	=item B<-l> file name only
	592
	593	Display the file name of the module found.
	594
cce34969	595	=item B<-F> file names
cce34969	596
89b8affa	597	Consider arguments as file names, no search in directories will be performed.
cce34969	598
31bdbec1	599	=item B<-f> perlfunc
	600
	601	The B<-f> option followed by the name of a perl built in function will
	602	extract the documentation of this function from L<perlfunc>.
	603
c8950503	604	=item B<-q> perlfaq
	605
	606	The B<-q> option takes a regular expression as an argument. It will search
	607	the question headings in perlfaq[1-9] and print the entries matching
	608	the regular expression.
	609
89b8affa	610	=item B<-X> use an index if present
	611
	612	The B<-X> option looks for a entry whose basename matches the name given on the
	613	command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
	614	contain fully qualified filenames, one per line.
	615
7eda7aea	616	=item B<PageName\|ModuleName\|ProgramName>
	617
	618	The item you want to look up. Nested modules (such as C<File::Basename>)
	619	are specified either as C<File::Basename> or C<File/Basename>. You may also
	620	give a descriptive name of a page, such as C<perlfunc>. You make also give a
	621	partial or wrong-case name, such as "basename" for "File::Basename", but
	622	this will be slower, if there is more then one page with the same partial
	623	name, you will only get the first one.
	624
	625	=back
	626
	627	=head1 ENVIRONMENT
	628
	629	Any switches in the C<PERLDOC> environment variable will be used before the
	630	command line arguments. C<perldoc> also searches directories
	631	specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
	632	defined) and C<PATH> environment variables.
	633	(The latter is so that embedded pods for executables, such as
a3cb178b	634	C<perldoc> itself, are available.) C<perldoc> will use, in order of
	635	preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
	636	C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
	637	used if C<perldoc> was told to display plain text or unformatted pod.)
7eda7aea	638
	639	=head1 AUTHOR
	640
	641	Kenneth Albanowski <kjahds@kjahds.com>
	642
	643	Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
	644
7eda7aea	645	=cut
	646
	647	#
c5ae3962	648	# Version 1.14: Wed Jul 15 01:50:20 EST 1998
	649	# Robin Barker <rmb1@cise.npl.co.uk>
	650	# -strict, -w cleanups
89b8affa	651	# Version 1.13: Fri Feb 27 16:20:50 EST 1997
	652	# Gurusamy Sarathy <gsar@umich.edu>
	653	# -doc tweaks for -F and -X options
137443ea	654	# Version 1.12: Sat Apr 12 22:41:09 EST 1997
	655	# Gurusamy Sarathy <gsar@umich.edu>
	656	# -various fixes for win32
7eda7aea	657	# Version 1.11: Tue Dec 26 09:54:33 EST 1995
	658	# Kenneth Albanowski <kjahds@kjahds.com>
	659	# -added Charles Bailey's further VMS patches, and -u switch
	660	# -added -t switch, with pod2text support
	661	#
	662	# Version 1.10: Thu Nov 9 07:23:47 EST 1995
	663	# Kenneth Albanowski <kjahds@kjahds.com>
	664	# -added VMS support
	665	# -added better error recognition (on no found pages, just exit. On
	666	# missing nroff/pod2man, just display raw pod.)
	667	# -added recursive/case-insensitive matching (thanks, Andreas). This
	668	# slows things down a bit, unfortunately. Give a precise name, and
	669	# it'll run faster.
	670	#
	671	# Version 1.01: Tue May 30 14:47:34 EDT 1995
	672	# Andy Dougherty <doughera@lafcol.lafayette.edu>
	673	# -added pod documentation.
	674	# -added PATH searching.
	675	# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
	676	# and friends.
	677	#
	678	#
	679	# TODO:
	680	#
	681	# Cache directories read during sloppy match
4633a7c4	682	!NO!SUBS!
	683
	684	close OUT or die "Can't close $file: $!";
	685	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	686	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1	687	chdir $origdir;