# @(#)$Id: Help.pm 1139 2012-03-28 23:49:18Z pjf $

package CatalystX::Usul::Model::Help;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.5.%d', q$Rev: 1139 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul::Model CatalystX::Usul::Email);

use CatalystX::Usul::Constants;
use CatalystX::Usul::Functions qw(distname merge_attributes);
use CatalystX::Usul::Table;
use CatalystX::Usul::Time;
use Time::Elapsed qw(elapsed);
use MRO::Compat;

__PACKAGE__->config( cpan_dist_uri => q(http://search.cpan.org/dist/),
                     default_css   => NUL,
                     name          => NUL, );

__PACKAGE__->mk_accessors( qw(cpan_dist_uri default_css name) );

sub COMPONENT {
   my ($class, $app, $attrs) = @_; my $ac = $app->config;

   merge_attributes $attrs, $ac, $class->config, [ qw(default_css name) ];

   return $class->next::method( $app, $attrs );
}

sub about_form {
   my $self = shift; my $s = $self->context->stash;

   $s->{title} = $s->{header}->{title} = $self->loc( 'About' );
   return;
}

sub add_debug_info {
   my ($self, $prefix) = @_; my $c = $self->context; my $s = $c->stash;

   my $cfg = $c->config; my $data = $s->{user}.q(@).$s->{host_port};

   $s->{tip_title} = $self->loc( 'Debug Info' );
   $self->_add_template_data( $prefix, $data, q(yourIdentity) );

   # Useful numbers and such
   $cfg->{version} and $self->_add_template_data( $prefix, $cfg->{version},
                                                  q(moduleVersion) );

   defined $s->{version} and $self->_add_template_data( $prefix, $s->{version},
                                                        q(levelVersion) );

   $self->_add_template_data( $prefix, time2str(), q(pageGenerated) );

   $s->{elapsed} and $self->_add_template_data( $prefix,
                                                elapsed( $s->{elapsed} ),
                                                q(elapsedTime) );

   $self->_add_template_data( $prefix, $s->{user_agent}->name, 'User agent' );
   $data = $s->{user_agent}->version;
   $self->_add_template_data( $prefix, $data, 'User agent version' );
}

sub add_footer {
   my $self = shift; my $s = $self->context->stash; my $prefix = q(footer);

   $self->add_select_language( $prefix );
   $s->{debug} and $self->add_debug_info( $prefix );
   $self->add_field ( {
      container => FALSE, name => $prefix, type => q(template), } );
   $self->stash_meta( { id => $prefix.q(.data) } );
   return;
}

sub add_select_language {
   my ($self, $prefix) = @_; my $c = $self->context; my $s = $c->stash;

   my $cfg = $c->config; my @languages = split SPC, $cfg->{languages} || LANG;

   my ($classes, $labels) = ({}, {}); my $name = q(select_language);

   for my $lang (@languages) {
      $classes->{ $lang } = q(flag_).$lang;
      $labels->{ $lang } = $self->loc( q(lang_).$lang );
   }

   $self->add_field( { classes => $classes,
                       default => $s->{lang},
                       id      => $prefix.q(.).$name,
                       labels  => $labels,
                       values  => \@languages } );
   $self->add_field( { default => $self->query_value( q(val) ),
                       name    => q(referer),
                       type    => q(hidden) } );

   my $action = $c->uri_for_action( SEP.$name );

   $self->form_wrapper( { action => $action, name => $name } );
   return;
}

sub documentation {
   my ($self, $path) = @_; my $uri = $self->context->uri_for( $path );

   $self->add_field( { path => $uri, subtype => q(html), type => q(file) } );
   return;
}

sub feedback_form {
   my ($self, @rest) = @_;
   my $nbsp          = NBSP;
   my $s             = $self->context->stash;
   my $subject       = $self->query_value( q(subject) );
   my $form          = $s->{form}->{name};

   $subject ||= $self->loc( $form.q(.subject), $self->name, join SEP, @rest );
   ($s->{html_subject} = $subject) =~ s{ \s+ }{$nbsp}gmx;

   $self->clear_form ( { firstfld => $form.q(.body),
                         title    => $self->loc( $form.q(.title) ) } );
   $self->add_field  ( { id       => $form.q(.body) } );
   $self->add_hidden ( q(subject), $subject );
   $self->add_buttons( qw(Send) );
   return;
}

sub feedback_send {
   my $self    = shift;
   my $s       = $self->context->stash;
   my $subject = $self->query_value( q(subject) ) || $self->name.' feedback';
   my $post    = { attributes  => { charset      => $s->{encoding},
                                    content_type => q(text/html) },
                   body        => $self->query_value( q(body) ) || NUL,
                   from        => $s->{user_email},
                   mailer      => $s->{mailer},
                   mailer_host => $s->{mailer_host},
                   subject     => $subject,
                   to          => $s->{feedback_email} };

   $self->add_result( $self->send_email( $post ) );
   return TRUE;
}

sub module_docs {
   my ($self, $module, $name) = @_; my $c = $self->context; my $s = $c->stash;

   $module ||= $self->name; $name ||= $module;

   my $src   = $self->find_source( $module )
      or return $self->add_error_msg( 'Module [_1] not found', $module );
   my $url   = $c->uri_for_action( $c->config->{module_docs}, '%s' );
   my $help  = $self->loc( 'Help' );
   my $title = $name.SPC.$help;
   my $nav   = $s->{nav_model};

   $nav->clear_controls; $nav->add_menu_close;

   $s->{title     } = $s->{application}.SPC.$help;
   $s->{page_title} = $title.q( - ).$s->{application}.SPC.$s->{platform};

   $self->clear_form( { title => $s->{title} } );
   $self->add_field ( { src   => $src,
                        title => $title,
                        type  => q(POD),
                        url   => $url, } );
   return;
}

sub module_list {
   my $self = shift; my $c = $self->context; my $s = $c->stash; my $name;

   # TODO: Switch to using Module::Versions
   # Otherwise lots from modules that don't set VERSION
   no warnings; ## no critic

   my $count = 0;
   my $docs  = $c->action->namespace.SEP.q(module_docs);
   my $table = __get_module_table();

   for my $path (sort keys %INC) {
      $path =~ m{ \A [/] }mx and next;

      ($name = $path) =~ s{ [/] }{::}gmx; $name =~ s{ \.pm }{}gmx;

      my $c_uri = $self->cpan_dist_uri.(distname $name);
      my $h_uri = $c->uri_for_action( $docs, $name );
      my $s_uri = $c->uri_for_action( SEP.q(view_source), $name );
      my $flds  = {};

      $flds->{name   } = $name;
      $flds->{cpan   } = __make_icon( 'CPAN',           q(link_icon), $c_uri );
      $flds->{help   } = __make_icon( 'Doucumentation', q(help_icon), $h_uri );
      $flds->{source } = __make_icon( 'View Source',    q(file_icon), $s_uri );
      $flds->{version} = eval { $name->VERSION() };

      push @{ $table->values }, $flds; $count++;
   }

   $table->count( $count );
   $self->add_field( { data => $table, number_rows => TRUE, type => q(table) });
   $self->group_fields( { id => q(module_list.select) } );
   return;
}

sub overview {
   my $self = shift;

   $self->add_field ( { id => q(overview) } );
   $self->stash_meta( { id => q(overview) } );
   return;
}

# Private methods

sub _add_template_data {
   my ($self, $name, $data, $alt) = @_; my $s = $self->context->stash;

   my $key = "template_data_${name}";
   my $tip = ($s->{tip_title} || DOTS).TTS.$self->loc( $alt || 'None' );

   $s->{ $key } ||= []; push @{ $s->{ $key } }, { text => $data, tip => $tip };
   return;
}

# Private subroutines

sub __get_module_table {
   return CatalystX::Usul::Table->new
      ( class    => { cpan    => q(icons),
                      help    => q(icons),
                      name    => q(data_value),
                      source  => q(icons),
                      version => q(data_value), },
        flds     => [ qw(source help cpan name version) ],
        hclass   => { cpan    => q(minimal),
                      help    => q(minimal),
                      name    => q(most),
                      source  => q(minimal),
                      version => q(some) },
        labels   => { cpan    => 'CPAN',
                      help    => 'Help',
                      name    => 'Module Name',
                      source  => 'Source',
                      version => 'Version' },
        typelist => { version => q(numeric), } );
}

sub __make_icon {
   my ($alt, $imgclass, $href) = @_;

   return { class     => q(icon),
            container => FALSE,
            href      => $href,
            imgclass  => $imgclass,
            sep       => NUL,
            target    => q(documentation),
            text      => NUL,
            tip       => $alt,
            type      => q(anchor),
            widget    => TRUE };
}

1;

__END__

=pod

=head1 Name

CatalystX::Usul::Model::Help - Provides data for help pages

=head1 Version

0.5.$Revision: 1139 $

=head1 Synopsis

   package MyApp::Model::Help;

   use base qw(CatalystX::Usul::Model::Help);

   1;

   package MyApp::Controller::Foo;

   sub bar {
      my ($self, $c) = @_;

      $c->model( q(Help) )->get_help( $c->stash, q(Foo) );
   }

=head1 Description

Provides context sensitive help. Help text comes from running
L<Pod::Html> on the controller source

=head1 Subroutines/Methods

=head2 COMPONENT

Constructor sets attributes for: default CSS filename and the
application name from the application config

=head2 about_form

Provides information about the application. Content is implemented in a
template

=head2 add_debug_info

Adds some useful information to the footer if debug is turned on

=head2 add_footer

Calls L</add_debug_info> and L</add_select_language>

=head2 add_select_language

Adds a form containing a popup menu that allows the user to select from
the list of supported languages. Called from L</add_footer>

=head2 documentation

   $self->model( q(Help) )->documentation( $uri );

Adds a file type field to the form. Displays as an I<iframe>
containing the HTML document referenced by C<$uri>

=head2 feedback_form

Adds the fields and button data to the stash for the user feedback form

=head2 feedback_send

Sends an email to the site administrators

=head2 get_help

Add a field of type I<POD>

=head2 module_docs

Extract the POD for a given module and renders it as HTML

=head2 module_list

Generates the data for a table that shows all the modules the application
is using. Links allow the source code and the POD to be viewed

=head2 overview

Generate the data for an XML response to a Javascript C<XMLHttpRequest()>

=head1 Diagnostics

None

=head1 Configuration and Environment

None

=head1 Dependencies

=over 3

=item L<CatalystX::Usul::Model>

=item L<CatalystX::Usul::Table>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome

=head1 Author

Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>

=head1 License and Copyright

Copyright (c) 2008 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End: