package WebGUI::Operation::Help; #------------------------------------------------------------------- # WebGUI is Copyright 2001-2009 Plain Black Corporation. #------------------------------------------------------------------- # Please read the legal notices (docs/legal.txt) and the license # (docs/license.txt) that came with this distribution before using # this software. #------------------------------------------------------------------- # http://www.plainblack.com info@plainblack.com #------------------------------------------------------------------- use strict qw(vars subs); use Tie::IxHash; use WebGUI::AdminConsole; use WebGUI::International; use WebGUI::Asset::Template; use WebGUI::Macro; use WebGUI::Utility; use WebGUI::TabForm; =head1 NAME Package WebGUI::Operation::Help =head1 DESCRIPTION Handles displaying WebGUI's internal help to the user as an operation. =cut #------------------------------------------------------------------- =head2 _loadHelp ( $session, $helpPackage ) Safely load's the Help file for the requested helpPackage if it hasn't been already and logs errors during the load. =cut sub _loadHelp { my $session = shift; my $helpPackage = shift; eval { WebGUI::Pluggable::load( $helpPackage ); }; if ($@) { $session->errorHandler->error("Help failed to compile: $helpPackage. ".$@); return {}; } if (defined *{"$helpPackage\::HELP"}) { ##Symbol table lookup our $table; *table = *{"$helpPackage\::HELP"}; ##Create alias into symbol table return $table; ##return whole hashref } } #------------------------------------------------------------------- =head2 _processVariables ( $helpVar, $namespace ) Recursively descend down any nested template variables and give them default namespaces. Also, handle copying the variables entry. =cut sub _processVar { my ($helpVar, $namespace) = @_; my $processed = {}; $processed->{name} = $helpVar->{name}, $processed->{description} = $helpVar->{description}, $processed->{namespace} = $helpVar->{namespace} || $namespace; if ($helpVar->{variables}) { foreach my $helpVariable (@{ $helpVar->{variables} }) { push @{ $processed->{variables} }, _processVar($helpVariable, $namespace); } } return $processed; } #------------------------------------------------------------------- =head2 _process ( $session, $cmd, $key ) Do almost all the post processing for an entry in a freshly loaded help file. Resolve the related key, add a default isa key if it is missing, and set the __PROCESSED flag to prevent processing entries twice. =cut sub _process { my ($session, $helpEntry, $key) = @_; return undef if exists($helpEntry->{__PROCESSED}) and $helpEntry->{__PROCESSED}; $helpEntry->{related} = [ _related($session, $helpEntry->{related}) ]; ##Add an ISA link unless it already exists. ##This simplifies handling later. unless (exists $helpEntry->{isa} and ref $helpEntry->{isa} eq 'ARRAY') { $helpEntry->{isa} = []; } unless (exists $helpEntry->{__PROCESSED}) { $helpEntry->{__PROCESSED} = 0; } foreach my $isa ( @{ $helpEntry->{isa} } ) { my $oCmd = "WebGUI::Help::".$isa->{namespace}; my $other = _loadHelp($session, $oCmd); my $otherHelp = $other->{ $isa->{tag} }; _process($session, $otherHelp, $isa->{tag}); my $add = $otherHelp->{fields}; @{$helpEntry->{fields}} = (@{$helpEntry->{fields}}, @{$add}); $add = $otherHelp->{related}; @{$helpEntry->{related}} = (@{ $helpEntry->{related} }, @{ $add }); $add = $otherHelp->{variables}; foreach my $row (@{$add}) { push(@{$helpEntry->{variables}}, _processVar($row, $isa->{namespace})); } } $helpEntry->{__PROCESSED} = 1; } #------------------------------------------------------------------- =head2 _load ( $session, $namespace ) Safely load's the Help file for the requested namespace and logs errors during the load. =cut sub _load { my $session = shift; my $namespace = shift; my $cmd = "WebGUI::Help::".$namespace; my $help = _loadHelp($session, $cmd); foreach my $tag (keys %{ $help }) { _process($session, $help->{$tag}, $tag); } return $help; } #------------------------------------------------------------------- =head2 _get ( $session, $id, $namespace ) Safely load's the Help file for the requested namespace and returns the specified id (help key). =cut sub _get { my $session = shift; my $id = shift; my $namespace = shift; my $help = _load($session,$namespace); if (keys %{ $help } ) { return $help->{$id}; } else { $session->errorHandler->warn("Unable to load help for $namespace -> $id"); return undef; } } #------------------------------------------------------------------- =head2 _link ( $session, $id, $namespace ) Utility routine for formatting a link for returning a help entry in the requested namespace. =cut sub _link { my $session = shift; return $session->url->page('op=viewHelp;hid='.$session->url->escape($_[0]).';namespace='.$_[1]); } #------------------------------------------------------------------- =head2 _linkTOC ( $session, $namespace ) Utility routine for formatting a link for returning a table of contents entry for a Help namespace. =cut sub _linkTOC { my $session = shift; return $session->url->page('op=viewHelpChapter;namespace='.$_[0]); } #------------------------------------------------------------------- =head2 _getHelpFilesList ( $session ) Utility routine for returning a list of all Help files in the lib/WebGUI/Help folder. =cut sub _getHelpFilesList { my $session = shift; my $dir = join '/', $session->config->getWebguiRoot,"lib","WebGUI","Help"; opendir (DIR,$dir) or $session->errorHandler->fatal("Can't open Help directory!"); my @files; foreach my $file (readdir DIR) { next unless $file =~ /.pm$/; my $modName; ($modName = $file) =~ s/\.pm$//; push @files, [ $file, $modName ]; } closedir(DIR); return @files; } #------------------------------------------------------------------- =head2 _related ( $session, $related ) Utility routine for returning a list of topics related the the current help entry. =head3 $related A scalar ref to either an array ref, which will be dereferenced to return a list, or a code ref, which will be executed and should return a list. =cut sub _related { my ($session, $related) = @_; if (ref $related eq 'CODE') { return $related->($session); } else { return @{ $related }; } } #------------------------------------------------------------------- =head2 _columnar ( $columns, $list ) Utility routine for taking a list of data and returning it multiple columns. =head3 $columns The number of columns to create. =head3 $list A scalar ref to the array of data that will be broken into columns. =cut sub _columnar { my ($columns, $list) = @_; my @entries = @{ $list }; my $fraction = round(@entries/$columns + 0.50); my $output = '
| '; my $halfway = round(@helpIndex / 2); my $i = 0; @helpIndex = sort { $a->[2] cmp $b->[2] } @helpIndex; foreach my $helpEntry (@helpIndex) { my ($namespace, $id, $title) = @{ $helpEntry }; $output .= ''; $i++; if ($i == $halfway) { $output .= ' | '; } } $output .= ' |