view release on metacpan or  search on metacpan

lib/HTML/Perlinfo/Modules.pm  view on Meta::CPAN

 $html .= $self->print_htmlhead if $full_page; 

 my %show_columns = ( 
		'name'    => 'Module name',
		'version' => 'Version',
		'path'	  => 'Location',
		'core' 	  => 'Core',
		'desc'	  => 'Description'
	);

  $html .= $section ? print_section($section) : '';
  $html .= print_color_codes($color_specs) if $color_specs && $color_specs->[2];
  $html .= print_table_start();
  $html .= print_table_header(scalar @$columns, map{ $show_columns{$_} }@$columns);
return $html;
}

sub module_info {
   my ($module_path, $show_only) = @_;

   ( $module_path ) = $module_path =~ /^(.*)$/; 
   
   my ($mod_name, $mod_version, $mod_desc);
 
   no warnings 'all'; # silence warnings
   open(MOD, $module_path) or return 0; 
    while (<MOD>) {
      
      unless ($mod_name) {
	    if (/^ *package +(\S+);/) { 
		    $mod_name = $1;
        }
      }
      
      unless ($mod_version) {
	
      if (/([\$*])(([\w\:\']*)\bVERSION)\b.*\=/) {
	      
       my $line = substr $_, index($_, $1);
       my $eval = qq{
        package HTML::Perlinfo::_version;
        no strict;

        local $1$2;
        \$$2=undef; do {
        $line
        }; \$$2
       };
       
       ( $eval ) = $eval =~ /^(.*)$/sm;
       $mod_version = eval($eval);
       # Again let us be nice here.
       $mod_version = '<i>unknown</i>' if (not defined $mod_version) || ($@);
       $mod_version =~ s/^\s+|\s+$//;
      }
     }

    unless ($mod_desc) {
        if (/=head\d\s+NAME/) {
            local $/ = '';
            local $_;
            chomp($_ = <MOD>);
            ($mod_desc) = /^.*?-+\s*(.*?)$/ism;
        }
    }
    
    last if $mod_name && $mod_version && $mod_desc; 
    
 }
 
   close (MOD);
   return 0 if (! $mod_name || $show_only && ref $show_only && (match_string($mod_name, $show_only) == 0));
   $mod_version = '<i>unknown</i>' if !($mod_version) || ($mod_version !~ /^[\.\d+_]+$/);
   $mod_desc = escapeHTML($mod_desc) if $mod_desc;
   $mod_desc = "<i>No description found</i>" unless $mod_desc;
   return { 'name' => $mod_name, 'version' => $mod_version, 'desc' => $mod_desc };
}

sub print_color_codes {
  my $color_specs = shift;
  my ($html, $label);
  $html .= print_table_start();
  $html .= print_table_header(1, "Module Color Codes");
  $html .= print_table_color_start();

  if (ref($color_specs->[0]) eq 'ARRAY') {
     my $count = 0;
     foreach (@{ $color_specs }) {
        $html .= "<tr>" if $count++ % 5 == 0;
        $label = $_->[2] || $_->[1];
        $html .= print_color_box($_->[0], $label);
        $html .= "</tr>" if (($count >= 5 && $count % 5 == 0)||($count >= @{$color_specs}));
     }
  }
  else {
    $label = $color_specs->[2] || $color_specs->[1];
    $html .= print_color_box($color_specs->[0], $label);
  }

  $html .= print_table_color_end();
  $html .= print_table_end();
  return $html;
}

sub print_module_results {

  my ($mod_dir, $mod_count, $from, $overall_total, $show_dir) = @_;

  my ($html, $total_amount, $searched, @mod_dir, @bad_dir, %seen);
  
  if ($show_dir) {

    $html .= print_table_start();
    $html .= print_table_header(2, "Directory", "Number of Modules");
     for my $dir (keys %{$mod_count}) {
         my $amount_found = $mod_count->{$dir};
         push (@mod_dir, $dir) if $amount_found;
     }
     
     for my $dir1 (@mod_dir) {