The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Padre::Help::PIR;
BEGIN {
  $Padre::Help::PIR::VERSION = '0.31';
}

# ABSTRACT: PIR Help Provider

use 5.008;
use strict;
use warnings;

use Cwd ();
use Padre::Logger;
use Padre::Help            ();
use Padre::Pod2HTML        ();
use Padre::Util            ();

our @ISA     = 'Padre::Help';

#
# Initialize help
#
sub help_init {
	my $self = shift;

	# TODO factor out and stop requireing PARROT_DIR
	return if not $ENV{PARROT_DIR};

	# TODO what is the difference between docs/book/pir and docs/ops ?
	my $dir = "$ENV{PARROT_DIR}/docs/ops";

	my %index;

	#foreach my $file ('io.pod') {
	#my $path = "$dir/$file";
	foreach my $path ("$ENV{PARROT_DIR}/docs/pdds/pdd19_pir.pod") {
		open my $fh, '<', $path;
		if ( !$fh ) {
			warn "Could not open $path $!";
			next;
		}
		my %item;
		my $cnt = 0;
		my $topic;
		while ( my $line = <$fh> ) {
			$cnt++;
			if ( $line =~ /=item\s+(\.\w+)/ ) {
				if ($topic) {
					TRACE($topic) if DEBUG;
					$item{end} = $cnt - 1;
					push @{ $index{$topic} }, {%item};
				}
				$topic = $1;
				%item = ( start => $cnt, file => $path );
				next;
			}
			if ( $line =~ /^=/ and $topic ) {
				$item{end} = $cnt - 1;
				push @{ $index{$topic} }, {%item};
				$topic = undef;
				%item  = ();
				next;
			}
		}
	}
	foreach my $path ( glob "$dir/*.pod" ) {
		if ( open my $fh, '<', $path ) {
			my %item;
			my $cnt = 0;
			my $topic;
			while ( my $line = <$fh> ) {
				$cnt++;
				if ( $line =~ /=item\s+B<(\w+)>/ ) {
					if ($topic) {
						TRACE($topic) if DEBUG;
						$item{end} = $cnt - 1;
						push @{ $index{$topic} }, {%item};
					}
					$topic = $1;
					%item = ( start => $cnt, file => $path );
					next;
				}
				if ( $line =~ /^=/ and $topic ) {
					$item{end} = $cnt - 1;
					push @{ $index{$topic} }, {%item};
					$topic = undef;
					%item  = ();
					next;
				}
			}
		} else {
			warn "Could not open '$path': $!";
		}
	}

	$self->{pir} = \%index;
}


#
# Renders the help topic content into XHTML
#
sub help_render {
	my ( $self, $topic ) = @_;
	my ( $html, $location );

	TRACE("render '$topic'") if DEBUG;

	#use Data::Dumper;
	#TRACE(Dumper $self->{pir}) if DEBUG;
	return if not $self->{pir}->{$topic};
	my $pod;

	# TODO read the files only once!?
	foreach my $x ( @{ $self->{pir}->{$topic} } ) {
		if ( open my $fh, '<', $x->{file} ) {
			my @lines = <$fh>;
			$pod .= join '', @lines[ $x->{start} .. $x->{end} ];
		}
	}
	TRACE($pod) if DEBUG;
	$html = Padre::Pod2HTML->pod2html($pod);
	TRACE($html) if DEBUG;

	return ( $html, $location || $topic );
}

#
# Returns the help topic list
#
sub help_list {
	my $self = shift;
	return [ sort keys %{ $self->{pir} } ];
}

1;



=pod

=head1 NAME

Padre::Help::PIR - PIR Help Provider

=head1 VERSION

version 0.31

=head1 DESCRIPTION

PIR Help index is built here and rendered.

=head1 AUTHORS

=over 4

=item *

Gabor Szabo L<http://szabgab.com/>

=item *

Ahmad M. Zawawi <ahmad.zawawi@gmail.com>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by Gabor Szabo.

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

=cut


__END__