#!/usr/bin/perl -wT use strict; # where do we connect to the Similarity server? # note I put in my local host information just to give you an idea. # you should add your own though if you are using another server # you need to change the $remote_host and the $doc_base my $remote_host = 'localhost'; my $remote_port = '31135'; my $doc_base = '/umls_similarity/'; use CGI; use Socket; BEGIN { # Our University's webserver uses an ancient version of CGI::Carp # so we can't do fatalsToBrowser. # The carpout() function lets us modify the format of messages sent to # a filehandle (in this case STDERR) to include timestamps use CGI::Carp 'carpout'; carpout(*STDOUT); } # subroutine prototypes sub showForm ($$$$$$$$$); sub round ($); my $cgi = CGI->new; # These are the colors of the text when we alternate text colors (when # showing errors, for example). my $text_color1 = 'black'; my $text_color2 = '#d03000'; # print the HTTP header print $cgi->header; # if the showform parameter is no, then don't show the form--this is how # we avoid showing the form in popups my $showform = $cgi->param ('showform') || 'yes'; # show the start of the page (all the usual HTML that goes at the top # of a page, etc.) showPageStart (); # check if we want to show the version information (version of UMLS, etc.) my $showversion = $cgi->param ('version'); if ($showversion) { socket (Server, PF_INET, SOCK_STREAM, getprotobyname ('tcp')); my $internet_addr = inet_aton ($remote_host) or die "Could not convert $remote_host to an Internet addr: $!\n"; my $paddr = sockaddr_in ($remote_port, $internet_addr); unless (connect (Server, $paddr)) { print "
Cannot connect to server $remote_host:$remote_port
\n"; goto SHOW_END; } select ((select (Server), $|=1)[0]); print Server "v\015\012\015\012"; print "$1 version $2
\n"; } elsif ($line =~ m/^! (.*)/) { print "$1
\n"; } else { print "Strange message from server: $line\n"; } } local $ENV{PATH} = "/usr/local/bin:/usr/bin:/bin:/sbin"; my $t_osinfo = `uname -a` || "Couldn't get system information: $!"; # $t_osinfo is tainted. Use it in a pattern match and $1 will # be untainted. $t_osinfo =~ /(.*)/; print "
HTTP server: $ENV{HTTP_HOST} ($1)
\n"; print "Similarity server: $remote_host
\n"; goto SHOW_END; } # check if we're generating this page as the result of a query; if so, then # we need to show the results. my $word1 = $cgi->param ('word1'); my $word2 = $cgi->param ('word2'); if ($word1 and !$word2) { print "Term 2 was not specified.
"; } elsif (!$word1 and $word2) { print "Term 1 was not specified.
"; } elsif ($word1 and $word2) { print "Cannot connect to server $remote_host:$remote_port
\n"; goto SHOW_END; } select ((select (Server), $|=1)[0]); # value of the parameters can be 'all', 'gloss', or 'synset' my $w1option = $cgi->param ('senses1'); my $w2option = $cgi->param ('senses2'); my $button = $cgi->param('button'); my %measurehash = (); $measurehash{'path'} = "Path Length"; $measurehash{'lch'} = "Leacock & Chodorow"; $measurehash{'wup'} = "Wu & Palmer"; $measurehash{'res'} = "Resnik"; $measurehash{'lin'} = "Lin"; $measurehash{'jcn'} = "Jiang & Conrath"; $measurehash{'cdist'} = "Conceptual Distance"; $measurehash{'nam'} = "Nguyen & Al-Mubaid"; $measurehash{'random'} = "Random Measure"; $measurehash{'vector'} = "Vector Measure"; $measurehash{'lesk'} = "Adapted Lesk"; my $query_type = 2; my $measure = ""; my $sab = ""; my $rel = ""; if($button eq "Compute Relatedness") { $measure = $cgi->param('relatedness'); $sab = $cgi->param('sabdef'); $rel = $cgi->param('reldef'); } else { $measure = $cgi->param ('similarity'); $sab = $cgi->param ('sab'); $rel = $cgi->param ('rel'); } my $gloss = $cgi->param ('gloss') ? 'yes' : 'no'; my $path = $cgi->param ('path') ? 'yes' : 'no'; my $all_senses = $cgi->param ('sense') ? 1 : 0; # terminate all messages with CRLF (best to avoid \r\n because the # meaning of \r and \n varies from platform to platform # if the word is a CUI get its preferred term if($word1=~/C[0-9]+/) { print Server "t|$word1|\015\012"; } if($word2=~/C[0-9]+/) { print Server "t|$word2|\015\012"; } # now get their similarity if ($measure eq 'all' && $button eq "Compute Similarity") { foreach my $m (qw/path wup lch res lin jcn random cdist nam/) { print Server +("r|$word1|$word2|$button|$m|$sab|$rel|", "\015\012"); } print Server "\015\012"; } elsif ($measure eq 'all' && $button eq "Compute Relatedness") { foreach my $m (qw/vector lesk/) { print Server +("r|$word1|$word2|$button|$m|$sab|$rel|", "\015\012"); } } else { print Server ("r|$word1|$word2|$button|$measure|$sab|$rel|", "\015\012"); } # get the path information if the similarity button is clicked if($button eq "Compute Similarity") { print Server "p|$word1|$word2|\015\012"; } # get the definitions of the possible CUIs of the words or the CUIs # themselves depending on what was entered print Server "g|$button|$word1|\015\012"; print Server "g|$button|$word2|\015\012"; print Server "\015\012"; my %terms = (); my %cuis = (); my %scores = (); my %paths = (); my @glosses = (); my @errors = (); my $pathflag = 0; my @version_info; my $lines = 0; my $last_measure = ''; while (my $response =$item->[0] version $item->[1]
\n"; } goto SHOW_END; } # show errors, if any if (scalar @errors) { unless ($cgi->param ('errors') eq 'show') { my $query = $query_string . '&errors=show'; my $url = "umls_similarity.cgi?${query}"; # Having onclick return false should keep the browser from # loading the page specified by href, but IE loads it # anyways. That's why we set href to # instead of the # URL (setting it to the URL would let non-JavaScript # browsers see the page in the main window, but such # browsers are rare) print +("", "View errors", '
', "\n"); } else { print ''; my $parity = 0; foreach (0..$#errors) { my $color = $parity ? $text_color1 : $text_color2; print "
'; print "
Sorry, no definitions were found.
\n"; } goto SHOW_END; } else { my $query = $query_string . '&gloss=yes'; my $url = "umls_similarity.cgi?${query}"; print +('', "", "View Definitions", '
', "\n"); } # show path information if similarity is desired, if any if($button eq "Compute Similarity") { if ($path eq 'yes') { my $parity = 0; if($pathflag > 0) { print ''; print "
Sorry, no path information was found.
\n"; } goto SHOW_END; } else { my $query = $query_string . '&path=yes'; my $url = "umls_similarity.cgi?${query}"; print +('', "", "View Shortest Path", '
', "\n"); } } if ($all_senses) { print '| Measure | Term 1 | Term 2 | Score | '; print "
|---|---|---|---|
| $m | "; print "$_->[1] | "; print "$_->[2] | "; print "$_->[0] | "; print "
", "The relatedness of $term1 (", "$good->[1] ", ") and $term2 ($good->[2] ", ") using $measurehash{$m} ($m) is $good->[0].", "
\nUsing:", "    SABDEF :: include $sab
", "    RELDEF :: include $rel
"); } else { print +("\n", "The similarity of $term1 (", "$good->[1] ", ") and $term2 ($good->[2] ", ") using $measurehash{$m} ($m) is $good->[0].", "
\nUsing:", "    SAB :: include $sab
", "    REL :: include $rel
"); } } print +("", "View relatedness of all possible senses
\n"); } SHOW_END: print "UMLS::Similarity is a freely available open source software package that can be used to obtain the similarity or relatedness between two biomedical terms from the Unified Medical Language System (UMLS).
EOINTRO } sub showForm ($$$$$$$$$) { my ($type, $arg1, $arg2, $arg3, $arg4, $arg5, $arg6, $arg7, $arg8) = @_; # the 'action' attribute for the HTML form below--should be the script # name my $action = 'umls_similarity.cgi'; print <<"EOFORM1";DIRECTIONS: You may enter any two terms or Concept Unique Identifiers (CUIs) below. If terms are entered, then the relatedness or similarity of the possible CUIs will be computed and the pair with the highest score returned. The difference between similarity and relatedness is ....
Detailed instructions.
About the Similarity Measures.
About the Relatedness Measures.