sub buildHelpDB
{ require Bio::Root::Version;
require G::IO;
my $bpv = $Bio::Root::Version::VERSION;
my $gv = $G::IO::VERSION;
if(sdb_exists("pdoc-bp$bpv-g$gv") && sdb_exists("gclass-$gv")){
%pdoc = %{sdb_load("pdoc-bp$bpv-g$gv")};
%gclass = %{sdb_load("gclass-$gv")};
return;
}
my $bpPath = qx//perldoc -l Bio::Perl/;
my $gPath = qx//perldoc -l G::IO/;
my $rcmdPath = qx//perldoc -l Rcmd::Clustering/;
$bpPath =~ s/Perl.pm//;
$gPath =~ s/\/IO.pm//;
$rcmdPath =~ s/\/Clustering.pm//;
chomp($bpPath);
chomp($gPath);
chomp($rcmdPath);
find({"wanted"=>\&process_g, 'follow'=>1}, $gPath . '.pm');
find({"wanted"=>\&process_g, 'follow'=>1}, $gPath);
find({"wanted"=>\&process_g, 'follow'=>1}, $rcmdPath . '.pm');
find({"wanted"=>\&process_g, 'follow'=>1}, $rcmdPath);
find({"wanted"=>\&process_bp, 'follow'=>1}, $bpPath);
sdb_save(\%pdoc, "pdoc-bp$bpv-g$gv");
sdb_save(\%gclass, "gclass-$gv");} | sub help
{ buildHelpDB() unless(scalar %pdoc);
my $key = shift || 'help';
if ($key =~ /^\-(\S+)/){
my $option = $1;
$key = join(' ', @_);
my $lckey = lc($key);
my $ans = " Keyword\" $key\" was not found in the documentations.\n";
if($option eq 'w'){
require MOBY::Client::Central;
my $m = MOBY::Client::Central->new();
my ($sv, undef) = $m->findService(serviceName=>$key);
if(scalar(@$sv) == 1){
$ans = "\n";
$ans .= ' ' . 'Name: ' . $$sv[0]->{name}. "\n\n";
$ans .= ' ' . "Description:\n"
. ' ' . $$sv[0]->{description} . "\n\n\n";
$ans .= ' ' . "Input:\n";
foreach my $in ( @{$$sv[0]->{input}}){
$ans .= sprintf(" %-20s\n\t\t Object: %-30s\n\t\tNamespace: %-30s\n", $in->articleName, $in->objectType, join(' ', @{$in->namespaces}));
}
$ans .= "\n\n\n";
$ans .= ' ' . "Output:\n";
foreach my $in ( @{$$sv[0]->{output}}){
$ans .= sprintf(" %-20s\n\t\t Object: %-30s\n\t\tNamespace: %-30s\n", $in->articleName, $in->objectType, join(' ', @{$in->namespaces}));
}
$ans .= "\n\n\n";
$ans .= ' ' . 'Authority : ' . $$sv[0]->{authority}. "\n";
$ans .= ' ' . 'Contact : ' . $$sv[0]->{contactEmail}. "\n";
$ans .= ' ' . 'Type : ' . $$sv[0]->{type}. "\n";
$ans .= ' ' . 'Category : ' . $$sv[0]->{category}. "\n";
$ans .= ' ' . 'URL : ' . $$sv[0]->{URL}. "\n";
$ans .= ' ' . 'LSID : ' . $$sv[0]->{LSID}. "\n";
}else{
my @tmpsv = @$sv;
($sv, undef) = $m->findService(keywords=>[split(/\s+/, $lckey)]);
push(@tmpsv, @$sv);
if(scalar(@tmpsv)){
$ans = sprintf(" Found keyword\" %s\" in the following web services\( %s hits\).\n\n", $key, scalar(@tmpsv));
my %tmp;
foreach my $in (@$sv){
$in->{description} =~ s/\n/ /g;
$in->{description} =~ s/^\s+//g;
$tmp{$in->{name}} = ': ' . substr($in->{description}, 0, 50) . '...';
}
foreach my $key (sort keys %tmp){
$ans .= sprintf(" %-40s%s\n", $key, $tmp{$key});
}
}
}
}else{
my @tmp;
foreach my $keyword (sort keys %pdoc){
if ($keyword =~ /Bio/){
next if ($option =~ 'g');
}else{
next if ($option =~ 'b');
}
if(lc($pdoc{$keyword}) =~ /$lckey/){
push(@tmp, $keyword);
}elsif(length($lckey) < 1){
push(@tmp, $keyword);
}
}
if(scalar(@tmp)){
$ans = sprintf(" Found keyword\" %s\" in the following manual pages\( %s hits\).\n\n", $key, scalar(@tmp));
foreach my $entry (@tmp){
my $tmp = $pdoc{$entry};
my $abstract;
if($tmp =~ /Name:\s*(.*)( - .*?)\_\_\%\%\%\%\%\_\_/){
$abstract = $2;
}
if($entry =~ /Bio::/){
$ans .= sprintf(" %s\n",$entry);
}elsif($entry){
$ans .= sprintf(" %-32s%s\n",$entry, $abstract);
}
}
}
}
msg_send($ans);
return $ans;
}else{
my $ans = $pdoc{$key};
my $ans2 = $pdoc{'$gb->' . $key . '()'};
if(length $ans){
$ans =~ s/\_\_\%\%\%\%\%\_\_/\n/g;
unless($ans =~ /Name: (.*) - (.*)\n/){
$ans = "\n Name: $key\n". $ans;
}
}elsif(length $ans2){
$ans = $ans2;
$ans =~ s/\_\_\%\%\%\%\%\_\_/\n/g;
unless($ans =~ /Name: (.*) - (.*)\n/){
$ans = "\n Name: $key\n". $ans;
}
}else{
$ans = " Keyword:\" $key\" not found in manual.\n\n";
my $lckey = lc($key);
my @tmp;;
foreach my $keyword (sort keys %pdoc){
if(lc($keyword) =~ /$lckey/){
push(@tmp, $keyword);
if(lc($keyword) eq $lckey){
$ans = $pdoc{$keyword};
$ans =~ s/\_\_\%\%\%\%\%\_\_/\n/g;
unless($ans =~ /Name: (.*) - (.*)\n/){
$ans = "\n Name: $key\n". $ans;
}
msg_send($ans);
return $ans;
}
}
}
unless(scalar(@tmp)){
foreach my $keyword (sort keys %pdoc){
if(amatch($lckey, ['i 1'], lc($keyword))){
push(@tmp, $keyword);
}
}
}
if(scalar(@tmp)){
$ans .= " Did you mean:\n";
foreach my $entry (@tmp){
$ans .= " " . $entry . "\n";
}
}
$ans .= "\n\n use\" help -s\" if you want to search, or\" help help\" if desperate.\n";
}
msg_send($ans);
return $ans;
}} | sub process_bp
{ my $class = 'Bio';
if ($File::Find::name =~ /\/(Bio.*)\.pm$/){
$class = $1;
$class =~ s/\//::/g;
}else{
next;
}
open(FILE, $File::Find::name) || die($!);
while(<FILE>){
chomp;
if(/^\s*\=head2\s+(\S*)\s*/){
my $subname = $class . '::' . $1;
next if ($subname =~ /Mailing Lists/ || $subname =~ /Reporting Bugs/);
while(<FILE>){
chomp;
last if (/\=cut/);
$pdoc{$subname} .= $_ . '__%%%%%__';
}
}
}
close(FILE);} | sub process_g
{ next unless(/\.pm$/);
my $class = 'G';
if ($File::Find::name =~ /\/((?:G|SubOpt|Rcmd).*)\.pm$/){
$class = $1;
$class =~ s/\//::/g;
}else{
next;
}
open(FILE, $File::Find::name) || die($File::Find::name, " ", $!);
while(<FILE>){
chomp;
if(/^\s*\=head2\s+(.*)\s*$/){
my $subname = $1;
$gclass{$subname} = $class;
while(<FILE>){
chomp;
last if (/\=cut/);
$pdoc{$subname} .= $_ . '__%%%%%__';
}
}
}
close(FILE);} |