package Pod::Perldoc::GetOptsOO;
use strict;

use vars qw($VERSION);
$VERSION = '3.28';

BEGIN { # Make a DEBUG constant ASAP
  *DEBUG = defined( &Pod::Perldoc::DEBUG )
   ? \&Pod::Perldoc::DEBUG
   : sub(){10};
}


sub getopts {
  my($target, $args, $truth) = @_;

  $args ||= \@ARGV;

  $target->aside(
    "Starting switch processing.  Scanning arguments [@$args]\n"
  ) if $target->can('aside');

  return unless @$args;

  $truth = 1 unless @_ > 2;

  DEBUG > 3 and print "   Truth is $truth\n";


  my $error_count = 0;

  while( @$args  and  ($_ = $args->[0]) =~ m/^-(.)(.*)/s ) {
    my($first,$rest) = ($1,$2);
    if ($_ eq '--') {	# early exit if "--"
      shift @$args;
      last;
    }
    if ($first eq '-' and $rest) {      # GNU style long param names
      ($first, $rest) = split '=', $rest, 2;
    }
    my $method = "opt_${first}_with";
    if( $target->can($method) ) {  # it's argumental
      if($rest eq '') {   # like -f bar
        shift @$args;
        $target->warn( "Option $first needs a following argument!\n" ) unless @$args;
        $rest = shift @$args;
      } else {            # like -fbar  (== -f bar)
        shift @$args;
      }

      DEBUG > 3 and print " $method => $rest\n";
      $target->$method( $rest );

    # Otherwise, it's not argumental...
    } else {

      if( $target->can( $method = "opt_$first" ) ) {
        DEBUG > 3 and print " $method is true ($truth)\n";
        $target->$method( $truth );

      # Otherwise it's an unknown option...

      } elsif( $target->can('handle_unknown_option') ) {
        DEBUG > 3
         and print " calling handle_unknown_option('$first')\n";

        $error_count += (
          $target->handle_unknown_option( $first ) || 0
        );

      } else {
        ++$error_count;
        $target->warn( "Unknown option: $first\n" );
      }

      if($rest eq '') {   # like -f
        shift @$args
      } else {            # like -fbar  (== -f -bar )
        DEBUG > 2 and print "   Setting args->[0] to \"-$rest\"\n";
        $args->[0] = "-$rest";
      }
    }
  }


  $target->aside(
    "Ending switch processing.  Args are [@$args] with $error_count errors.\n"
  ) if $target->can('aside');

  $error_count == 0;
}

1;

__END__

=head1 NAME

Pod::Perldoc::GetOptsOO - Customized option parser for Pod::Perldoc

=head1 SYNOPSIS

    use Pod::Perldoc::GetOptsOO ();

    Pod::Perldoc::GetOptsOO::getopts( $obj, \@args, $truth )
       or die "wrong usage";


=head1 DESCRIPTION

Implements a customized option parser used for
L<Pod::Perldoc>.

Rather like Getopt::Std's getopts:

=over

=item Call Pod::Perldoc::GetOptsOO::getopts($object, \@ARGV, $truth)

=item Given -n, if there's a opt_n_with, it'll call $object->opt_n_with( ARGUMENT )
   (e.g., "-n foo" => $object->opt_n_with('foo').  Ditto "-nfoo")

=item Otherwise (given -n) if there's an opt_n, we'll call it $object->opt_n($truth)
   (Truth defaults to 1)

=item Otherwise we try calling $object->handle_unknown_option('n')
   (and we increment the error count by the return value of it)

=item If there's no handle_unknown_option, then we just warn, and then increment
   the error counter

=back

The return value of Pod::Perldoc::GetOptsOO::getopts is true if no errors,
otherwise it's false.

=head1 SEE ALSO

L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002-2007 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallen@cpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>

=cut
package Pod::Perldoc::ToChecker;
use strict;
use warnings;
use vars qw(@ISA);

use vars qw($VERSION);
$VERSION = '3.28';

# Pick our superclass...
#
eval 'require Pod::Simple::Checker';
if($@) {
  require Pod::Checker;
  @ISA = ('Pod::Checker');
} else {
  @ISA = ('Pod::Simple::Checker');
}

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' }

sub if_zero_length {
  my( $self, $file, $tmp, $tmpfd ) = @_;
  print "No Pod errors in $file\n";
}


1;

__END__

=head1 NAME

Pod::Perldoc::ToChecker - let Perldoc check Pod for errors

=head1 SYNOPSIS

  % perldoc -o checker SomeFile.pod
  No Pod errors in SomeFile.pod
  (or an error report)

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Simple::Checker as a "formatter" class (or if that is
not available, then Pod::Checker), to check for errors in a given
Pod file.

This is actually a Pod::Simple::Checker (or Pod::Checker) subclass, and
inherits all its options.

=head1 SEE ALSO

L<Pod::Simple::Checker>, L<Pod::Simple>, L<Pod::Checker>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallen@cpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>

=cut

package Pod::Perldoc::ToNroff;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);

use vars qw($VERSION);
$VERSION = '3.28';

# This is unlike ToMan.pm in that it emits the raw nroff source!

sub is_pageable        { 1 }  # well, if you ask for it...
sub write_with_binmode { 0 }
sub output_extension   { 'man' }

use Pod::Man ();

sub center          { shift->_perldoc_elem('center'         , @_) }
sub date            { shift->_perldoc_elem('date'           , @_) }
sub fixed           { shift->_perldoc_elem('fixed'          , @_) }
sub fixedbold       { shift->_perldoc_elem('fixedbold'      , @_) }
sub fixeditalic     { shift->_perldoc_elem('fixeditalic'    , @_) }
sub fixedbolditalic { shift->_perldoc_elem('fixedbolditalic', @_) }
sub quotes          { shift->_perldoc_elem('quotes'         , @_) }
sub release         { shift->_perldoc_elem('release'        , @_) }
sub section         { shift->_perldoc_elem('section'        , @_) }

sub new { return bless {}, ref($_[0]) || $_[0] }

sub parse_from_file {
  my $self = shift;
  my $file = $_[0];

  my @options =
    map {; $_, $self->{$_} }
      grep !m/^_/s,
        keys %$self
  ;

  defined(&Pod::Perldoc::DEBUG)
   and Pod::Perldoc::DEBUG()
   and print "About to call new Pod::Man ",
    $Pod::Man::VERSION ? "(v$Pod::Man::VERSION) " : '',
    "with options: ",
    @options ? "[@options]" : "(nil)", "\n";
  ;

  Pod::Man->new(@options)->parse_from_file(@_);
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToNroff - let Perldoc convert Pod to nroff

=head1 SYNOPSIS

  perldoc -o nroff -d something.3 Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Man as a formatter class.

The following options are supported:  center, date, fixed, fixedbold,
fixeditalic, fixedbolditalic, quotes, release, section

Those options are explained in L<Pod::Man>.

For example:

  perldoc -o nroff -w center:Pod -d something.3 Some::Modulename

=head1 CAVEAT

This module may change to use a different pod-to-nroff formatter class
in the future, and this may change what options are supported.

=head1 SEE ALSO

L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToMan>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallen@cpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>

=cut

package Pod::Perldoc::ToPod;
use strict;
use warnings;
use parent qw(Pod::Perldoc::BaseTo);

use vars qw($VERSION);
$VERSION = '3.28';

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'pod' }

sub new { return bless {}, ref($_[0]) || $_[0] }

sub parse_from_file {
  my( $self, $in, $outfh ) = @_;

  open(IN, "<", $in) or $self->die( "Can't read-open $in: $!\nAborting" );

  my $cut_mode = 1;

  # A hack for finding things between =foo and =cut, inclusive
  local $_;
  while (<IN>) {
    if(  m/^=(\w+)/s ) {
      if($cut_mode = ($1 eq 'cut')) {
        print $outfh "\n=cut\n\n";
         # Pass thru the =cut line with some harmless
         #  (and occasionally helpful) padding
      }
    }
    next if $cut_mode;
    print $outfh $_ or $self->die( "Can't print to $outfh: $!" );
  }

  close IN or $self->die( "Can't close $in: $!" );
  return;
}

1;
__END__

=head1 NAME

Pod::Perldoc::ToPod - let Perldoc render Pod as ... Pod!

=head1 SYNOPSIS

  perldoc -opod Some::Modulename

(That's currently the same as the following:)

  perldoc -u Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to display Pod source as
itself!  Pretty Zen, huh?

Currently this class works by just filtering out the non-Pod stuff from
a given input file.

=head1 SEE ALSO

L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallencpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>

=cut

package Pod::Perldoc::BaseTo;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '3.28';

use Carp                  qw(croak carp);
use Config                qw(%Config);
use File::Spec::Functions qw(catfile);

sub is_pageable        { '' }
sub write_with_binmode {  1 }

sub output_extension   { 'txt' }  # override in subclass!

# sub new { my $self = shift; ...  }
# sub parse_from_file( my($class, $in, $out) = ...; ... }

#sub new { return bless {}, ref($_[0]) || $_[0] }

# this is also in Perldoc.pm, but why look there when you're a
# subclass of this?
sub TRUE  () {1}
sub FALSE () {return}

BEGIN {
 *is_vms     = $^O eq 'VMS'      ? \&TRUE : \&FALSE unless defined &is_vms;
 *is_mswin32 = $^O eq 'MSWin32'  ? \&TRUE : \&FALSE unless defined &is_mswin32;
 *is_dos     = $^O eq 'dos'      ? \&TRUE : \&FALSE unless defined &is_dos;
 *is_os2     = $^O eq 'os2'      ? \&TRUE : \&FALSE unless defined &is_os2;
 *is_cygwin  = $^O eq 'cygwin'   ? \&TRUE : \&FALSE unless defined &is_cygwin;
 *is_linux   = $^O eq 'linux'    ? \&TRUE : \&FALSE unless defined &is_linux;
 *is_hpux    = $^O =~ m/hpux/    ? \&TRUE : \&FALSE unless defined &is_hpux;
 *is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd;
 *is_freebsd = $^O =~ m/freebsd/ ? \&TRUE : \&FALSE unless defined &is_freebsd;
 *is_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig;
}

sub _perldoc_elem {
  my($self, $name) = splice @_,0,2;
  if(@_) {
    $self->{$name} = $_[0];
  } else {
    $self->{$name};
  }
}

sub debugging {
	my( $self, @messages ) = @_;

    ( defined(&Pod::Perldoc::DEBUG) and &Pod::Perldoc::DEBUG() )
	}

sub debug {
	my( $self, @messages ) = @_;
	return unless $self->debugging;
	print STDERR map { "DEBUG $_" } @messages;
	}

sub warn {
	my( $self, @messages ) = @_;
	carp join "\n", @messages, '';
	}

sub die {
	my( $self, @messages ) = @_;
	croak join "\n", @messages, '';
	}

sub _get_path_components {
	my( $self ) = @_;

	my @paths = split /\Q$Config{path_sep}/, $ENV{PATH};

	return @paths;
	}

sub _find_executable_in_path {
	my( $self, $program ) = @_;

	my @found = ();
	foreach my $dir ( $self->_get_path_components ) {
		my $binary = catfile( $dir, $program );
		$self->debug( "Looking for $binary\n" );
		next unless -e $binary;
		unless( -x $binary ) {
			$self->warn( "Found $binary but it's not executable. Skipping.\n" );
			next;
			}
		$self->debug( "Found $binary\n" );
		push @found, $binary;
		}

	return @found;
	}

1;

__END__

=head1 NAME

Pod::Perldoc::BaseTo - Base for Pod::Perldoc formatters

=head1 SYNOPSIS

    package Pod::Perldoc::ToMyFormat;

    use parent qw( Pod::Perldoc::BaseTo );
    ...

=head1 DESCRIPTION

This package is meant as a base of Pod::Perldoc formatters,
like L<Pod::Perldoc::ToText>, L<Pod::Perldoc::ToMan>, etc.

It provides default implementations for the methods

    is_pageable
    write_with_binmode
    output_extension
    _perldoc_elem

The concrete formatter must implement

    new
    parse_from_file

=head1 SEE ALSO

L<perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002-2007 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallen@cpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>

=cut
package Pod::Perldoc::ToText;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '3.28';

use parent qw(Pod::Perldoc::BaseTo);

sub is_pageable        { 1 }
sub write_with_binmode { 0 }
sub output_extension   { 'txt' }

use Pod::Text ();

sub alt       { shift->_perldoc_elem('alt'     , @_) }
sub indent    { shift->_perldoc_elem('indent'  , @_) }
sub loose     { shift->_perldoc_elem('loose'   , @_) }
sub quotes    { shift->_perldoc_elem('quotes'  , @_) }
sub sentence  { shift->_perldoc_elem('sentence', @_) }
sub width     { shift->_perldoc_elem('width'   , @_) }

sub new { return bless {}, ref($_[0]) || $_[0] }

sub parse_from_file {
  my $self = shift;

  my @options =
    map {; $_, $self->{$_} }
      grep !m/^_/s,
        keys %$self
  ;

  defined(&Pod::Perldoc::DEBUG)
   and Pod::Perldoc::DEBUG()
   and print "About to call new Pod::Text ",
    $Pod::Text::VERSION ? "(v$Pod::Text::VERSION) " : '',
    "with options: ",
    @options ? "[@options]" : "(nil)", "\n";
  ;

  Pod::Text->new(@options)->parse_from_file(@_);
}

1;

=head1 NAME

Pod::Perldoc::ToText - let Perldoc render Pod as plaintext

=head1 SYNOPSIS

  perldoc -o text Some::Modulename

=head1 DESCRIPTION

This is a "plug-in" class that allows Perldoc to use
Pod::Text as a formatter class.

It supports the following options, which are explained in
L<Pod::Text>: alt, indent, loose, quotes, sentence, width

For example:

  perldoc -o text -w indent:5 Some::Modulename

=head1 CAVEAT

This module may change to use a different text formatter class in the
future, and this may change what options are supported.

=head1 SEE ALSO

L<Pod::Text>, L<Pod::Perldoc>

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.  All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Current maintainer: Mark Allen C<< <mallen@cpan.org> >>

Past contributions from:
brian d foy C<< <bdfoy@cpan.org> >>
Adriano R. Ferreira C<< <ferreira@cpan.org> >>,
Sean M. Burke C<< <sburke@cpan.org> >>


=cut