/[suikacvs]/webroot/swe/lib/suikawiki/main.pl
Suika

Diff of /webroot/swe/lib/suikawiki/main.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.45 by wakaba, Sun Sep 20 08:54:33 2009 UTC revision 1.46 by wakaba, Mon Sep 21 07:09:48 2009 UTC
# Line 963  if ($path[0] eq 'n' and @path == 2) { Line 963  if ($path[0] eq 'n' and @path == 2) {
963        $id_lock->unlock;        $id_lock->unlock;
964      }      }
965    } elsif ($param =~ /^(un)?related-([0-9]+)$/ and not defined $dollar) {    } elsif ($param =~ /^(un)?related-([0-9]+)$/ and not defined $dollar) {
966      my $id1 = $path[1] + 0;      if ($cgi->request_method eq 'POST') {
967      my $id2 = $2 + 0;        my $id1 = $path[1] + 0;
968      my $answer = $1 ? -1 : 1;        my $id2 = $2 + 0;
969          my $answer = $1 ? -1 : 1;
970      require SWE::Object::Repository;        
971      my $repo = SWE::Object::Repository->new (db => $db);        require SWE::Object::Repository;
972          my $repo = SWE::Object::Repository->new (db => $db);
973      my $y = $repo->are_related_ids ($id1, $id2, $answer);        
974              my $y = $repo->are_related_ids ($id1, $id2, $answer);
975      $repo->save_term_weight_vector;        
976              $repo->save_term_weight_vector;
977      binmode STDOUT, ':encoding(utf-8)';        
978      print "Content-Type: text/plain; charset=utf-8\n\n";        print "Content-Type: text/ping\n\n";
979              print "PING";
980      print "$y\n\n";        exit;
981  #    print $diff->stringify, "\n\n";      } else {
982  #        http_error (405, 'Method not allowed', 'POST');
983  #    print $fv1->stringify, "\n\n";      }
 #    print $fv2->stringify, "\n\n";  
     exit;  
984    }    }
985  } elsif ($path[0] eq 'new-page' and @path == 1) {  } elsif ($path[0] eq 'new-page' and @path == 1) {
986    if ($cgi->request_method eq 'POST') {    if ($cgi->request_method eq 'POST') {
# Line 1124  if ($path[0] eq 'n' and @path == 2) { Line 1122  if ($path[0] eq 'n' and @path == 2) {
1122      exit;      exit;
1123    }    }
1124  } elsif (@path == 2 and $path[0] eq 'g') {  } elsif (@path == 2 and $path[0] eq 'g') {
1125    my $id = 0+$path[1];    require SWE::Object::Graph;
1126      my $graph = SWE::Object::Graph->new (db => $db);
1127    
1128      my $node;
1129    if ($path[1] =~ /\A([0-9]+)\z/ and not defined $dollar) {    if ($path[1] =~ /\A([0-9]+)\z/ and not defined $dollar) {
1130      #      my $id = 0+$path[1];
1131        $node = $graph->get_node_by_id ($id);
1132    } elsif ($path[1] =~ /^id([0-9]+)$/ and not defined $dollar) {    } elsif ($path[1] =~ /^id([0-9]+)$/ and not defined $dollar) {
1133      my $docid = 0+$1;      my $docid = 0+$1;
1134            
1135      ## TODO: ID lock      ## TODO: ID lock
       
     my $id_prop = $id_prop_db->get_data ($docid);  
       
     $id = $id_prop->{node_id};  
       
     unless (defined $id) {  
       require SWE::Object::Graph;  
       my $graph = SWE::Object::Graph->new (db => $db);  
       my $node = $graph->create_node ($docid, $id_prop_db);  
1136    
1137        $id = $node->id;      require SWE::Object::Document;
1138        my $doc = SWE::Object::Document->new (db => $db, id => $docid);
1139        $id_prop->{node_id} = $id;      $node = $doc->get_or_create_graph_node;
       $id_prop_db->set_data ($docid => $id_prop);  
     }  
1140    }    }
     
   use Data::Dumper;  
   binmode STDOUT, ':encoding(utf-8)';  
   print "Content-Type: text/plain; charset=UTF-8\n\n";  
   
   my $node_prop = $db->graph_prop->get_data ($id);  
   
   print Dumper $node_prop;  
   
   require SWE::Object::Graph;  
   my $graph = SWE::Object::Graph->new (db => $db);  
   my $node = $graph->get_node_by_id ($id);  
1141    
1142    my $neighbors = [map {    if ($node) {
1143      my $o = $_;      use Data::Dumper;
1144      $o->{doc_id} = $o->{node}->document_id;      binmode STDOUT, ':encoding(utf-8)';
1145      $o;      print "Content-Type: text/plain; charset=UTF-8\n\n";
   } map {  
     {  
       node_id => $_,  
       node => $graph->get_node_by_id ($_),  
     }  
   } $id, keys %{$node->neighbor_ids}];  
1146    
1147    require SWE::Object::Repository;      my $neighbors = [map {
1148    my $repo = SWE::Object::Repository->new (db => $db);        my $o = $_;
1149    my $doc_id = $node->document_id;        $o->{doc_id} = $o->{node}->document_id;
1150          $o;
1151    for my $n (@$neighbors) {      } map {
1152      if ($n->{doc_id}) {        {
1153        my $id_prop = $id_prop_db->get_data ($n->{doc_id});          node_id => $_,
1154        print $n->{node_id}, "\t", $n->{doc_id}, "\t",          node => $graph->get_node_by_id ($_),
1155                (length $id_prop->{title} ? $id_prop->{title}        }
1156                 : [keys %{$id_prop->{name}}]->[0] // ''); ## TODO: title-type      } keys %{$node->neighbor_ids}];
1157        print "\t", ($repo->are_related_ids ($doc_id, $n->{doc_id}) // 'u' || '0')      
1158            if defined $doc_id;      require SWE::Object::Repository;
1159        print "\n";      my $repo = SWE::Object::Repository->new (db => $db);
1160      } else {      my $doc_id = $node->document_id;
1161        print $n->{node_id}, "\n";      
1162        require SWE::Object::Document;
1163        for my $n (@$neighbors) {
1164          if ($n->{doc_id}) {
1165            my $doc = SWE::Object::Document->new (db => $db, id => $n->{doc_id});
1166            print join "\t", $n->{doc_id}, $doc->title;
1167            print "\n";
1168          }
1169      }      }
1170        
1171        $graph->schelling_update ($node->id);
1172        
1173        exit;
1174    }    }
   
   $graph->schelling_update ($id);  
   
   exit;  
1175  } elsif (@path == 1 and  } elsif (@path == 1 and
1176           {'' => 1, 'n' => 1, 'i' => 1}->{$path[0]}) {           {'' => 1, 'n' => 1, 'i' => 1}->{$path[0]}) {
1177    our $homepage_name;    our $homepage_name;
Legend:
Removed from v.1.45  
changed lines
  Added in v.1.46
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24