#!/opt/perl-5.8.3/bin/perl -T # # Copyright (c) 2003, Tim Chklovski and Rada Mihalcea # All rights reserved. # # Redistribution and use in source and binary forms, with or without modification, # are permitted provided that the following conditions are met: # 1. Redistributions of source code must retain the above copyright notice, this # list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright notice, this # list of conditions and the following disclaimer in the documentation and/or other # materials provided with the distribution. # 3. The use of this code or extensions of the code must be acknowledged with a reference # and a link to http://teach-computers.org. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT # SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT # OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # # $Header: /RESEARCH-CVS/web-interface/wsd-collect-tagging.cgi,v 1.14 2002/04/24 13:03:35 timc Exp $ require 5.001; use strict; use CGI qw(:cgi-lib :standard :html3 :netscape); use CGI::Carp qw(fatalsToBrowser); $CGI::POST_MAX=1024 * 100; # max 100K posts $CGI::DISABLE_UPLOADS = 1; # no uploads use DBI; use Digest::MD5; use lib '.'; use lib '../../cgi-lib'; #use lib '/usr/lib/perl5/5.8.0/i386-linux-thread-multi/Digest/'; use lib '/opt/perl-5.8.3/lib/5.8.3/i686-linux/Digest/'; require PresentWSD; require Contributor; require Stats; require CustomizedSettings; MAIN: { $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:'; # my $db_name = 'EnWsdDB'; my $db_name = 'robk'; my $dbh = &ConnectCollectionDB($db_name); my $activity_id = 20; # NOTE: this is the id of WSD Tagging activity # for multiple senses per word: my $tag_sep = '__'; #how tags are separated in DB my $num_pulldowns = 0; # load up the customized messages my %messages = LoadMessages(); # read the current topics my @all = CurrentTopics(); # recover the 'user' cookie: my %user_info = cookie($db_name); my $ip = $ENV{'REMOTE_ADDR'} || 'unknown'; # NOTE: need finer grained time here -- $user_info{'session-name'} ||= &NewSession($dbh, $ip, time()); my $session_id = &NameToId($dbh, 'sessions', &UntaintAlNum($user_info{'session-name'})) or die("Unable to look up session id for ".$user_info{'session_name'}); my ($uid, $uname) = &SessionToUser($dbh, $session_id); # anonymous user has uid = 1 # save output of previous tagging in a log file: &SaveReplies("../data/wsd-collect-tagging.log"); # store the output of previous tagging in a DB: my $submit_data_ref = &StoreReplies($dbh, $session_id, $activity_id, $num_pulldowns, $tag_sep); ## SET UP THE NEW PRESENTATION ## my $max_per_item = 1000; # max of total items to present per topic my $num_to_present = 10; # per screen my $long_posp = "noun"; # currently not supported my @all_topics = &GetWSDTopics(\@all); my $topic = &UntaintAlNum($user_info{'topic'}) || $all_topics[0]; my $start_idx = $user_info{'start'} || 0; # override topic and start if user-topic was supplied: my $user_topic = param('user-topic') || ''; $user_topic = &UntaintAlNum($user_topic); if(($user_topic ne '---') and ($user_topic ne '')) { $topic = $user_topic; $start_idx = 0; } # end activity if done: &EndActivity(\%messages) if $topic eq '_done_'; # array of lines which are all the information to present for this item # each line is a ref to a hash with several keys: # 'id' => id of this item # 'words' => and ref to an array of words that make up this item # 'idx' => idx of the interesting word in the array of words my @lines = &GetItems($dbh, $topic, $long_posp, $uid, $ip); #allow for more data to be collected only for 'interest' if($topic eq 'interest') { $max_per_item = 2000; } @lines = @lines[0..($max_per_item-1)] if (scalar @lines > $max_per_item); $user_info{'activity-id'} = $activity_id; if ($start_idx+$num_to_present < scalar @lines) { $user_info{'topic'} = $topic; $user_info{'start'} = $start_idx + $submit_data_ref->{'num-skipped'}; } else { $user_info{'topic'} = &GetTopicAfter(\@all_topics, $topic); $user_info{'start'} = 0; } # refresh the cookie so that it doesn't expire. my $the_cookie = cookie(-name=>$db_name, -value=>\%user_info, -path=>'/', -expires=>'+1h'); #Rada: get the senses and the labels from the dictionary sql database my $sth = $dbh->prepare(qq(SELECT id, label FROM dictionary WHERE topic = '$topic';)) or die $dbh->errstr; $sth->execute; my @senses = (); my %labels; while(my ($id, $label) = $sth->fetchrow_array()) { $labels{$id} = $label; push @senses, $id; } # make selector that lets the user override what topic to address next: my $topic_selection_str = &MakeTopicSelector(\%messages, @all_topics); my $nav_str = center(div({-class=>'color', -style=>'background-color:#666699;' }, join(" | ", a({-href=>'stats.cgi'}, "hall of fame"), a({-href=>'../help.html'},"help")))); ## PRESENT THE NEW PAGE ## # start the page print header(-cookie=>$the_cookie), # -charset=>'UTF-8'), start_html(-title=>"Learning meanings for '$topic'", -style=>{'src'=>'../../styles/style.css'}); #"\n"; h1(img({src=>'../../images/openmindexpert_small.gif', width=>193, height=>37, hspace=>20, align=>'right'}), "Learning about ".strong({-class=>'word'}, uc($topic))); #make sure the escapeHTML is not enabled, so that special #character encoding is not disabled autoEscape(undef); # print menu print &PresentMenu; # present WordNet summary of the topic: print div({-class=>'box'}, &PresentWnTopic($dbh, $topic, $long_posp, \%messages)); print div({-class=>'color',-style=>'background-color:#666699;'}, &PresentStatus($dbh, $uname, $activity_id, $session_id, $topic, \%messages)); my $num_done = ($uname eq 'anonymous' ? &SessionNumTagged($dbh, $session_id, $activity_id, $topic): &UserNumTagged($dbh, $uname, $activity_id, $topic)); # present the form that users will fill out: print &PresentSelectionForm($topic, [@senses], {%labels}, [@lines], $num_done, $start_idx, $num_to_present, $topic_selection_str, \%messages, $num_pulldowns); # wrap up print $nav_str, # center( # # ask for feedback # em("Comments, suggestions on making this better? ", # "We would like to hear your ", # a({-href=>'mailto:wsd-feedback@media.mit.edu'}, # "feedback") . "."),br, # em("How will my contribution be ",a({-href=>'../help.html#usage'},"used"), "?"),br, # # show copyright notice # font({-size=>-2}, "© 2002 Tim Chklovski")), #"
", end_html; $dbh->disconnect; exit; }