The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# Deob_interface.cgi
# part of the Deobfuscator package
# by Laura Kavanaugh and Dave Messina
#
# cared for by Dave Messina <dave-pause@davemessina.net>
#
# POD documentation - main docs before the code

=head1 NAME

deob_interface.cgi - a WWW user interface to the BioPerl Deobfuscator

=head1 VERSION

This document describes deob_interface.cgi version 0.0.3


=head1 SYNOPSIS

    This program is designed to be used through a web browser. To install
    deob_interface.cgi and the rest of the Deobfuscator package, see the
    README.


=head1 DESCRIPTION

Deob_interface.cgi provides a web-based front-end to the BioPerl Deobfuscator.
It uses the Deobfuscator package to open the Berkeley databases storing the
BioPerl documentation and then display a list of the available modules. A
search box is also provided if the user wants to pare down the list.

When a user clicks on the name of a class, deob_interface.cgi looks up the
stored documentation on the methods in that class, and all of the classes that
class inherits from, and displays a list of those methods. The list shows the
class, return values, and usage statement for each method. A user can see more
extensive documentation for a method by clicking on its name or its class's
name.


=head1 DIAGNOSTICS

=over

=item C<< Can't open list of Perl module names >>

deob_interface.cgi can't locate the textfile F<package_list.txt>
containing the full list of BioPerl packages. By default this file should be
in the same directory as F<deob_interface.cgi>. See L</"CONFIGURATION AND
ENVIRONMENT"> for more information.

=item C<< Can't close list of Perl module names >>

deob_interface.cgi was unsuccessful in closing the F<package_list.txt>
file after reading it. This is most likely a transient filesystem error.

=item C<< Unknown sort option selected in deob_interface.cgi >>

In the event a sort parameter other than I<sort by class> or I<sort by method>
was sent to the sorting subroutine, deob_interface.cgi will exit with a fatal
error.

=back


=head1 CONFIGURATION AND ENVIRONMENT

See the F<README> for installation instructions.

There are four hardcoded variables you may need to set. Look in
deob_interface.cgi for a section labeled 'SET HARDCODED VALUES HERE'.

=over

=item C<< $deob_detail_path >>

The URL of the F<deob_detail.cgi> program. Set to L<<
http://localhost/cgi-bin/deob_detail.cgi >> by default. F<deob_detail.cgi>
needs to be in your webserver's F<cgi-bin> directory or some location where
you are allowed to serve executable code to the web.

If you are setting up the Deobfuscator package on your own machine, the
default URL will probably work. Otherwise, you will need to change the URL,
replacing the C<< localhost portion >> with the hostname of your webserver,
and replacing C<< cgi-bin >> with the path to F<deob_detail.cgi> (starting
at your webserver's root directory).

=item C<< $PERLMODULES >>

The textfile containing a list of the BioPerl modules. Set to
F<package_list.txt> by default. F<package_list.txt> is automatically generated
by the L<< deob_index.pl >> script and its name is a hardcoded value.

If your copy of F<package_list.txt> has a different name or is not in the
same directory as F<deob_detail.cgi>, set $PERLMODULES to the full path of
F<package_list.txt>'s location.

=item C<< $BerkeleyDB_packages >>

The Berkeley DB file storing documentation on BioPerl packages. Set to
F<packages.db> by default. F<packages.db> is automatically generated by the
L<< deob_index.pl >> script and its name is a hardcoded value.

If your copy of F<packages.db> has a different name or is not in the same
directory as F<deob_detail.cgi>, set C<< $BerkeleyDB_packages >> to the
full path of F<packages.db>'s location.

=item C<< $BerkeleyDB_methods >>

The Berkeley DB file storing documentation on BioPerl methods. Set to F<methods.db> by default. F<methods.db> is automatically generated by the
F<deob_index.pl> script and its name is a hardcoded value.

If your copy of F<methods.db> has a different name or is not in the same
directory as F<deob_detail.cgi>, set C<< $BerkeleyDB_methods >> to the
full path of  F<methods.db>'s location.

=back


=head1 DEPENDENCIES

L<version>, L<CGI>, L<Deobfuscator>


=head1 INCOMPATIBILITIES

None reported.


=head1 BUGS AND LIMITATIONS

=over

=item C<< Selecting a class name returns no methods >>

Clicking on C<< Bio::Tools::dpAlign >> or C<< Bio::Tools::AlignFactory >> in
the upper class selection pane produces an empty lower methods pane. There are
undoubtedly other modules that will display this behavior. Reported by Laura
Kavanaugh 2006-04-18.

=back

=head1 FEEDBACK

=head2 Mailing Lists

User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to one
of the Bioperl mailing lists.  Your participation is much appreciated.

  bioperl-l@bioperl.org                       - General discussion
  http://bioperl.org/Support.html   - About the mailing lists

=head2 Reporting Bugs

Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution.  Bug reports can be submitted via the
web:

  https://github.com/bioperl/bioperl-live/issues


=head1 SEE ALSO

L<Deobfuscator>, L<deob_detail.cgi>, L<deob_index.pl>


=head1 AUTHOR

Laura Kavanaugh


=head1 CONTRIBUTORS

=over

=item Dave Messina C<< <dave-pause@davemessina.net> >>

=item David Curiel

=back


=head1 ACKNOWLEDGMENTS

This software was developed originally at the Cold Spring Harbor Laboratory's
Advanced Bioinformatics Course between Oct 12-25, 2005. Many thanks to David
Curiel, who provided much-needed guidance and assistance on this project. Also, special thanks to Todd Wylie for his help with CGI.

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2005-6 Laura Kavanaugh and Dave Messina. All Rights Reserved.

You may use modify or redistribute this software under the same terms as
Perl itself.


=head1 DISCLAIMER

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


=cut


# Let the code begin...

## SET HARDCODED VALUES HERE ##
use lib './lib';
my $PERLMODULES         = 'package_list.txt';
my $BerkeleyDB_packages = 'packages.db';
my $BerkeleyDB_methods  = 'methods.db';
my $help_path           = 'deob_help.html';
my $deob_detail_path    = 'deob_detail.cgi';

## You shouldn't need to change anything below here ##

use version; $VERSION = qv('0.0.2');
use warnings;
use strict;
use CGI ':standard';
use Deobfuscator;

my @available_modules;
my $sort_method;
my $ref_Class_hash;
my $filter;
my $search;
my $sort_order;
my $pattern_found = 0;
my @all_modules;
my $ref_BerkeleyDB_packages;
my $ref_BerkeleyDB_methods;
my $ref_sorted_keys;

# if user previously set the sort order, we can send it with the first form
$sort_order = param('sort_order') ? param('sort_order') : 'by method';

# define some styles
my $style1
    = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:10px;background-color:lightgrey;padding:3"};
my $style2
    = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:10px;padding:3"};
my $style3
    = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:14px;padding:3"};
my $style4
    = qq{style="border-collapse:collapse;border:0px;font-family:verdana;font-size:18px;font-weight:bold;padding:3"};
my $style5 = qq{style="font-family:verdana;font-size:14px;padding:3"};

# Open file containing all Bioperl package names
open my $MODS, '<', $PERLMODULES
    or die "Could not read list of Perl module names '$PERLMODULES': $!\n";

# Open BerkeleyDB by getting hash references
$ref_BerkeleyDB_packages = Deobfuscator::open_db($BerkeleyDB_packages);
$ref_BerkeleyDB_methods  = Deobfuscator::open_db($BerkeleyDB_methods);

# Grab input and remove whitespace
my $pattern = param('search_string') ? param('search_string') : ' ';
$pattern =~ s/\s//g;

# Filter file names with user search string if one has been entered
while (<$MODS>) {
    if (/\S+/) {    # capture list of all module names in case there are no
                    # matches found to user input string
        push @all_modules, $_;
    }
    if ($pattern) {
        if (/$pattern/i) {
            push @available_modules, $_;
            $pattern_found = 1;
        }
    }
    else {
        if (/\S+/) {
            push @available_modules, $_;
        }
    }
}

if ( scalar @available_modules < 1 ) {
    @available_modules = @all_modules;
}
close $MODS or die "Could not close list of Perl module names $PERLMODULES: $!\n";

# grab BioPerl version string
my $version_string = '__BioPerl_Version'; # specified in deob_index.pl
my $BioPerl_version = $ref_BerkeleyDB_packages->{$version_string};

print header;

print <<CSHL;
<html>
    <head>
        <title>BioPerl Deobfuscator</title>
        <script language="JavaScript">

        function submitMe(packageName) {
            searchForm.module.value=packageName;
            searchForm.Search.value='Search';
            searchForm.submit();
            return true;
        }
        </script>
    </head>
    <body $style5>
	<div style="border:solid black 1px; width:100%; overflow:auto">
    <table width=100%>
    <tr>
        <td><p $style4>Welcome to the BioPerl Deobfuscator</p></td>
        <td><p $style5>[ <font color="red">$BioPerl_version</font> ]</p></td>
        <td><p align=right><a href="$help_path">what is it?</a></p></td>
    </tr>
    </table>
    </div>
    <br>
    <br>
    <div>
        <form name="searchForm" action="">
            <input type="hidden" name="Search">
            <input type="hidden" name="module">
			<input type="hidden" name="sort_order" value="$sort_order">

            Search <b>class names</b> by string or Perl regex (examples: Bio::SeqIO, seq, fasta\$)
            <br>
            <input style="width:30em" type="text"   name="search_string" value="$pattern"></input>
            <input type="submit" name="Filter"></input></form>
            <br>
            OR select a class from the list:
    </div>
CSHL

print <<CSHL2;

            <div style="border:solid black 1px; width:100%; height:200; overflow:auto">
            <table width="100%" $style2>
CSHL2

foreach my $package (@available_modules) {
    chomp $package;

    my $packageDesc
        = Deobfuscator::get_pkg_docs( $ref_BerkeleyDB_packages, $package,
        'short_desc' );
    my $link = qq{<a href="javascript:submitMe('$package')">$package</a>};

    print
        "<tr><td $style1>$link</td><td $style2 width='75%'>$packageDesc</td></tr>\n";
}


print <<EOP;
    </table>
    </div>
    <br>
EOP


# keep track of all our form values
my $input_module = param('module');
$filter          = param('Filter') ? param('Filter') : ' ';
$search          = param('Search');
$sort_order      = param('sort_order');

# set position of sort button based on current sort order
my $is_method;
my $is_class;
if ($sort_order) {
	if ($sort_order eq 'by method') {
		$is_method = 'selected';
		$is_class  = '';
	}
	elsif ($sort_order eq 'by class') {
		$is_method = '';
		$is_class  = 'selected';
	}
	else {
		$is_method = 'selected';
		$is_class  = '';
	}
}

# Process user input and return result
if ( param() ) {    #1

	# show button allowing user to set sort order
	print <<SORT_CODE;

<form name="SORT" action="">
<input type="hidden" name="Search" value="$search">
<input type="hidden" name="module" value="$input_module">
<select name="sort_order" onChange="submit()">
<option value="by method" $is_method>sort by method</option>
<option value="by class" $is_class>sort by class</option>
</select>
</form>
SORT_CODE

	# grab sort order from form or sort by method as a default
	$sort_method = param('sort_order') ? param('sort_order') : 'by method';

	# filter not yet implemented, so this 'if' should never be true
    if ( ( $filter eq "" ) && ( $input_module eq "" ) ) {

        print "filter = $filter<br>search=$search<br>";
        print "Please select a class from the menu or enter a search \n";
        print "string and press \"Filter\" button\n";
    }
    elsif ($search) {

        # Determine methods available to user's input class and the class
        # where the methods reside.  Store results in a hash.
        $ref_Class_hash = get_methods($input_module);

        # Sort the method/class data according to user input and display
        $ref_sorted_keys
            = sorting( $input_module, $sort_method, $ref_Class_hash );

        # Display results
        display( $input_module, $ref_sorted_keys, $ref_Class_hash,
            $ref_BerkeleyDB_methods, $deob_detail_path );

    }
	# filter not yet implemented, so this 'if' should never be true
    elsif ($filter) {
        if ( !($pattern_found) ) {
            print qq{<b><p style="color:red">No match to string found, please try again</p></b>};
            h1('Welcome to the BioPerl Deobfuscator!'),;
        }
    }
    else {
        print "Not sure about that input. Please submit error report\n";
    }

}    #1

# footer
print "</html>\n";


# Close BerkeleyDB
Deobfuscator::close_db($BerkeleyDB_packages);
Deobfuscator::close_db($BerkeleyDB_methods);


########################  SUBROUTINES  #################################

sub get_methods {    #1

 # Get all available methods for user input class.  Deobfuscator package
 # returns hash with key as user input class and value as ref to array.  The
 # array contains references to an array for each Class, method pair.  This
 # subroutine unpacks this data structure and, for each user input class
 # creates a hash where the keys are a concatinated class--method pair and the
 # values are the method (There is method to the maddness, its just obscure).

    my ($user_class) = shift;

    my $hashref = Deobfuscator::return_methods($user_class);

    # Put data from Deobfuscaotr into hash so it can be sorted later according
    # to user specification
    my %Package_hash = ();

    foreach my $array_ref ( @{ $hashref->{$user_class} } ) {    #3
        my $key = $array_ref->[1] . "::" . $array_ref->[0];
        $Package_hash{$key} = $array_ref->[0];

    }    #3

    return \%Package_hash;

}    #1 End sub get_methods


sub sorting {    #1
    my ( $package, $sort, $ref_hash ) = @_;
    my @sorted_keys;

    # Sort by Class or method, depending on user request
    if ( $sort =~ 'by class' ) {    #3
            # Sort by Class name (use "lc" to ensure names containing capital
            # letters are not sorted separately from lower case names
        foreach my $first ( sort { lc $a cmp lc $b } keys %$ref_hash ) {    #4
            $first =~ /^(.+)::/;
            my $package_name = $1;
            push @sorted_keys, $first;
        }    #4

    }
    elsif ( $sort =~ 'by method' ) {    #3
           # Sort alphabetically by method name (use "lc" in sort because some
           # method names are capitalized and will appear first in
           # an alphabetized list unless lower cased.)
        foreach my $first (
            sort { lc $ref_hash->{$a} cmp lc $ref_hash->{$b} }
            keys %$ref_hash
            )
        {    #5
            $first =~ /^(.+)::/;
            my $package_name = $1;
            push @sorted_keys, $first;
        }    #5

    }
    else {    #3
        die
            "Unknown sort option >$sort< in deob_interface.cgi::sorting()\n";
    }    #3

    return \@sorted_keys;

}    #1 End sorting subroutine


sub display {    #1
    my ( $package, $ref_sorted_array, $ref_hash, $db_hashref, $detail_path ) = @_;
    my $search_word;

    print <<CSHL;
        <div style="border:solid black 1px; width:100%; overflow:auto">
        <table width="100%" $style3>
        <tr><td colspan=4><center>methods for <b>$package</b></center></td></tr>

		</table></div>
		<div style="border:solid black 1px; width:100%; height:200; overflow:auto">
        <table width="100%" $style3>

        <tr>
            <td $style3 align=center>Method</td>
            <td $style3 align=center>Class</td>
            <td $style3 align=center>Returns</td>
            <td $style3 align=center>Usage</td>
        </tr>

CSHL

    foreach my $first (@$ref_sorted_array) {    #4
        $first =~ /^(.+)::/;
        my $package_name = Deobfuscator::urlify_pkg($1);

        # Get the return values part of the documentation
        my $return_methods_raw
            = Deobfuscator::get_method_docs( $db_hashref, $first, "returns" );
        if ( $return_methods_raw eq "0" ) {
            $return_methods_raw = "not documented";
        }

        # Get the usage part of the documentation
        my $return_usage_raw
            = Deobfuscator::get_method_docs( $db_hashref, $first, "usage" );
        if ( $return_usage_raw eq "0" ) {
            $return_usage_raw = "not documented";
        }

        # clean up formatting a little
        my $return_methods = Deobfuscator::htmlify($return_methods_raw);
        my $return_usage   = Deobfuscator::htmlify($return_usage_raw);

        # Display output
        my $href = $detail_path . "?method=$first";
        my $link
            = qq{<a target="method" href="$href">$ref_hash->{$first}</a>};

        my @columns
            = ( $link, $package_name, $return_methods, $return_usage );


        print "<tr><td $style2>", join( "</td><td $style2>", @columns ),
            "</td></tr>\n";

    }    #4

    print <<EOP;
    </table>
    </div>

EOP

}    #1 End display subroutine

__END__