[Openinteract-commits] CVS: OpenInteract2/pkg/system_doc/OpenInteract2/Action SystemDoc.pm,1.15,1.16

[Chris W. <la...@us...>]

Update of /cvsroot/openinteract/OpenInteract2/pkg/system_doc/OpenInteract2/Action
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1030/OpenInteract2/Action

Modified Files:
	SystemDoc.pm 
Log Message:
OIN-156: add OI2::Manual, OI2::App, SPOPS::Manual and Template::Manual
trees to the viewable modules; removed some old package documentation
stuff; streamlined the pod finding (lots of caching); added page
demarcation class divs to the templates


Index: SystemDoc.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/pkg/system_doc/OpenInteract2/Action/SystemDoc.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** SystemDoc.pm	18 Mar 2005 04:09:47 -0000	1.15
--- SystemDoc.pm	23 Sep 2005 05:00:55 -0000	1.16
***************
*** 5,8 ****
--- 5,9 ----
  use strict;
  use base qw( OpenInteract2::Action );
+ use File::Spec::Functions    qw( catdir catfile );
  use Log::Log4perl            qw( get_logger );
  use OpenInteract2::Constants qw( :log );
***************
*** 15,28 ****
  my ( $log );
  
! my ( %POD_CACHE );
  
- sub list {
-     my ( $self ) = @_;
-     return $self->generate_content(
-                     {}, { name => 'system_doc::system_doc_menu' } );
- }
  
  
! # TODO: Get SPOPS|OI2::Manual stuff in here
  
  sub module_list {
--- 16,37 ----
  my ( $log );
  
! # class variable,  holds something like:
! #   OpenInteract2::Action => /usr/lib/perl5/site_perl/.../OpenInteract2/Action.pm
! my %POD_CACHE = ();
  
  
+ # Classpaths we want to manually find and add for viewing
+ my @check_subclass = (
+     [ qw/ OpenInteract2 App / ],
+     [ qw/ OpenInteract2 Manual / ],
+     [ qw/ SPOPS Manual / ],
+     [ qw/ Template Manual / ],
+ );
  
! 
! sub home {
!     my ( $self ) = @_;
!     return $self->generate_content();
! }
  
  sub module_list {
***************
*** 30,77 ****
      $log ||= get_logger( LOG_APP );
  
!     # Now sort INC and chop up the files into packages
  
!     my %this_inc = %INC;
!     my @top = ();
  
!     my $count = -1;
!     my $curr_parent = undef;
!     foreach my $full_pkg ( sort keys %this_inc ) {
!         next unless ( $full_pkg =~ /\.pm$/ );
!         my ( $first ) = split /\//, $full_pkg;
!         if ( $first ne $curr_parent ) {
!             $count++;
              $log->is_debug &&
!                 $log->debug( "First item != parent: ",
!                              "($first) / ($curr_parent)" );
!             $curr_parent   = $first;
!             $curr_parent   =~ s/\.pm$//;
!             $top[ $count ] = [ $curr_parent, [] ];
          }
!         $log->is_debug &&
!             $log->debug( "Found package $full_pkg" );
!         push @{ $top[ $count ]->[1] }, _colonify( $full_pkg );
      }
      $log->is_debug &&
!         $log->debug( "# module parents found: ", scalar @top );
!     return $self->generate_content(
!                     { module_list => \@top },
!                     { name => 'system_doc::module_listing' } );
! }
! 
! 
! sub _colonify {
!     my ( $text ) = @_;
!     $text =~ s|\.pm$||;
!     $text =~ s|/|::|g;
!     return $text;
! }
! 
! 
! sub _uncolonify {
!     my ( $text, $is_pod ) = @_;
!     $text =~ s|::|/|g;
!     my $ext = ( $is_pod ) ? '.pod' : '.pm';
!     return "$text$ext";
  }
  
--- 39,72 ----
      $log ||= get_logger( LOG_APP );
  
!     # Copy %INC plus manual items to local cache
!     unless ( keys %POD_CACHE ) {
!         $self->_read_classpath();
!     }
  
!     my @top_level = ();
  
!     # and group the modules into sections, with the top-level
!     # namespace as the first item and an arrayref of all children as
!     # the second
! 
!     my @curr_group = ();
!     foreach my $module ( sort keys %POD_CACHE ) {
!         my ( $namespace ) = split /::/, $module;
!         if ( $namespace ne $curr_group[0] ) {
              $log->is_debug &&
!                 $log->debug( "Module ($namespace) != parent ($curr_group[0])" );
!             if ( ref $curr_group[1] ) {
!                 push @top_level, [ @curr_group ];
!             }
!             @curr_group = ( $namespace, [] );
          }
!         push @{ $curr_group[1] }, $module;
!     }
!     if ( ref $curr_group[1] ) {
!         push @top_level, \@curr_group;
      }
      $log->is_debug &&
!         $log->debug( "# module parents found: ", scalar @top_level );
!     return $self->generate_content({ module_list => \@top_level });
  }
  
***************
*** 80,232 ****
      my ( $self ) = @_;
      $log ||= get_logger( LOG_APP );
  
!     my $request = CTX->request;
!     my %params = map { $_ => '' }
!                      qw( pod_file  html_file text_file title error );
  
!     # If this is a package, display the doc
  
!     my $package_spec = $request->param( 'package' );
!     if ( $package_spec ) {
!         $self->_display_package_params( $package_spec, \%params );
      }
      else {
!         my $module = $self->param( 'module' )
!                      || $request->param( 'module' );
!         $self->_display_module_params( $module, \%params );
      }
  
-     my ( $content );
- 
-     if ( -f $params{pod_file} ) {
-         $content = $self->_show_pod( \%params );
-     }
  
!     elsif ( -f $params{html_file} ) {
!         $content = $self->_show_html( \%params );
!     }
  
!     elsif ( -f $params{text_file} ) {
!         $content = $self->_show_text( \%params );
!     }
  
!     else {
!         return "<p>$params{error}.</p>";
!     }
  
!     unless ( $content ) {
!         return '<p>Filename found but no content in file.</p>';
!     }
!     return $self->generate_content(
!                     { content => $content },
!                     { name => 'system_doc::doc_display' } );
! }
  
! sub _display_package_params {
!     my ( $self, $package_spec, $params ) = @_;
!     my ( $package_name, $ver ) =
!             OpenInteract2::Package->parse_full_name( $package_spec );
!     my $request = CTX->request;
!     my $doc = $request->param( 'doc' );
!     my $repos = CTX->repository;
!     if ( $doc =~ /\.(html|txt|pod)$/ ) {
!         my $full_filename = $repos->find_file( $package_name, $doc );
!         $log->is_debug &&
!             $log->debug( "Found [$full_filename] in [$package_name]" );
!         $params->{pod_file}  = $full_filename  if ( $doc =~ /\.pod$/ );
!         $params->{html_file} = $full_filename  if ( $doc =~ /\.html$/ );
!         $params->{text_file} = $full_filename  if ( $doc =~ /\.txt$/ );
!         $params->{title} = $self->_msg( 'sys_doc.package.doc_title', $package_name );
!         $params->{error} = $self->_msg( 'sys_doc.error.cannot_find_package_doc', $doc );
      }
  }
  
- sub _display_module_params {
-     my ( $self, $module, $params ) = @_;
- 
-     # ewww! ick!
-     # TODO: Can we programmatically use Pod::Perldoc to do this?
-     $params->{pod_file} = $POD_CACHE{ $module } || `perldoc -l $module`;
- 
-     chomp $params->{pod_file};
-     if ( $params->{pod_file} ) {
-         $log->is_info &&
-             $log->info( "Found [$params->{pod_file}] from [$module]" );
-     }
-     else {
-         $params->{pod_file} = $INC{ _uncolonify( $module ) };
-         $log->is_info &&
-             $log->info( "Found [$params->{pod_file}] from %INC" );
-     }
-     if ( -f $params->{pod_file} ) {
-         $POD_CACHE{ $module } = $params->{pod_file};
-     }
-     $params->{title} = $self->_msg( 'sys_doc.module.doc_title', $module );
-     $params->{error} = $self->_msg( 'sys_doc.error.cannot_find_module_doc', $module );
- }
  
  sub _show_pod {
!     my ( $self, $params ) = @_;
      $log->is_debug &&
!         $log->debug( "Trying to view pod in [$params->{pod_file}]" );
      my $parser = Pod::POM->new();
!     my $pom = $parser->parse( $params->{pod_file} );
      unless ( $pom ) {
          $log->error( "Pod::POM did not return an object: ",
                       $parser->error() );
!         my $msg = $self->_msg( 'sys_doc.error.pod_parse', $parser->error() );
!         return qq(<p>$msg</p>);
      }
  
      eval { require OpenInteract2::PodView };
      if ( $@ ) {
!         $log->error( "No POD viewer: $@" );
!         $self->add_error_key( 'sys_doc.error.pod_viewer', $@ );
!         return $self->_msg( 'sys_doc.pod.no_content' );
      }
      my $content = eval { OpenInteract2::PodView->print( $pom ) };
      if ( $@ ) {
!         $log->error( "Failed to output html from pod: $@" );
!         return $self->_msg( 'sys_doc.pod.cannot_display_module', $@ );
      }
!     $content =~ s/^.*<BODY>//sm;
!     $content =~ s|</BODY>.*$||sm;
!     return $content;
! }
! 
! sub _show_html {
!     my ( $self, $params ) = @_;
!     eval { open( HTML, $params->{html_file} ) || die $! };
!     if ( $@ ) {
!         my $msg = $self->_msg( 'sys_doc.error.cannot_open_file',
!                                $params->{html_file}, $@ );
!         $log->error( $msg );
!         return "<p>$msg</p>";
      }
-     my $content = join( '', <HTML> );
-     close( HTML );
-     $content =~ s/^.*<BODY>//sm;
-     $content =~ s|</BODY>.*$||sm;
      return $content;
  }
  
- sub _show_text {
-     my ( $self, $params ) = @_;
-     eval { open( TEXT, $params->{text_file} ) || die $! };
-     if ( $@ ) {
-         my $msg = $self->_msg( 'sys_doc.error.cannot_open_file',
-                                $params->{text_file}, $@ );
-         $log->error( $msg );
-         return "<p>$msg</p>";
-     }
-     my $content = join( '', <TEXT> );
-     close( TEXT );
-     return qq(<pre class="systemDocText">$content</pre>);
- }
- 
  1;
  
  __END__
  
  =head1 NAME
  
--- 75,204 ----
      my ( $self ) = @_;
      $log ||= get_logger( LOG_APP );
+     unless ( keys %POD_CACHE ) {
+         $self->_read_classpath();
+     }
+     my $module = $self->param( 'module' )
+                  || CTX->request->param( 'module' );
  
!     my $pod_file = $POD_CACHE{ $module };
  
!     # Yuck -- running perldoc like this stinks: don't use it unless we
!     # have to...
! #    unless ( $pod_file ) {
! #        $pod_file = `perldoc -l $module`;
! #        chomp $pod_file;
! #    }
  
!     my ( $content );
!     if ( -f $pod_file ) {
!         $content = $self->_show_pod( $pod_file );
      }
      else {
!         $self->add_error_key(
!             'sys_doc.error.cannot_find_module_doc', $module
!         );
!         $content = '';
      }
+     my $title = $self->_msg( 'sys_doc.module.doc_title', $module );
+     return $self->generate_content({
+         content => $content, title => $title
+     });
+ }
  
  
! sub _read_classpath {
!     my ( $self ) = @_;
!     eval {
!         # First, copy everything from %INC...
!         while ( my ( $inc_module, $inc_path ) = each %INC ) {
!             my $module = $inc_module;
!             $module =~ s|\.(\w+)$||;
!             $module =~ s|/|::|g;
!             next if ( $module =~ m|^::| );
!             $POD_CACHE{ $module } = $inc_path;
!             $log->info( "POD cache from INC: $module => $inc_path" );
!         }
  
!         my @file_extensions = qw( .pm .pod );
  
!         # Then seek out our modules/POD that won't be in %INC...
!         foreach my $top_dir ( @INC ) {
!             foreach my $subclass_info ( @check_subclass ) {
  
!                 # Finds stuff like OpenInteract2/Manual.pod
!                 foreach my $ext ( @file_extensions ) {
!                     my $top_file =
!                         catfile( $top_dir, @{ $subclass_info } ) . $ext;
!                     if ( -f $top_file ) {
!                         my $module = join( '::', @{ $subclass_info } );
!                         $POD_CACHE{ $module } = $top_file;
!                     }
!                 }
  
!                 my $full_subclass_dir =
!                     catdir( $top_dir, @{ $subclass_info } );
!                 next unless ( -d $full_subclass_dir );
!                 opendir( INCDIR, $full_subclass_dir )
!                     || die "Cannot read from '$full_subclass_dir': $!\n";
!                 my @pod_from = grep /\.(pm|pod)$/, readdir( INCDIR );
!                 closedir( INCDIR );
!                 foreach my $pod_src ( @pod_from ) {
!                     my $full_path = catfile( $full_subclass_dir, $pod_src );
!                     $pod_src =~ s/\.\w+$//;
!                     my $pod_key = join( '::', @{ $subclass_info }, $pod_src );
!                     $POD_CACHE{ $pod_key } ||= $full_path;
!                     $log->info( "POD cache from manual: $pod_key => $full_path" );
!                 }
!             }
!         }
!     };
!     if ( $@ ) {
!         %POD_CACHE = ();
!         die "Error reading modules from %INC: $@\n";
      }
  }
  
  
  sub _show_pod {
!     my ( $self, $pod_file ) = @_;
      $log->is_debug &&
!         $log->debug( "Trying to view pod in '$pod_file'" );
      my $parser = Pod::POM->new();
!     my $pom = $parser->parse( $pod_file );
      unless ( $pom ) {
          $log->error( "Pod::POM did not return an object: ",
                       $parser->error() );
!         $self->add_error_key( 'sys_doc.error.pod_parse', $parser->error() );
!         return '';
      }
  
      eval { require OpenInteract2::PodView };
      if ( $@ ) {
!         my $error = $@;
!         $log->error( "No POD viewer: $error" );
!         $self->add_error_key( 'sys_doc.error.pod_viewer', $error );
!         return '';
      }
+ 
      my $content = eval { OpenInteract2::PodView->print( $pom ) };
      if ( $@ ) {
!         my $error = $@;
!         $log->error( "Failed to output html from pod: $error" );
!         $self->add_error_key(
!             'sys_doc.pod.cannot_display_module', $error );
      }
!     else {
!         $content =~ s/^.*<BODY>//sm;
!         $content =~ s|</BODY>.*$||sm;
      }
      return $content;
  }
  
  1;
  
  __END__
  
+ =pod
+ 
  =head1 NAME
  
***************
*** 242,246 ****
  =head1 METHODS
  
! C<list()>
  
  List the OpenInteract system documentation and all the modules used by
--- 214,222 ----
  =head1 METHODS
  
! C<home()>
! 
! Display main menu.
! 
! C<module_list()>
  
  List the OpenInteract system documentation and all the modules used by
***************
*** 248,253 ****
  C<SPOPS> modules first.
  
- B<package_list()>
- 
  B<module_list()>
  
--- 224,227 ----
***************
*** 290,291 ****
--- 264,267 ----
  
  Chris Winters E<lt>ch...@cw...E<gt>
+ 
+ =cut