1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
#!/usr/bin/perl
# -*- Mode: perl -*-
# file: feedback
# Provide feedback to data curator(s)
use strict;
use CGI 2.42 qw(:standard);
use Ace::Browser::AceSubs qw(:DEFAULT Header DB_Name);
use vars '@FEEDBACK_RECIPIENTS';
# This page called with the parameters:
# recipients- numeric index(es) for recipients of message
# name - name of object to update
# class - class of object to update
# from - sender's e-mail address
# subject - subject of mail message
# remark - body of e-mail message
my $object_name = param('name');
my $object_class = param('class');
my $where_from = param('referer') || referer();
if (param('return') && $where_from !~ /\/feedback/ ) {
print redirect($where_from);
exit 0;
}
PrintTop(undef,undef,'Feedback Page');
if (Configuration->Feedback_recipients) {
@FEEDBACK_RECIPIENTS = @{Configuration->Feedback_recipients};
if (param('submit') && send_mail($object_name,$object_class,$where_from)) {
print_confirmation();
} else {
print start_form;
print_instructions();
print_form( $object_name,$object_class,DB_Name(),$where_from );
print end_form;
}
} else {
print p("No recipients for feedback are defined.");
print start_form(),
hidden(-name=>'referer',-value=>$where_from),br,
submit(-name=>'return',-value=>'Cancel & Return',-class=>'error'),
end_form();
}
PrintBottom;
sub print_top {
my $title = 'Data Submissions and Comments';
print start_html (
'-Title' => $title,
'-style' => Style(),
),
Header,
h1($title);
}
sub print_instructions {
my @defaults;
for (my $i=0; $i<@FEEDBACK_RECIPIENTS; $i++) {
push @defaults,$i if $FEEDBACK_RECIPIENTS[$i][2];
}
print
p({-class=>'small'},
"Use this form to send new data or corrections to",
"the maintainers of this database. An e-mail message",
"will be sent to the individuals selected from the list",
"below."),
blockquote({-class=>'small'},
checkbox_group(-name => 'recipients',
-Values => [(0..$#FEEDBACK_RECIPIENTS)],
-Labels => { map {
$_=>"$FEEDBACK_RECIPIENTS[$_]->[0] ($FEEDBACK_RECIPIENTS[$_]->[1])"
} (0..$#FEEDBACK_RECIPIENTS) },
-defaults=>\@defaults,
-linebreak=>1));
}
sub print_bottom {
print Footer;
}
sub print_form {
my ($name,$class,$db,$where_from) = @_;
print
table(
TR(th({-align=>'RIGHT'},"Your full name:"),
td({-align=>'LEFT'},textfield(-name=>'full_name',-size=>40))),
TR(th({-align=>'RIGHT'},"Your institution:"),
td({-align=>'LEFT'},textfield(-name=>'institution',-size=>40))),
TR(th({-align=>'RIGHT'},"Your e-mail address:"),
td({-align=>'LEFT'},textfield(-name=>'from',-size=>40))),
TR(th({-align=>'RIGHT'},"Subject:"),
td({-align=>'LEFT'},textfield(-name=>'subject',
-value=>$class && $name ?
"Comments on $class $name ($db db)": '',
-size=>60))),
TR(th({-colspan=>2,-align=>'LEFT'},'Comment or Correction:')),
TR(td({-colspan=>2},textarea(-name=>'remark',
-rows=>12,
-cols=>80,
-wrap=>'VIRTUAL'
))),
),
hidden(-name=>'name',-value=>$name),
hidden(-name=>'class',-value=>$class),
hidden(-name=>'db',-value=>$db),
hidden(-name=>'referer',-value=>$where_from),br,
submit(-name=>'return',-value=>'Cancel & Return',-class=>'error'),
submit(-name=>'submit',-value=>'Submit Data');
}
sub send_mail {
my ($obj_name,$obj_class,$where_from) = @_;
$obj_name ||= '(unknown name)';
$obj_class ||= '(unknown class)';
$where_from ||= '(unknown)';
my @addresses = map { $FEEDBACK_RECIPIENTS[$_] ?
$FEEDBACK_RECIPIENTS[$_]->[0]
: () } param('recipients');
my @missing;
push @missing,"At least one message recipient"
unless @addresses;
push @missing,"Your full name (needed for proper attribution)"
unless my $name = param('full_name');
push @missing,"Your institution (needed for proper attribution)"
unless my $institution = param('institution');
push @missing,"Your e-mail address"
unless my $from = param('from');
push @missing,"A properly formatted e-mail address"
if $from && $from !~ /.+\@[\w.]+/;
push @missing,"A subject line"
unless my $subject = param('subject');
push @missing,"A comment or correction"
unless my $remark = param('remark');
if (@missing) {
print
p({-class=>'error'},
"Your submission could not be processed because",
"the following information was missing:"),
ol({-class=>'error'},
li(\@missing)),
p({-class=>'error'},
"Please fill in the missing fields and try again.");
return;
}
my $error = <<END;
Unable to send mail. Please try again later.
If the problem persists, contact the site\'s webmaster.
END
;
unless (open (MAIL,"|/usr/lib/sendmail -oi -t")) {
AceError($error);
return;
}
my $to = join(", ",@addresses);
print MAIL <<END;
From: $from ($name via ACEDB feedback page)
To: $to
Subject: $subject
Full name: $name
Institution: $institution
Address: $from
DATABASE RECORD: $obj_class: $obj_name
SUBMITTED FROM PAGE: $where_from
COMMENT TEXT:
$remark
END
;
unless (close MAIL) {
AceError($error);
return;
}
return 1;
}
sub print_confirmation {
print
p("Thank you for taking the time to submit this information.",
"Please use the buttons below to submit more reports or to",
"return to the database.",
),
start_form,
submit(-name=>'restart',-label=>'Submit Another Report'),
hidden('referer'),
submit(-name=>'return',-label=>'Return to Database'),
end_form;
}
|
