#!/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'}); #"