#!/usr/local/bin/perl
################################################################################
#
#   File name: update (submit)
#   Project: PEERS
#   Description: Create or amend a record
#
#
#   External documents:
#
#
#   Author: Peter Haworth
#   Date created: 30/09/1998 (entered into SCCS)
#
#   sccs version: 1.2    last changed: 09/30/98
#
#   Copyright Institute of Physics Publishing 1998
#
################################################################################

require 'IOPP/PEERS.pl';
require 'IOPP/hdbm.pl';
use CGI;
use MailQ;

$action=$PEERS_script;
$query=new CGI;
&escapeHTML_query($query);
$query->import_names('query');
$query->autoEscape(undef);
@args=split('/',$query->path_info);
shift @args;
while($arg=$args[0]){
  if(0){
  }else{
    last;
  }
}
($email)=@args;
$admin=$PEERS_admin?'/Admin':'';

if($action eq 'update'){
  $act_name=$PEERS_admin?"Update Record":"Update Your Details";
}else{
  $action='submit';
  $act_name=$PEERS_admin?"Add Record":"Submit Your Details";
}

&printHeader("$PEERS_name: $act_name",$act_name,undef,undef,[$action,'main','add','help']);
print "$IopStyle::TABLE<TR><TD>\n";

if($action eq 'update'){
  $query::email_=lc $query::email_;
  if(!$email){
    if($query::submitting_){
      $query::sname_
      or $PEERS_admin
      or push @errors,"You must enter your surname.";
      $email=$query::email_
      or push @errors,"You must enter your e-mail address.";

      if(!@errors){
        if(!&hdbm_read(\%emaildb,$PEERS_emaildb)){
          push @errors,"The database cannot be opened: $!.";
        }elsif(not $record=$emaildb{$query::email_}){
          push @errors,"There is no record for the e-mail address you entered.";
        }else{
          @record=split(/\0/,$record);
          if(!$PEERS_admin && uc $record[$PEERS_db_sname] ne uc $query::sname_){
            push @errors,"The surname you entered does not match the record
		held against the e-mail address you entered.";
          }
        }
        untie %emaildb;
      }
    }
    if(@errors or !$query::submitting_){
      if(@errors){
        print "Sorry, your request could not be processed because of the
	  following errors:<UL>\n",
	  (map {"<LI>$_\n"} @errors),"</UL>$IopStyle::HR\n";
      }
      print "
        <P>To update your $PEERS directory details, enter your surname
	and the e-mail address currently held in the directory, then press the
	<B>Submit</B> button. You will then be presented with a screen
	containing your complete record which can be amended as required.
      ";

#      print "</TD></TR></TABLE>\n";
      print <<"!END!";
              <p><table width="100%" border="0" cellspacing="0" cellpadding="0" bgcolor="#bbdbbd">
                <tr> 
                  <td valign="top"><img src="/images/peers/tl.gif" width="9" height="9"></td>
                  <td>&nbsp;</td>
                  <td valign="top" align="right"><img src="/images/peers/tr.gif" width="9" height="9"></td>
                </tr>
                <tr> 
                  <td>&nbsp;</td>
                  <td>
                    <table border="0" width="100%" cellpadding="3" cellspacing="0">
                      <tr> 
                        <td>
!END!
      print $query->startform('POST',"$PEERS_cgi$admin/$PEERS_script"),"\n";
      print "<DL><DT><B>Surname:</B><DD>",$query->textfield('sname_','',60),"\n"
        unless $PEERS_admin;
      print "<DT><B>E-Mail address:</B><DD>",$query->textfield('email_','',60),"\n";
      print $query->hidden('submitting_',1);
      print '<DT><BR>',$query->submit('',' Submit '),"</DL>\n";
      print $query->endform,"\n";
      print <<"!END2!";
                        </td>
                      </tr>
                    </table>
                  </td>
                  <td>&nbsp;</td>
                </tr>
                <tr> 
                  <td valign="bottom"><img src="/images/peers/bl.gif" width="9" height="9"></td>
                  <td>&nbsp;</td>
                  <td valign="bottom" align="right"><img src="/images/peers/br.gif" width="9" height="9"></td>
                </tr>
              </table></p>
!END2!
#      print "$IopStyle::TABLE<TR><TD>\n";
      &printTail;
      exit;
    }
  }elsif(!&hdbm_read(\%emaildb,$PEERS_emaildb)){
    push @errors,"The database cannot be opened: $!.";
  }elsif(not $record=$emaildb{$email}){
    push @errors,"No record is held for the e-mail address: $email";
  }
  untie %emaildb;
}
if(@errors){
  print "Sorry, your request could not be processed because of the
	following errors:<UL>\n",
	(map {"<LI>$_\n"} @errors),"</UL>\n";
  &printTail;
  exit;
}
@record=split(/\0/,$record);
  
# Process submitted form, setting @errors if necessary
if($query::submitting){
  # First, check the data entered were OK
  $query::title
  or push @errors,"You must enter your title.";

  $query::sname
  or push @errors,"You must enter your surname.";

  $query::fname
  or push @errors,"You must enter your first name.";

  if($query::email){
    &MailQ::isvalid_addr($query::email)
    or push @errors,"You must enter a valid e-mail address ($MailQ::error).";
  }else{
    push @errors,"You must enter your e-mail address.";
  }

  $query::dept or $PEERS_admin
  or push @errors,"You must enter your department.";

  $query::inst or $PEERS_admin
  or push @errors,"You must enter the name of your institution or company.";

  $query::itype ne '.z.other' || $query::itype_other or $PEERS_admin
  or push @errors,"You must select the type of your institution or company.";

  $query::job or $PEERS_admin
  or push @errors,"You must enter your key function or job title.";

  $query::ctry
  or push @errors,"You must enter your country.";

  # Massage the data slightly
  if($action eq 'update'){
    # Change phone number to normal
    ($phone=$record[$PEERS_db_phone])=~s/\d/*/g;
    if($query::phone eq $phone){
      $query::phone=$record[$PEERS_db_phone];
    }
  }
  $query::email=lc $query::email;
  $query::itype=$query::itype eq '.z.other'
    ? $query::itype_other
    : $query::itype;

  $query::url=~s/^\s+|\s+$//g;
  if(lc $query::url eq 'http://'){
    $query::url='';
  }elsif($query::url ne ''){
    $query::url=~m#^http://[\w\-]+(\.[\w\-]+)+(:\d+)?(/|$)#i
    or push @errors,"You must enter a valid URL.";
  }

  # Make sure that something changed
  if($action eq 'update'){
    my $changed=0;
    foreach(qw(email title fname sname addr dept inst itype job subj ctry phone
url)){
      if(${"query::$_"} ne $record[${"PEERS_db_$_"}]){
        $changed=1;
        last;
      }
    }
    $changed
    or push @errors,"You didn't change any fields.";
  }

  # Record the changes and inform the user
  if(!@errors){
    my @changerec=();
    if($PEERS_admin){
      $rec=\@record;
      $oemail=$record[$PEERS_db_email];
    }else{
      $rec=\@changerec;
    }
    foreach(qw(email title fname sname addr dept inst itype job subj ctry phone url noconf oemail)){
      $rec->[${"PEERS_db_$_"}]=${"query::$_"};
    }
    $rec->[$PEERS_db_mtime]=time;
    $rec->[$PEERS_db_ctime]=$record[$PEERS_db_ctime]
      || $rec->[$PEERS_db_mtime];
    $rec->[$PEERS_db_action]=$action;

    if($PEERS_admin){
      if(&hdbm_write(\%emaildb,$PEERS_emaildb)){
        delete $emaildb{$oemail};
        $emaildb{$query::email}=join("\0",@record);
        untie %emaildb;

        print "
		<P>The record for email address $oemail has been successfully
		updated.
        ";
      }else{
        push @errors,"The email database cannot be opened: $!";
      }
    }else{
      if(&hdbm_write(\%penddb,$PEERS_penddb)){
        $seqn=$penddb{'_seqn_'};
        ++$seqn;
        $penddb{'_seqn_'}=$seqn;

        $penddb{$seqn}=join("\0",@changerec);
        untie %penddb;

        my $name=&escapeHTML("$query::title $query::sname");
        if($action eq 'submit'){
          print "
	    <P>Thank you for submitting your details $name.
	    They will be checked by the moderator before being added to
	    the $PEERS_name directory.
          ";
          if(open(OFFER,"$PEERS_data/offer")){
            my $name=&escapeHTML("$query::title $query::fname $query::sname");
            my $email=&escapeHTML($query::email);
            my $phone=&escapeHTML($changerec[$PEERS_db_phone]);
            my $addr=&escapeHTML("$changerec[$PEERS_db_addr]\n$changerec[$PEERS_db_ctry]");
            while(<OFFER>){
              s/\$name/$name/o;
              s/\$phone/$phone/o;
              s/\$email/$email/o;
              s/\$addr/$addr/o;
              print;
            }
            close OFFER;
          }
        }else{
          print "
            <P>Thank your for updating your details $name.
            Your details will be checked by the moderator before the updates are
            made.
          ";
        }

        if(!$query::noconf){
          my %message;
          my $name=&accent2ascii("$query::title $query::sname");
          $message{'to'}=$query::email;
          $message{'from'}=$PEERS_email_mod;
          $message{'text'}= <<"!EOF!";
To: $query::email
From: $PEERS_email_mod
Subject: Confirmation of $PEERS_name $action request (change #$seqn)

Dear $name

!EOF!
          if($action eq 'submit'){
            $message{'text'}.= <<"!EOF!";
Thank you for submitting your details to our $PEERS_name directory. As you are
aware, this directory is moderated. Your details will be checked, and you will
receive confirmation by e-mail when they have been added to the directory.
!EOF!
          }else{
            $message{'text'}.= <<"!EOF!";
Thank you for updating your details on our $PEERS_name directory. As you are
aware, this directory is moderated. Your updates will be checked, and you will
receive confirmation by e-mail when your record is updated.
!EOF!
          }
          $message{'text'}.= <<"!EOF!";

Should you have any questions regarding your submission, please contact the
moderator at $PEERS_email_mod quoting change #$seqn.

$PEERS_sig
!EOF!
          &MailQ::queue_message(%message)
          or print "<P><B>Warning:</B> The confirmation message could not be queued: $MailQ::error.";
        }
      }else{
        push @errors,"The changes database cannot be opened: $!.";
      }
    }
  }
}

# Print any errors which occurred, and the search form if necessary
if(!$query::submitting || @errors){
  if(@errors){
    print "
       Sorry, your request could not be processed because of the following
       errors:<UL>
    ",(map { "<LI>$_\n"; } @errors),"</UL>$IopStyle::HR\n";
  }elsif($action eq 'submit'){
    print "
      <P>Thank you for your interest in the $PEERS_name directory. Please use this
      form to submit your details for inclusion in the directory.
      You may choose to receive an e-mail message confirming your submission.

<!--
      <P><I>Once a week,  the name of a new addition to the directory is
      selected at random to receive a voucher which entitles them to a 30%
      discount from any Institute of Physics Publishing book title.</I>
-->
    ";
  }
  if($action eq 'submit'){
    print "
      <P>The $PEERS_name directory is a look-up service for physicists and other
      scientists. It will not be used for commercial or promotional purposes,
      nor will any of the information submitted to this service be forwarded to
      other parties. In submitting your data, you are also protected by the
      Data Protection Act 1984 (see below).
    ";
    print "
      <P>Please complete the form as instructed. All fields are compulsory
      unless otherwise stated. Please note that all submissions are moderated.
    ";
  }else{
    $PEERS_admin or print qq%
      <DL>
      <DT>To delete your entry in the $PEERS_name directory, press this button
	(you will be asked for confirmation):
      <DD><FORM method="POST" action="$PEERS_cgi$admin/delete">
	<INPUT type="hidden" name="email" value="$record[$PEERS_db_email]">
	<INPUT type="submit" value=" Delete Your Record ">
	</FORM>
      </DL>
      <P>To update your entry in the $PEERS_name directory, edit the relevant
	fields in the form below and press the `Submit Form' button at the
	bottom of the page. Please note that all updates are moderated.
    %;
  }
#  print "</TD></TR></TABLE><DL>\n";
  print <<"!END!";
              <p><table width="100%" border="0" cellspacing="0" cellpadding="0" bgcolor="#bbdbbd">
                <tr> 
                  <td valign="top"><img src="/images/peers/tl.gif" width="9" height="9"></td>
                  <td>&nbsp;</td>
                  <td valign="top" align="right"><img src="/images/peers/tr.gif" width="9" height="9"></td>
                </tr>
                <tr> 
                  <td>&nbsp;</td>
                  <td>
                    <table border="0" width="100%" cellpadding="3" cellspacing="0">
                      <tr> 
                        <td>
!END!
  print "<DL>\n";
  print $query->startform('POST',"$PEERS_cgi$admin/$PEERS_script/".&urlEncode($email)),"\n";
  print "<DT><B>Title:</B> <font size=-1 class=smlgry>(eg. Dr, Prof, Mr, Mrs, Ms)</font>\n<DD>",
	$query->textfield('title',$record[$PEERS_db_title],10),"\n";
  print "<DT><B>Surname <font size=-1 class=smlgry>(last name)</font>:</B>\n<DD>",
	$query->textfield('sname',$record[$PEERS_db_sname],60),"\n";
  print "<DT><B>First Name:</B>\n<DD>",
	$query->textfield('fname',$record[$PEERS_db_fname],60),"\n";
  print "<DT><B>E-Mail:</B> <font size=-1 class=smlgry>(specify your personal internet e-mail address)</font>
	<DD>",$query->textfield('email',$record[$PEERS_db_email],60),"\n";
  print "<DT><B>Department</B> <font size=-1 class=smlgry>(eg. Physics, R&amp;D)</font>\n<DD>",
	$query->textfield('dept',$record[$PEERS_db_dept],60),"\n";
  print "<DT><B>Name of Institution/Company:</B>
	<font size=-1 class=smlgry>(eg. ICI, NASA, University of Bristol)</font>\n<DD>",
	$query->textfield('inst',$record[$PEERS_db_inst],60),"\n";
  if(($itype=$record[$PEERS_db_itype]) eq ''){
    $itype='-';
$itype='.z.other';
  }elsif($itype!~/^\./){
    $itype_other=$itype;
    $itype='.z.other';
  }
  print "<DT><B>Type of Institution:</B>
	<font size=-1 class=smlgry>(select the option that best describes your institution)</font>\n<DD>",
	$query->popup_menu('itype',[sort keys %PEERS_itypes],$itype,\%PEERS_itypes),
        "\n",$query->textfield('itype_other',$itype_other,40),"\n";
  print "<DT><B>Key Function/Job Title:</B>
	<font size=-1 class=smlgry>(eg. Lecturer, Research Scientist, Editor)</font>\n<DD>",
	$query->textfield('job',$record[$PEERS_db_job],60),"\n";
  print "<DT><B>Main Subject of Interest:</B> <font size=-1 class=smlgry>(optional)</font>\n<DD>",
	$query->textfield('subj',$record[$PEERS_db_subj],60),"\n";
  print "<DT><B>Postal Address:</B> <font size=-1 class=smlgry>(optional)</font>\n<DD>",
	$query->textarea('addr',$record[$PEERS_db_addr],5,60),"\n";
  print "<DT><B>Country:</B>\n<DD>",
	$query->textfield('ctry',$record[$PEERS_db_ctry],60),"\n";
  ($phone=$record[$PEERS_db_phone])=~s/\d/*/g;
  print "<DT><B>Telephone Number:</B> <font size=-1 class=smlgry>(optional)</font>\n<DD>",
	$query->textfield('phone',$phone,60),
	"<BR><font size=-1 class=smlgry>This is for administrative purposes only and WILL NOT be used
	when your details are displayed on screen.</font>\n";
  print "<DT><B>URL:</B>
	<font size=-1 class=smlgry>(specify your World Wide Web homepage - optional)</font>\n<DD>",
	$query->textfield('url',$record[$PEERS_db_url] || 'http://',60),"\n";
  print "<P><DT>Thank you for filling in this form. As a further security
	measure, we shall be e-mailing back to you the contents of this form for
	verification.
  ";
  print "If for any reason, you do not wish us to do so,
        <B>please indicate here:</B>\n<DD>",
	$query->checkbox('noconf',undef,1,''),
	"<font size=-1 class=smltxt>check this box if you do not wish to receive e-mail confirmation</font>\n"
    if $action eq 'submit';
  print "<DT><B>Please read the database protection notice below before
	submitting your details. By pressing the `Submit Form' button you are
	agreeing to this notice. You are the `data subject' to which we refer.</B>
	<DD><P>",
	$query->submit('',' Submit Form '),"\n",
	$query->defaults(' Clear '),"\n";
  print $query->hidden('oemail',$record[$PEERS_db_email]),"\n";
  print $query->hidden('submitting',1),"\n";
  print $query->endform;
  print "</DL>\n";#$IopStyle::TABLE<TR><TD>\n";
  print <<"!END2!";
			<P>To return to the $PEERS_name service, please select
			<A HREF="$PEERS_cgi/main">$PEERS_name Home</A>.
                        </td>
                      </tr>
                    </table>
                  </td>
                  <td>&nbsp;</td>
                </tr>
                <tr> 
                  <td valign="bottom"><img src="/images/peers/bl.gif" width="9" height="9"></td>
                  <td>&nbsp;</td>
                  <td valign="bottom" align="right"><img src="/images/peers/br.gif" width="9" height="9"></td>
                </tr>
              </table></p>
!END2!

  print qq%
    <p><font size="+1" class="head3grn">Data Protection Notice</font><br>

    The data subject hereby freely gives consent to the specific data above
    being processed and understands that it will be used solely for inclusion
    in the IOP Publishing Ltd's $PEERS_name ($PEERS_longname)
    directory. IOP Publishing Ltd undertakes to process the data
    fairly and lawfully and that the data has been collected for specified,
    explicit and legitimate purposes. At any time the data subject may view
    the data, may obtain the recipients or categories of recipients to whom
    the data are disclosed, and has the right to amend and keep up to date the
    data or may object to the processing of personal data. IOP Publishing Ltd
    will take all the measures it can to prevent
    unauthorised alterations, disclosure or restriction of the data held in
    the directory. If you have any further data protection requirements please
    contact <A HREF="mailto:$PEERS_email_custserv">$PEERS_email_custserv</A>.</p>
  %
}

&printTail;

sub printTail{
  &printFooter($action,'main','search','help');
}