retagform.pm

一个论文管理系统

# $Id: RetagForm.pm,v 1.10 2005/07/20 18:37:47 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::RetagForm class provides a rename tag form.

package Bibliotech::Component::RetagForm;
use strict;
use base 'Bibliotech::Component';

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

sub html_content {
  my ($self, $class, $verbose, $main) = @_;
  my $cgi = $self->bibliotech->cgi;

  my $user = $self->getlogin or return $self->saylogin('to rename your tags');

  my $validationmsg;
  if ($cgi->param('button') eq 'Retag') {
    my $count = 0;
    eval {
      my @oldtag = $self->bibliotech->parser->tag_list($cgi->param('oldtag')) or
	  die "Old tag: Missing tags, malformed tags, or use of a reserved keyword as a tag.\n";
      @oldtag = join(' ', @oldtag) if @oldtag > 1;  # force just one tag
      my @newtag = $self->bibliotech->parser->tag_list($cgi->param('newtag')) or
	  die "New tag(s): Missing tags, malformed tags, or use of a reserved keyword as a tag.\n";
      die "The tags you have entered are the same (case is ignored) so no action is performable.\n"
	  if join(',', sort(map(lc($_), @oldtag))) eq join(',', sort(map(lc($_), @newtag)));
      $count = $self->bibliotech->retag($user->user_id, \@oldtag, \@newtag);
      die 'No instances of old '.(@oldtag == 1 ? 'tags' : 'tag').' found for your user: '.join(', ', @oldtag).".\n"
	  unless $count;
    };
    if ($@) {
      $validationmsg = $@;
    }
    else {
      return Bibliotech::Page::HTML_Content->simple($cgi->p($count
							    ? "Successfully renamed tags in $count original ".
							    ($count == 1 ? 'instance' : 'instances').'.'
							    : 'No instances found.'));
    }
  }

  # parameter cleaning - need this to keep utf-8 output from messing up on an update reload
  foreach (qw/oldtag newtag/) {
    my $value = $self->cleanparam($cgi->param($_));
    $cgi->param($_ => $value) if $value;
  }

  my $o = $cgi->h1('rename tag');
  $o .= $cgi->start_form(-method => 'POST', -action => $self->bibliotech->location.'retag', -name => 'retag');
  $o .= $cgi->div({class => 'errormsg'}, $validationmsg) if $validationmsg;
  $o .= $cgi->start_table;
  $o .= $cgi->Tr([$cgi->td({valign => 'top'},
			   ['Old tag:',
			    $cgi->textfield(-id => 'oldtagbox', -class => 'textctl', -name => 'oldtag', -size => 60).
			    $cgi->br.'(one tag to find, remove, and replace with the new tag or tags)']),
		  $cgi->td({valign => 'top'},
			   ['New tag(s):',
			    $cgi->textfield(-id => 'newtagbox', -class => 'textctl', -name => 'newtag', -size => 60).
			    $cgi->br.'(space or comma separated, enclose multiword tag name in "quote marks")']),
		  $cgi->td(['', $cgi->submit(-id => 'retagbutton', -class => 'buttonctl', -name => 'button', -value => 'Retag')])
		  ]);
  $o .= $cgi->end_table;
  $o .= $cgi->end_form;

  my $javascript_first_empty = $self->firstempty($cgi, 'retag', qw/oldtag newtag/);

  return new Bibliotech::Page::HTML_Content({html_parts => {main => $o},
					     javascript_onload => ($main ? $javascript_first_empty : undef)});
}

1;
__END__