deobfuscator/Deobfuscator/cgi-bin/deob_interface.cgi

   1 #!/usr/bin/perl
   2
   3 # Deob_interface.cgi
   4 # part of the Deobfuscator package
   5 # by Laura Kavanaugh and Dave Messina
   6 #
   7 # cared for by Dave Messina <dave-pause@davemessina.net>
   8 #
   9 # POD documentation - main docs before the code
  10
  11 =head1 NAME
  12
  13 deob_interface.cgi - a WWW user interface to the BioPerl Deobfuscator
  14
  15 =head1 VERSION
  16
  17 This document describes deob_interface.cgi version 0.0.3
  18
  19
  20 =head1 SYNOPSIS
  21
  22     This program is designed to be used through a web browser. To install
  23     deob_interface.cgi and the rest of the Deobfuscator package, see the
  24     README.
  25
  26
  27 =head1 DESCRIPTION
  28
  29 Deob_interface.cgi provides a web-based front-end to the BioPerl Deobfuscator.
  30 It uses the Deobfuscator package to open the Berkeley databases storing the
  31 BioPerl documentation and then display a list of the available modules. A
  32 search box is also provided if the user wants to pare down the list.
  33
  34 When a user clicks on the name of a class, deob_interface.cgi looks up the
  35 stored documentation on the methods in that class, and all of the classes that
  36 class inherits from, and displays a list of those methods. The list shows the
  37 class, return values, and usage statement for each method. A user can see more
  38 extensive documentation for a method by clicking on its name or its class's
  39 name.
  40
  41
  42 =head1 DIAGNOSTICS
  43
  44 =over
  45
  46 =item C<< Can't open list of Perl module names >>
  47
  48 deob_interface.cgi can't locate the textfile F<package_list.txt>
  49 containing the full list of BioPerl packages. By default this file should be
  50 in the same directory as F<deob_interface.cgi>. See L</"CONFIGURATION AND
  51 ENVIRONMENT"> for more information.
  52
  53 =item C<< Can't close list of Perl module names >>
  54
  55 deob_interface.cgi was unsuccessful in closing the F<package_list.txt>
  56 file after reading it. This is most likely a transient filesystem error.
  57
  58 =item C<< Unknown sort option selected in deob_interface.cgi >>
  59
  60 In the event a sort parameter other than I<sort by class> or I<sort by method>
  61 was sent to the sorting subroutine, deob_interface.cgi will exit with a fatal
  62 error.
  63
  64 =back
  65
  66
  67 =head1 CONFIGURATION AND ENVIRONMENT
  68
  69 See the F<README> for installation instructions.
  70
  71 There are four hardcoded variables you may need to set. Look in
  72 deob_interface.cgi for a section labeled 'SET HARDCODED VALUES HERE'.
  73
  74 =over
  75
  76 =item C<< $deob_detail_path >>
  77
  78 The URL of the F<deob_detail.cgi> program. Set to L<<
  79 http://localhost/cgi-bin/deob_detail.cgi >> by default. F<deob_detail.cgi>
  80 needs to be in your webserver's F<cgi-bin> directory or some location where
  81 you are allowed to serve executable code to the web.
  82
  83 If you are setting up the Deobfuscator package on your own machine, the
  84 default URL will probably work. Otherwise, you will need to change the URL,
  85 replacing the C<< localhost portion >> with the hostname of your webserver,
  86 and replacing C<< cgi-bin >> with the path to F<deob_detail.cgi> (starting
  87 at your webserver's root directory).
  88
  89 =item C<< $PERLMODULES >>
  90
  91 The textfile containing a list of the BioPerl modules. Set to
  92 F<package_list.txt> by default. F<package_list.txt> is automatically generated
  93 by the L<< deob_index.pl >> script and its name is a hardcoded value.
  94
  95 If your copy of F<package_list.txt> has a different name or is not in the
  96 same directory as F<deob_detail.cgi>, set $PERLMODULES to the full path of
  97 F<package_list.txt>'s location.
  98
  99 =item C<< $BerkeleyDB_packages >>
 100
 101 The Berkeley DB file storing documentation on BioPerl packages. Set to
 102 F<packages.db> by default. F<packages.db> is automatically generated by the
 103 L<< deob_index.pl >> script and its name is a hardcoded value.
 104
 105 If your copy of F<packages.db> has a different name or is not in the same
 106 directory as F<deob_detail.cgi>, set C<< $BerkeleyDB_packages >> to the
 107 full path of F<packages.db>'s location.
 108
 109 =item C<< $BerkeleyDB_methods >>
 110
 111 The Berkeley DB file storing documentation on BioPerl methods. Set to F<methods.db> by default. F<methods.db> is automatically generated by the
 112 F<deob_index.pl> script and its name is a hardcoded value.
 113
 114 If your copy of F<methods.db> has a different name or is not in the same
 115 directory as F<deob_detail.cgi>, set C<< $BerkeleyDB_methods >> to the
 116 full path of  F<methods.db>'s location.
 117
 118 =back
 119
 120
 121 =head1 DEPENDENCIES
 122
 123 L<version>, L<CGI>, L<Deobfuscator>
 124
 125
 126 =head1 INCOMPATIBILITIES
 127
 128 None reported.
 129
 130
 131 =head1 BUGS AND LIMITATIONS
 132
 133 =over
 134
 135 =item C<< Selecting a class name returns no methods >>
 136
 137 Clicking on C<< Bio::Tools::dpAlign >> or C<< Bio::Tools::AlignFactory >> in
 138 the upper class selection pane produces an empty lower methods pane. There are
 139 undoubtedly other modules that will display this behavior. Reported by Laura
 140 Kavanaugh 2006-04-18.
 141
 142 =back
 143
 144 =head1 FEEDBACK
 145
 146 =head2 Mailing Lists
 147
 148 User feedback is an integral part of the evolution of this and other
 149 Bioperl modules. Send your comments and suggestions preferably to one
 150 of the Bioperl mailing lists.  Your participation is much appreciated.
 151
 152   bioperl-l@bioperl.org                       - General discussion
 153   http://www.bioperl.org/wiki/Mailing_lists   - About the mailing lists
 154
 155 =head2 Reporting Bugs
 156
 157 Report bugs to the Bioperl bug tracking system to help us keep track
 158 the bugs and their resolution.  Bug reports can be submitted via the
 159 web:
 160
 161   https://github.com/bioperl/bioperl-live/issues
 162
 163
 164 =head1 SEE ALSO
 165
 166 L<Deobfuscator>, L<deob_detail.cgi>, L<deob_index.pl>
 167
 168
 169 =head1 AUTHOR
 170
 171 Laura Kavanaugh
 172
 173
 174 =head1 CONTRIBUTORS
 175
 176 =over
 177
 178 =item Dave Messina C<< <dave-pause@davemessina.net> >>
 179
 180 =item David Curiel
 181
 182 =back
 183
 184
 185 =head1 ACKNOWLEDGMENTS
 186
 187 This software was developed originally at the Cold Spring Harbor Laboratory's
 188 Advanced Bioinformatics Course between Oct 12-25, 2005. Many thanks to David
 189 Curiel, who provided much-needed guidance and assistance on this project. Also, special thanks to Todd Wylie for his help with CGI.
 190
 191 =head1 LICENSE AND COPYRIGHT
 192
 193 Copyright (C) 2005-6 Laura Kavanaugh and Dave Messina. All Rights Reserved.
 194
 195 You may use modify or redistribute this software under the same terms as
 196 Perl itself.
 197
 198
 199 =head1 DISCLAIMER
 200
 201 This module is free software; you may redistribute it and/or modify it under the same terms as Perl itself. See L<perlartistic>.
 202
 203
 204 =cut
 205
 206
 207 # Let the code begin...
 208
 209 ## SET HARDCODED VALUES HERE ##
 210 use lib './lib';
 211 my $PERLMODULES         = 'package_list.txt';
 212 my $BerkeleyDB_packages = 'packages.db';
 213 my $BerkeleyDB_methods  = 'methods.db';
 214 my $help_path           = 'deob_help.html';
 215 my $deob_detail_path    = 'deob_detail.cgi';
 216
 217 ## You shouldn't need to change anything below here ##
 218
 219 use version; $VERSION = qv('0.0.2');
 220 use warnings;
 221 use strict;
 222 use CGI ':standard';
 223 use Deobfuscator;
 224
 225 my @available_modules;
 226 my $sort_method;
 227 my $ref_Class_hash;
 228 my $filter;
 229 my $search;
 230 my $sort_order;
 231 my $pattern_found = 0;
 232 my @all_modules;
 233 my $ref_BerkeleyDB_packages;
 234 my $ref_BerkeleyDB_methods;
 235 my $ref_sorted_keys;
 236
 237 # if user previously set the sort order, we can send it with the first form
 238 $sort_order = param('sort_order') ? param('sort_order') : 'by method';
 239
 240 # define some styles
 241 my $style1
 242     = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:10px;background-color:lightgrey;padding:3"};
 243 my $style2
 244     = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:10px;padding:3"};
 245 my $style3
 246     = qq{style="border-collapse:collapse;border:solid black 1px;font-family:verdana;font-size:14px;padding:3"};
 247 my $style4
 248     = qq{style="border-collapse:collapse;border:0px;font-family:verdana;font-size:18px;font-weight:bold;padding:3"};
 249 my $style5 = qq{style="font-family:verdana;font-size:14px;padding:3"};
 250
 251 # Open file containing all Bioperl package names
 252 open my $MODS, '<', $PERLMODULES
 253     or die "Could not read list of Perl module names '$PERLMODULES': $!\n";
 254
 255 # Open BerkeleyDB by getting hash references
 256 $ref_BerkeleyDB_packages = Deobfuscator::open_db($BerkeleyDB_packages);
 257 $ref_BerkeleyDB_methods  = Deobfuscator::open_db($BerkeleyDB_methods);
 258
 259 # Grab input and remove whitespace
 260 my $pattern = param('search_string') ? param('search_string') : ' ';
 261 $pattern =~ s/\s//g;
 262
 263 # Filter file names with user search string if one has been entered
 264 while (<$MODS>) {
 265     if (/\S+/) {    # capture list of all module names in case there are no
 266                     # matches found to user input string
 267         push @all_modules, $_;
 268     }
 269     if ($pattern) {
 270         if (/$pattern/i) {
 271             push @available_modules, $_;
 272             $pattern_found = 1;
 273         }
 274     }
 275     else {
 276         if (/\S+/) {
 277             push @available_modules, $_;
 278         }
 279     }
 280 }
 281
 282 if ( scalar @available_modules < 1 ) {
 283     @available_modules = @all_modules;
 284 }
 285 close $MODS or die "Could not close list of Perl module names $PERLMODULES: $!\n";
 286
 287 # grab BioPerl version string
 288 my $version_string = '__BioPerl_Version'; # specified in deob_index.pl
 289 my $BioPerl_version = $ref_BerkeleyDB_packages->{$version_string};
 290
 291 print header;
 292
 293 print <<CSHL;
 294 <html>
 295     <head>
 296         <title>BioPerl Deobfuscator</title>
 297         <script language="JavaScript">
 298
 299         function submitMe(packageName) {
 300             searchForm.module.value=packageName;
 301             searchForm.Search.value='Search';
 302             searchForm.submit();
 303             return true;
 304         }
 305         </script>
 306     </head>
 307     <body $style5>
 308         <div style="border:solid black 1px; width:100%; overflow:auto">
 309     <table width=100%>
 310     <tr>
 311         <td><p $style4>Welcome to the BioPerl Deobfuscator</p></td>
 312         <td><p $style5>[ <font color="red">$BioPerl_version</font> ]</p></td>
 313         <td><p align=right><a href="$help_path">what is it?</a></p></td>
 314     </tr>
 315     </table>
 316     </div>
 317     <br>
 318     <br>
 319     <div>
 320         <form name="searchForm" action="">
 321             <input type="hidden" name="Search">
 322             <input type="hidden" name="module">
 323                         <input type="hidden" name="sort_order" value="$sort_order">
 324
 325             Search <b>class names</b> by string or Perl regex (examples: Bio::SeqIO, seq, fasta\$)
 326             <br>
 327             <input style="width:30em" type="text"   name="search_string" value="$pattern"></input>
 328             <input type="submit" name="Filter"></input></form>
 329             <br>
 330             OR select a class from the list:
 331     </div>
 332 CSHL
 333
 334 print <<CSHL2;
 335
 336             <div style="border:solid black 1px; width:100%; height:200; overflow:auto">
 337             <table width="100%" $style2>
 338 CSHL2
 339
 340 foreach my $package (@available_modules) {
 341     chomp $package;
 342
 343     my $packageDesc
 344         = Deobfuscator::get_pkg_docs( $ref_BerkeleyDB_packages, $package,
 345         'short_desc' );
 346     my $link = qq{<a href="javascript:submitMe('$package')">$package</a>};
 347
 348     print
 349         "<tr><td $style1>$link</td><td $style2 width='75%'>$packageDesc</td></tr>\n";
 350 }
 351
 352
 353 print <<EOP;
 354     </table>
 355     </div>
 356     <br>
 357 EOP
 358
 359
 360 # keep track of all our form values
 361 my $input_module = param('module');
 362 $filter          = param('Filter') ? param('Filter') : ' ';
 363 $search          = param('Search');
 364 $sort_order      = param('sort_order');
 365
 366 # set position of sort button based on current sort order
 367 my $is_method;
 368 my $is_class;
 369 if ($sort_order) {
 370         if ($sort_order eq 'by method') {
 371                 $is_method = 'selected';
 372                 $is_class  = '';
 373         }
 374         elsif ($sort_order eq 'by class') {
 375                 $is_method = '';
 376                 $is_class  = 'selected';
 377         }
 378         else {
 379                 $is_method = 'selected';
 380                 $is_class  = '';
 381         }
 382 }
 383
 384 # Process user input and return result
 385 if ( param() ) {    #1
 386
 387         # show button allowing user to set sort order
 388         print <<SORT_CODE;
 389
 390 <form name="SORT" action="">
 391 <input type="hidden" name="Search" value="$search">
 392 <input type="hidden" name="module" value="$input_module">
 393 <select name="sort_order" onChange="submit()">
 394 <option value="by method" $is_method>sort by method</option>
 395 <option value="by class" $is_class>sort by class</option>
 396 </select>
 397 </form>
 398 SORT_CODE
 399
 400         # grab sort order from form or sort by method as a default
 401         $sort_method = param('sort_order') ? param('sort_order') : 'by method';
 402
 403         # filter not yet implemented, so this 'if' should never be true
 404     if ( ( $filter eq "" ) && ( $input_module eq "" ) ) {
 405
 406         print "filter = $filter<br>search=$search<br>";
 407         print "Please select a class from the menu or enter a search \n";
 408         print "string and press \"Filter\" button\n";
 409     }
 410     elsif ($search) {
 411
 412         # Determine methods available to user's input class and the class
 413         # where the methods reside.  Store results in a hash.
 414         $ref_Class_hash = get_methods($input_module);
 415
 416         # Sort the method/class data according to user input and display
 417         $ref_sorted_keys
 418             = sorting( $input_module, $sort_method, $ref_Class_hash );
 419
 420         # Display results
 421         display( $input_module, $ref_sorted_keys, $ref_Class_hash,
 422             $ref_BerkeleyDB_methods, $deob_detail_path );
 423
 424     }
 425         # filter not yet implemented, so this 'if' should never be true
 426     elsif ($filter) {
 427         if ( !($pattern_found) ) {
 428             print qq{<b><p style="color:red">No match to string found, please try again</p></b>};
 429             h1('Welcome to the BioPerl Deobfuscator!'),;
 430         }
 431     }
 432     else {
 433         print "Not sure about that input. Please submit error report\n";
 434     }
 435
 436 }    #1
 437
 438 # footer
 439 print "</html>\n";
 440
 441
 442 # Close BerkeleyDB
 443 Deobfuscator::close_db($BerkeleyDB_packages);
 444 Deobfuscator::close_db($BerkeleyDB_methods);
 445
 446
 447 ########################  SUBROUTINES  #################################
 448
 449 sub get_methods {    #1
 450
 451  # Get all available methods for user input class.  Deobfuscator package
 452  # returns hash with key as user input class and value as ref to array.  The
 453  # array contains references to an array for each Class, method pair.  This
 454  # subroutine unpacks this data structure and, for each user input class
 455  # creates a hash where the keys are a concatinated class--method pair and the
 456  # values are the method (There is method to the maddness, its just obscure).
 457
 458     my ($user_class) = shift;
 459
 460     my $hashref = Deobfuscator::return_methods($user_class);
 461
 462     # Put data from Deobfuscaotr into hash so it can be sorted later according
 463     # to user specification
 464     my %Package_hash = ();
 465
 466     foreach my $array_ref ( @{ $hashref->{$user_class} } ) {    #3
 467         my $key = $array_ref->[1] . "::" . $array_ref->[0];
 468         $Package_hash{$key} = $array_ref->[0];
 469
 470     }    #3
 471
 472     return \%Package_hash;
 473
 474 }    #1 End sub get_methods
 475
 476
 477 sub sorting {    #1
 478     my ( $package, $sort, $ref_hash ) = @_;
 479     my @sorted_keys;
 480
 481     # Sort by Class or method, depending on user request
 482     if ( $sort =~ 'by class' ) {    #3
 483             # Sort by Class name (use "lc" to ensure names containing capital
 484             # letters are not sorted separately from lower case names
 485         foreach my $first ( sort { lc $a cmp lc $b } keys %$ref_hash ) {    #4
 486             $first =~ /^(.+)::/;
 487             my $package_name = $1;
 488             push @sorted_keys, $first;
 489         }    #4
 490
 491     }
 492     elsif ( $sort =~ 'by method' ) {    #3
 493            # Sort alphabetically by method name (use "lc" in sort because some
 494            # method names are capitalized and will appear first in
 495            # an alphabetized list unless lower cased.)
 496         foreach my $first (
 497             sort { lc $ref_hash->{$a} cmp lc $ref_hash->{$b} }
 498             keys %$ref_hash
 499             )
 500         {    #5
 501             $first =~ /^(.+)::/;
 502             my $package_name = $1;
 503             push @sorted_keys, $first;
 504         }    #5
 505
 506     }
 507     else {    #3
 508         die
 509             "Unknown sort option >$sort< in deob_interface.cgi::sorting()\n";
 510     }    #3
 511
 512     return \@sorted_keys;
 513
 514 }    #1 End sorting subroutine
 515
 516
 517 sub display {    #1
 518     my ( $package, $ref_sorted_array, $ref_hash, $db_hashref, $detail_path ) = @_;
 519     my $search_word;
 520
 521     print <<CSHL;
 522         <div style="border:solid black 1px; width:100%; overflow:auto">
 523         <table width="100%" $style3>
 524         <tr><td colspan=4><center>methods for <b>$package</b></center></td></tr>
 525
 526                 </table></div>
 527                 <div style="border:solid black 1px; width:100%; height:200; overflow:auto">
 528         <table width="100%" $style3>
 529
 530         <tr>
 531             <td $style3 align=center>Method</td>
 532             <td $style3 align=center>Class</td>
 533             <td $style3 align=center>Returns</td>
 534             <td $style3 align=center>Usage</td>
 535         </tr>
 536
 537 CSHL
 538
 539     foreach my $first (@$ref_sorted_array) {    #4
 540         $first =~ /^(.+)::/;
 541         my $package_name = Deobfuscator::urlify_pkg($1);
 542
 543         # Get the return values part of the documentation
 544         my $return_methods_raw
 545             = Deobfuscator::get_method_docs( $db_hashref, $first, "returns" );
 546         if ( $return_methods_raw eq "0" ) {
 547             $return_methods_raw = "not documented";
 548         }
 549
 550         # Get the usage part of the documentation
 551         my $return_usage_raw
 552             = Deobfuscator::get_method_docs( $db_hashref, $first, "usage" );
 553         if ( $return_usage_raw eq "0" ) {
 554             $return_usage_raw = "not documented";
 555         }
 556
 557         # clean up formatting a little
 558         my $return_methods = Deobfuscator::htmlify($return_methods_raw);
 559         my $return_usage   = Deobfuscator::htmlify($return_usage_raw);
 560
 561         # Display output
 562         my $href = $detail_path . "?method=$first";
 563         my $link
 564             = qq{<a target="method" href="$href">$ref_hash->{$first}</a>};
 565
 566         my @columns
 567             = ( $link, $package_name, $return_methods, $return_usage );
 568
 569
 570         print "<tr><td $style2>", join( "</td><td $style2>", @columns ),
 571             "</td></tr>\n";
 572
 573     }    #4
 574
 575     print <<EOP;
 576     </table>
 577     </div>
 578
 579 EOP
 580
 581 }    #1 End display subroutine
 582
 583 __END__