cgi-bin/chado/ontology_browser_ajax.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CXGN::Chado::Cvterm;
   7 use CXGN::Scrap::AjaxPage;
   8 use XML::Twig;
   9
  10 my $doc = CXGN::Scrap::AjaxPage->new();
  11 $doc->send_http_header();
  12 print $doc->header();
  13
  14 my ( $cv_accession, $action, $indent ) = $doc->get_encoded_arguments("cv_accession", "action", "indent");
  15
  16 my $dbh = CXGN::DB::Connection->new();
  17 $cv_accession =~ tr/a-z/A-Z/;
  18
  19 # Browser Searching
  20 if($action eq "specific") {
  21     my $cv_term = CXGN::Chado::Cvterm->new_with_accession( $dbh, $cv_accession );
  22     my $obsolete = "false";
  23     if( $cv_term->get_cvterm_id() ne "" && $cv_term->term_is_obsolete() eq "true" ) {
  24         $obsolete = "true";
  25         print "obsolete";
  26     }
  27
  28     if( $cv_term->get_cvterm_id() ne "" && $obsolete ne "true" ) {
  29         # Populate root list
  30         my @roots_list = ();
  31         my @roots = CXGN::Chado::Cvterm::get_roots($dbh, $cv_term->get_db_name() );
  32         foreach my $new_root ( @roots ) {
  33             push( @roots_list, $new_root );
  34         }
  35         my $rootNumber = scalar( @roots_list );
  36
  37         # Paths will be stored as an array of arrays
  38         my @paths = ();
  39
  40         # Explicitly initialize the first array, the rest will be dynamic
  41         my @init = ();
  42         push( @init, [$cv_term, undef] );
  43         unshift( @paths, \@init );
  44
  45         # Monitor variables
  46         my $complete = "false";
  47         # Will become true if and only if every path traces back to a root
  48         my $doneCounter = 0;
  49         # Monitors how many paths are done -- when all are done, complete becomes true
  50
  51         # If searching for a root, the path is already done
  52         FINDIFROOT: for( my $i = 0; $i < scalar( @roots_list ); $i++ ) {
  53             if( $init[0]->[0]->get_accession() eq $roots_list[$i]->get_accession() ) {
  54                 unshift( @init, "done" );
  55                 $paths[0] = \@init;
  56                 $doneCounter++;
  57                 $complete = "true";
  58                 last FINDIFROOT;
  59             }
  60         }
  61
  62         # Find paths
  63         while( $complete ne "true" ) {
  64             # Identify latest term in each path
  65             my $pathNumber = scalar( @paths );
  66             for( my $i = 0; $i < $pathNumber; $i++ ) {
  67                 my $pathArrayRef = $paths[$i];
  68                 my @workingPath = @$pathArrayRef;
  69
  70                 my $nextTerm = "done";
  71                 if( ref( $workingPath[0] ) eq "ARRAY" ) {
  72                     $nextTerm = $workingPath[0]->[0];
  73                 }
  74
  75                 # Read only paths that are not done, this saves time
  76                 if( $nextTerm ne "done" ) {
  77                     my @parents = $nextTerm->get_parents();
  78                     my $parentNumber = scalar( @parents );
  79
  80                     if( $parentNumber > 1 ) {
  81                         # Take out original path, then push copies of original path with new parents into paths list
  82                         my $index = $i;
  83                         my $originalPath = splice( @paths, $index, 1 );
  84
  85                         ROOTCHECKER: for( my $j = 0; $j < $parentNumber; $j++ ) {
  86                             my @nextPath = @$originalPath;
  87
  88                             unshift( @nextPath, $parents[$j] );
  89                             for( my $k = 0; $k < scalar( @roots_list ); $k++ ) {
  90                                 if( $nextPath[0]->[0]->get_accession() eq $roots_list[$k]->get_accession() ) {
  91                                     $nextPath[0] = [ $roots_list[$k], undef ];
  92                                     unshift( @nextPath, "done" );
  93                                     push( @paths, \@nextPath );
  94                                     $doneCounter++;
  95                                     last ROOTCHECKER;
  96                                 }
  97                             }
  98                             push( @paths, \@nextPath );
  99                         }
 100                     }
 101
 102                     else {
 103                         # Simple: put the parent in the array and see if it's a root or not
 104                         unshift( @workingPath, $parents[0] );
 105
 106                         ROOTCHECK: for( my $j = 0; $j < scalar( @roots_list ); $j++ ) {
 107                             if( $workingPath[0]->[0]->get_accession() eq $roots_list[$j]->get_accession() ) {
 108                                 $workingPath[0] = [ $roots_list[$j], undef ];
 109                                 unshift( @workingPath, "done" );
 110                                 $doneCounter++;
 111                                 last ROOTCHECK;
 112                             }
 113                         }
 114                         $paths[$i] = \@workingPath;
 115                     }
 116                 }
 117             }
 118
 119             my $test = scalar( @paths );
 120             if( $doneCounter == $test ) {
 121                 $complete = "true";
 122             }
 123         }
 124
 125         # Generate XML tree
 126         my $xmlRoot = XML::Twig::Elt->new('specific');
 127         my $treeRootTag = "term";
 128         my %termIndentHash = ();
 129
 130         for( my $i = 0; $i < scalar( @paths ); $i++ ) {
 131             my $pathRef = $paths[$i];
 132             my @path = @$pathRef;
 133
 134             for( my $j = 1; $j < scalar( @path ); $j++ ) {
 135                 my $treeRootContent = $paths[$i]->[$j]->[0]->get_db_name().":".$paths[$i]->[$j]->[0]->get_accession();
 136                 my $fullName = $treeRootContent;
 137                 $treeRootContent .= ' -- '.$paths[$i]->[$j]->[0]->get_cvterm_name();
 138
 139                 my $elementID = $j."--".$fullName;
 140
 141                 my $next = XML::Twig::Elt->new( $treeRootTag, $treeRootContent );
 142                 $next->set_att( id => $fullName );
 143                 $next->set_att( divID => $elementID );
 144                 $next->set_att( indent => $j );
 145
 146                 my $childNumber = $paths[$i]->[$j]->[0]->count_children();
 147                 $next->set_att( children => $childNumber );
 148
 149                 if( scalar( $xmlRoot->descendants() ) > 0 ) {
 150                     my $element = $xmlRoot;
 151                     while( $element = $element->next_elt( '#ELT' ) ) {
 152                         if( $j > 1 ) {
 153                             my $previousRootContent = $paths[$i]->[$j-1]->[0]->get_db_name().":";
 154                             $previousRootContent .= $paths[$i]->[$j-1]->[0]->get_accession();
 155
 156                             my $text = $element->text;
 157                             my $startIndex = index( $text, ":" ) + 1;
 158                             $text = substr( $text, $startIndex - 3, $startIndex + 7 );
 159
 160                             my $idText = substr( $element->trimmed_text, 0, 10 );
 161                             my $idIndent = $element->att( 'indent' );
 162
 163                             if( $text eq $previousRootContent ) {
 164                                 my $newElement = "true";
 165
 166                                 if( exists $termIndentHash{$idText} ) {
 167                                     if( !grep( $idIndent, @{$termIndentHash{$idText}} ) ) {
 168                                         push @{ $termIndentHash{$idText}}, $idIndent;
 169                                     }
 170                                 }
 171
 172                                 if( $newElement ne "false" ) {
 173                                     if( $next->att( 'indent' ) - $element->att( 'indent' ) == 1 ) {
 174                                         eval{$next->paste( 'last_child', $element )};
 175                                         $termIndentHash{$idText} = [$idIndent];
 176                                     }
 177                                 }
 178                             }
 179                         }
 180                     }
 181                 } else {
 182                     $next->paste( $xmlRoot );
 183                     $termIndentHash{$next->trimmed_text} = ["1"];
 184                 }
 185             }
 186         }
 187
 188         # Format and print XML tree
 189         my $text = $xmlRoot->sprint;
 190
 191         $text =~ s|>|>\n|g;                    # Put newlines after tag boundaries
 192         $text =~ s|<|\n<|g;                    # Put newlines before tag boundaries
 193         $text =~ s|>\n([A-Z])|>$1|g;           # Remove newlines when they come before an accession
 194
 195         my $newLineIndex = 0;                  # Remove blank lines by removing extra newlines; go through string multiple
 196         while( $newLineIndex != -1 ) {         # times if necessary
 197             $text =~ s|\n\n|\n|g;
 198             $newLineIndex = index( $text, "\n\n" );
 199         }
 200
 201         $text =~ s|(<term[A-Za-z0-9 _\,\<\>\+\=\/\'\"\:\t-]*)\n(</term>)|$1$2|g;
 202               # Condense the final term of each path, and its end tag, onto one line for easy identification
 203
 204         print $text;
 205     }
 206 }
 207
 208 # Browser Scanning
 209 else {
 210     # Assemble term list
 211     my @term_list = ();
 212     my $cv_term = undef;
 213
 214     if ($action eq "children") {
 215         # Get all children of a term
 216         $cv_term = CXGN::Chado::Cvterm->new_with_accession($dbh, $cv_accession);
 217         @term_list = $cv_term->get_children();
 218     }
 219
 220     else {
 221         # This gets roots for a specific database
 222         my @new_roots = CXGN::Chado::Cvterm::get_roots($dbh, $action);
 223         foreach my $new_root (@new_roots) {
 224             push @term_list, [ $new_root, undef ];
 225         }
 226     }
 227
 228     $indent++;
 229
 230     # Print out XML
 231     foreach my $t (@term_list) {
 232         my $id = $t->[0]->get_db_name().":".$t->[0]->get_accession();
 233         my $divID = $indent."--".$id;
 234         my $childNumber = $t->[0]->count_children();
 235
 236         my $term = "<term children='$childNumber' divID='$divID' id='$id' indent='$indent'> ";
 237         $term .= $t->[0]->get_db_name().":".$t->[0]->get_accession(). " -- ".$t->[0]->get_cvterm_name();
 238         $term .= "</term>";
 239
 240         print "$term\n";
 241     }
 242 }
 243
 244 print $doc->footer();