list.pm

一个论文管理系统

# $Id: List.pm,v 1.51 2006/01/10 22:48:43 martin Exp $
#
# Copyright 2005 Nature Publishing Group
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# The Bibliotech::Component::List class is the true workhorse component where
# most of the meat is. This component draws the lists of objects that are
# returned from the queries initiated by users.

package Bibliotech::Component::List;
use strict;
use base 'Bibliotech::Component';
use Set::Array;
use List::Util;
use Bibliotech::Const;
use Bibliotech::Config;
use Bibliotech::DBI;
use Bibliotech::Util;

(our $LINKED_RECENT_INTERVAL = Bibliotech::Config->get('LINKED_RECENT_INTERVAL') || '24 HOUR') =~ s|^(\d+)$|$1 HOUR|;
our $LINKED_MAX_USER_BOOKMARKS = Bibliotech::Config->get('LINKED_MAX_USER_BOOKMARKS') || 100;

sub last_updated_basis {
  ('DBI', 'LOGIN', 'USER');
}

sub heading {
  'List';
}

sub heading_dynamic {
  my ($self, $main) = @_;
  my $heading = $main ? $self->bibliotech->command->description($main) : $self->heading;
  #Don't lowercase anymore
  #$heading =~ s/\b((Home|Recent|Popular|Active|User|Tag|Bookmark|Date|Uri|URI|Comment)(\'?s)?)\b/lc $1/ge;
  return $heading;
}

sub list {
  my $self = shift;
  my $bibliotech = $self->bibliotech;
  my $func = $bibliotech->command->page;
  return $bibliotech->query->$func(@_);
}

sub calc_cabinet_set {
  my ($self, $class) = @_;

  my $quick = $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_cabinet_set'}->{$class};
  return $quick if defined $quick;

  my $bibliotech = $self->bibliotech;
  my $command = $bibliotech->command;
  my $table = $class->table;
  my $plural = $table.'s';
  my $unique = $class->unique;

  my $cabinet_set;
  if ($table =~ /^(user|tag|gang)$/) {
    my $other = $table eq 'user' ? 'tag' : 'user';
    $other = 'gang' if !$command->$other and $command->gang;
    my $flun = $other.'_flun';
    my @filter = $command->$flun;
    if (@filter) {
      my $otherclass = 'Bibliotech::'.ucfirst($other);
      my ($memcache, $cache_key, $last_updated);
      if ($other eq 'user' and $table eq 'tag' and @filter == 1 and $filter[0]) {
	$memcache = $bibliotech->memcache;
	if (my $viewed_user = $filter[0]->obj) {
	  my $viewed_user_id = $viewed_user->user_id;
	  my $updated = $viewed_user->updated;
	  $last_updated = $updated->epoch unless $updated->incomplete;
	  $cache_key = Bibliotech::Cache::Key->new($bibliotech,
						   class => ref $self,
						   method => 'cabinet',
						   id => $viewed_user_id,
						   effective => [undef, $viewed_user]);
	  $cabinet_set = $memcache->get_with_last_updated($cache_key, $last_updated, undef, 1);
	}
      }
      unless (defined $cabinet_set) {
	my @cabinet_set_temp;
	my $all_filters_alpha = 1;
	foreach my $obj (grep(defined $_, map($_->obj, @filter))) {
	  my $cabinet_func = $plural.'_alpha';
	  unless ($obj->can($cabinet_func)) {
	    $cabinet_func = $plural;
	    $all_filters_alpha = 0;
	  }
	  push @cabinet_set_temp, $obj->$cabinet_func;
	}
	unless ($all_filters_alpha) {
	  @cabinet_set_temp = sort {lc($a->$unique) cmp lc($b->$unique)} @cabinet_set_temp;
	}
	$cabinet_set = new Bibliotech::DBI::Set (@cabinet_set_temp);
	$cabinet_set->unique;
	$memcache->set_with_last_updated($cache_key, $cabinet_set, $last_updated) if defined $cache_key;
      }
    }
  }

  $cabinet_set = new Bibliotech::DBI::Set unless defined $cabinet_set;

  $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_cabinet_set'}->{$class} = $cabinet_set;
  return $cabinet_set;
}

sub calc_query_set {
  my ($self, $class, $cabinet_set) = @_;

  my $quick = $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_query_set'}->{$class};
  return $quick if defined $quick;

  $cabinet_set = $self->calc_cabinet_set($class) unless defined $cabinet_set;

  my $bibliotech = $self->bibliotech;
  my $command = $bibliotech->command;
  my $query = $bibliotech->query;
  my $table = $class->table;
  my $plural = $table.'s';

  my $query_set;

  my %avoid_dump;
  unless ($query->any_filters) {
    my $time = Bibliotech::DBI->db_Main->selectrow_array('SELECT NOW() - INTERVAL '.$LINKED_RECENT_INTERVAL);
    $avoid_dump{where} = ['ub.created' => {'>=', $time}];
  }
  # note that although you go to the query object there is a limitation on the same field you ask for
  $query_set = $command->$table ? [$query->$plural(all => 1, %avoid_dump)] : new Set::Array;
  bless $query_set, 'Bibliotech::DBI::Set';
  $query_set->difference($cabinet_set);

  $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_query_set'}->{$class} = $query_set;
  return $query_set;
}

sub calc_user_bookmark_ids {
  my ($self, %options) = @_;
  return map($_->user_bookmark_id, $self->bibliotech->query->user_bookmarks(%options));
}

sub calc_linked_set {
  my ($self, $class, $cabinet_set, $query_set, $user_bookmark_ids_ref, $note) = @_;

  my $quick_key = $class.($note ? ",$note" : '');
  my $quick = $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_linked_set'}->{$quick_key};
  return $quick if defined $quick;

  $cabinet_set = $self->calc_cabinet_set($class)             unless defined $cabinet_set;
  $query_set   = $self->calc_query_set($class, $cabinet_set) unless defined $query_set;

  my $table = $class->table;
  my $primary = $class->primary_column;

  my @user_bookmark_ids = $user_bookmark_ids_ref ? @{$user_bookmark_ids_ref} : $self->calc_user_bookmark_ids;

  my $sql_call = 'sql_joined';
  $sql_call .= '_plus_'.$table unless $table eq 'user';
  my $alias = join('', map(substr($_, 0, 1), split(/_/, $table)));
  my $sth = $class->$sql_call(join(', ', map("$alias.$_", $class->_essential)).', COUNT(ub.user_bookmark_id) as sort',
			      'AND ub.user_bookmark_id IN ('.join(',', map('?', @user_bookmark_ids)).')',
			      "GROUP BY $primary", '', 'ORDER BY sort DESC', 'LIMIT 50');
  $sth->execute(@user_bookmark_ids);
  my $linked_set = new Bibliotech::DBI::Set (map $class->construct($_), $sth->fetchall_hash);
  $linked_set->difference($cabinet_set);
  $linked_set->difference($query_set);

  $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_linked_set'}->{$quick_key} = $linked_set;
  return $linked_set;
}

sub calc_related_set {
  my ($self, $class, $cabinet_set, $query_set, $linked_set, $user_bookmark_ids_ref) = @_;

  my $quick = $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_related_set'}->{$class};
  return $quick if defined $quick;

  $cabinet_set = $self->calc_cabinet_set($class)                          unless defined $cabinet_set;
  $query_set   = $self->calc_query_set($class, $cabinet_set)              unless defined $query_set;
  $linked_set  = $self->calc_linked_set($class, $cabinet_set, $query_set) unless defined $linked_set;

  my $table = $class->table;
  my $primary = $class->primary_column;

  my @user_bookmark_ids = $user_bookmark_ids_ref ? @{$user_bookmark_ids_ref} : $self->calc_user_bookmark_ids;
  
  my $sql_call = 'sql_joined';
  $sql_call .= '_plus_'.$table unless $table eq 'user';
  $sql_call .= '_related_'.$table;
  my $sth = $class->$sql_call(join(', ', map("r.$_", $class->_essential)).', COUNT(ub2.user_bookmark_id) as sort',
			      'AND ub.user_bookmark_id IN ('.join(',', map('?', @user_bookmark_ids)).')',
			      "GROUP BY r.$primary", '', 'ORDER BY sort DESC', 'LIMIT 50');
  $sth->execute(@user_bookmark_ids);
  my $related_set = new Bibliotech::DBI::Set (map $class->construct($_), $sth->fetchall_hash);
  $related_set->difference($cabinet_set);
  $related_set->difference($query_set);
  $related_set->difference($linked_set);

  $Bibliotech::Apache::QUICK{'Bibliotech::Component::List::calc_related_set'}->{$class} = $related_set;
  return $related_set;
}

sub is_tag_linked {
  my ($self, $tag) = @_;
  my @set = $self->bibliotech->query->tags(all => 1,
					   no_freematch => 1,
					   where => ['t5.tag_id' => [$tag->tag_id]]);
  return scalar @set;
}

# works for side bars when main is of type user_bookmark
sub list_multipart_from_user_bookmarks {
  my ($self, $class) = @_;
  my %parts = %{$self->parts||{}};
  my (@final, $cabinet_set, $query_set, $linked_set, $related_set);

  $cabinet_set = $self->calc_cabinet_set($class);
  push @final, Cabinet => @{$cabinet_set} if @{$cabinet_set};

  if ($parts{query} || $parts{linked} || $parts{related} || $parts{main}) {
    $query_set = $self->calc_query_set($class, $cabinet_set);
    push @final, Query => @{$query_set} if @{$query_set};

    if ($parts{linked} || $parts{related} || $parts{main}) {
      my @ids = $self->calc_user_bookmark_ids;

      $linked_set = $self->calc_linked_set($class, $cabinet_set, $query_set, \@ids);
      push @final, Linked => @{$linked_set} if @{$linked_set};

      if ($parts{related} || $parts{main}) {
	$related_set = $self->calc_related_set($class, $cabinet_set, $query_set, $linked_set, \@ids);
	push @final, Related => @{$related_set} if @{$related_set};
      }
    }
  }

  return @final;
}

sub text_content {
  my ($self, $verbose) = @_;
  my @list = $self->list(main => 1) or return wantarray ? () : '';
  my @output = map(scalar $_->text_content($verbose), @list);
  return wantarray ? @output : join('', map("$_\n", @output));
}

sub tt_content {
  my ($self, $verbose) = @_;
  my @list = $self->list(main => 1) or return '';
  my @output = map(scalar $_->tt_content($verbose), @list);
  return join('', map("$_\n", @output));
}

sub html_content_num_options {
  my ($self) = @_;

  my @choices = (10, 25, 50, 100);

  my $bibliotech = $self->bibliotech;
  my $cgi = $bibliotech->cgi;
  my $location = $bibliotech->location;
  my $command = $bibliotech->command;

  my $current_num = $command->num;
  my $query_count = $bibliotech->query->lastcount;

  # list sub that finds the next highest element of a presorted list of numbers given a target number
  my $next_highest = sub { my $testval = shift; foreach (@_) { return $_ if $testval < $_; } return undef; };
  my $next_highest_choice = $next_highest->($query_count => @choices);
  my @numlinks = map {
    eval {
      return $cgi->span({class => 'current_num'}, $_) if $current_num == $_;
      return $cgi->span({class => 'higher_num'}, $_) if defined $next_highest_choice and $_ > $next_highest_choice;
      return $cgi->a({class => 'possible_num', href => $command->canonical_uri($location, {num => [set => $_]})}, $_);
    };
  } @choices;
  return $cgi->div({ id => 'sort-and-number-bar' },
           $cgi->div({ id => 'sort' }, '&nbsp;'),
           $cgi->div({id => 'number'}, 
             $cgi->span({ class => 'number-label' }, 'Number of bookmarks per page: '), 
             $cgi->div({ id => 'number-buttons' },
               join(' | ', @numlinks)
             )
           )
         );       
}

sub html_content_geoinfo {
  my ($self) = @_;

  my $bibliotech = $self->bibliotech;
  my $cgi = $bibliotech->cgi;
  my $location = $bibliotech->location;

  my $geo_href = $bibliotech->command->geo_href($location);

  return $cgi->div({id => 'geoinfo'}, 
		   $cgi->div({class => 'geoinfo_link'},
			     'View in Google Earth:',
			     $cgi->a({href => $geo_href},
				     $cgi->img({src => $location.'geo_data.gif', alt => 'GEO DATA',
						border => 0, title => 'Geographical Data'})),
			     $cgi->a({href => $location.'guide#geodata'},
				     $cgi->img({src => $location.'help_button.gif',
						border => 0, title => 'What does this mean?', alt => '?'}))),
		   $cgi->div({class => 'geoinfo_text'},
			     'Geographical information is available for some of these bookmarks.'));
}

# find global tags, users, etc named like your freematch search and provide alternative links
# this is not the place to change freematch results (see Bibliotech::DBI for that)
sub html_content_freematch_notes {
  my ($self, $freematch_obj) = @_;
  my $freematch = "$freematch_obj";

  my $bibliotech = $self->bibliotech;
  my $cgi = $bibliotech->cgi;

  my $make_link = sub {
    my ($obj, $obj_type, $href_type) = @_;
    return $obj->link($bibliotech, 'freematch_'.$obj_type, 'href_search_'.$href_type, undef, 1);
  };

  my $report_my_tag = sub {
    my $user = $bibliotech->user or return undef;
    my $user_id = $user->user_id;
    my ($tag, $tag_users_ref) = @_;
    my @users = $tag_users_ref ? @{$tag_users_ref} : $tag->users;
    return undef unless grep($_->user_id == $user_id, @users);
    return join(' ',
		'the tag',
		$make_link->($tag, 'tag', 'global_user'),
		'that you have used in your library');
  };

  my $report_global_tag = sub {
    my ($tag, $tag_users_ref) = @_;
    my @users = $tag_users_ref ? @{$tag_users_ref} : $tag->users;
    if (my $user = $bibliotech->user) {
      my $user_id = $user->user_id;
      return undef unless grep($_->user_id != $user_id, @users);
    }
    else {
      return undef unless @users;
    }
    return join(' ',
		'the global tag',
		$make_link->($tag, 'tag', 'global'));
  };

  my $report_linked_tag = sub {
    my $tag = shift;
    return undef unless $self->bibliotech->query->any_filters;
    return undef if $bibliotech->in_my_library;
    return undef unless $self->is_tag_linked($tag);
    return join(' ',
		'the tag',
		$make_link->($tag, 'tag', 'additive_and'),
		'used in this collection');
  };

  my @freematch;
  foreach ('tag', 'user', 'gang') {
    my $class = "Bibliotech::\u$_";
    if (my $obj = $class->new($freematch)) {