+
+
+
+
+
+
+
+$end_page
+END
+}
+
+sub get_post_versions {
+ my ($versions,$incoming,$htmldecode,$numver) = @_;
+ if ($incoming =~ /^/) {
+ my $p = HTML::LCParser->new(\$incoming);
+ my $done = 0;
+
+ while ( (my $token = $p->get_tag("version")) && (!$done)) {
+ my $num = $token->[1]{num};
+ my $text = $p->get_text("/version");
+ if (defined($numver)) {
+ if ($num == $numver) {
+ if ($htmldecode) {
+ $text = &HTML::Entities::decode($text);
+ }
+ $$versions{$numver}=$text;
+ $done = 1;
+ }
+ } else {
+ if ($htmldecode) {
+ $text = &HTML::Entities::decode($text);
+ }
+ $$versions{$num}=$text;
+ }
+ }
+ } else {
+ if (!defined($numver)) {
+ $numver = 0;
+ }
+ if ($htmldecode) {
+ $$versions{$numver} = $incoming;
+ } else {
+ $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"');
+ }
+ }
+ return;
+}
+
+sub get_post_attachments {
+ my ($attachments,$attachmenturls) = @_;
+ my $num;
+ if ($attachmenturls =~ m/^/) {
+ my $p = HTML::LCParser->new(\$attachmenturls);
+ while (my $token = $p->get_tag("attachment","filename","post")) {
+ if ($token->[0] eq "attachment") {
+ $num = $token->[1]{id};
+ %{$$attachments{$num}} =();
+ } elsif ($token->[0] eq "filename") {
+ $$attachments{$num}{'filename'} = $p->get_text("/filename");
+ } elsif ($token->[0] eq "post") {
+ my $id = $token->[1]{id};
+ $$attachments{$num}{$id} = $p->get_text("/post");
+ }
+ }
+ } else {
+ %{$$attachments{'0'}} = ();
+ $$attachments{'0'}{'filename'} = $attachmenturls;
+ $$attachments{'0'}{'0'} = 'n';
+ }
+
+ return;
+}
+
+sub fail_redirect {
+ my ($r,$feedurl) = @_;
+ if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
+ my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
+ $r->print(&Apache::loncommon::start_page('Feedback not sent',undef,
+ {'redirect' => [2,$feedurl],
+ 'only_body' => 1,}));
+ $r->print(<
+Sorry, no recipients ...
+ENDFAILREDIR
+ $r->print(&Apache::loncommon::end_page());
+}
+
+sub redirect_back {
+ my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$numpicks) = @_;
+ my $sorttag = '';
+ my $roletag = '';
+ my $statustag = '';
+ my $sectag = '';
+ my $userpicktag = '';
+ my $qrystr = '';
+ my $prevtag = '';
+
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+
+ &dewrapper(\$feedurl);
+ if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
+ if ($previous > 0) {
+ $qrystr = 'previous='.$previous;
+ if ($feedurl =~ /\?register=1/) {
+ $feedurl .= '&'.$qrystr;
+ } else {
+ $feedurl .= '?'.$qrystr;
+ }
+ $prevtag = '';
+ }
+ if (defined($sort)) {
+ my $sortqry = 'sortposts='.$sort;
+ if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
+ $feedurl .= '&'.$sortqry;
+ } else {
+ $feedurl .= '?'.$sortqry;
+ }
+ $sorttag = '';
+ if (defined($numpicks)) {
+ my $userpickqry = 'totposters='.$numpicks;
+ $feedurl .= '&'.$userpickqry;
+ $userpicktag = '';
+ } else {
+ if (ref($sectionpick) eq 'ARRAY') {
+ $feedurl .= '§ionpick=';
+ $sectag .= '';
+ } else {
+ $feedurl .= '§ionpick='.$sectionpick;
+ $sectag = '';
+ }
+ if (ref($rolefilter) eq 'ARRAY') {
+ $feedurl .= '&rolefilter=';
+ $roletag .= '';
+ } else {
+ $feedurl .= '&rolefilter='.$rolefilter;
+ $roletag = '';
+ }
+ $feedurl .= '&statusfilter='.$statusfilter;
+ $statustag ='';
+ }
+ }
+ $feedurl=&Apache::lonenc::check_encrypt($feedurl);
+ my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
+ my $onload = 'onLoad=\'if (window.name!="loncapaclient") { this.document.reldt.submit(); self.window.close(); }\'';
+ my $start_page=
+ &Apache::loncommon::start_page('New posts marked as read',undef,
+ {'redirect' => [2,$feedurl],
+ 'only_body' => 1,
+ 'add_entries' => $onload});
+ my $end_page = &Apache::loncommon::end_page();
+
+ $r->print(<
+$typestyle
+Sent $sendsomething message(s), and $sendposts post(s).
+$blog
+$status
+
+$end_page
+ENDREDIR
+}
+
+sub no_redirect_back {
+ my ($r,$feedurl) = @_;
+ my $nofeed=&mt('Sorry, no feedback possible on this resource ...');
+
+ my %body_options = ('only_body' => 1,
+ 'add_entries' => 'onLoad=\'if (window.name!="loncapaclient") { self.window.close(); }\'');
+
+ if ($feedurl !~ m{^/adm/feedback}) {
+ $body_options{'rediect'} = [2,$feedurl];
+ }
+ my $start_page=
+ &Apache::loncommon::start_page('Feedback not sent',undef,
+ \%body_options);
+
+ my $end_page = &Apache::loncommon::end_page();
+
+ $feedurl=&Apache::lonenc::check_encrypt($feedurl);
+ my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
+ $r->print (<
-
-Feedback
-
-
-
-ENDDOCUMENT
- return OK;
+
+
+$nofeed
+
+$end_page
+ENDNOREDIRTWO
+}
+
+sub screen_header {
+ my ($feedurl,$symb) = @_;
+ my $msgoptions='';
+ my $discussoptions='';
+ unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) {
+ if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) {
+ $msgoptions=
+ '';
+ }
+ if (&feedback_available(1)) {
+ $msgoptions.=
+ '';
+ }
+ if (&feedback_available(0,1)) {
+ $msgoptions.=
+ '';
+ }
+ if (&feedback_available(0,0,1)) {
+ $msgoptions.=
+ '';
+ }
+ }
+ if ($env{'request.course.id'}) {
+ if (&discussion_open(undef,$symb) &&
+ &Apache::lonnet::allowed('pch',
+ $env{'request.course.id'}.
+ ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
+ $discussoptions=' '.
+ ''.&mt('Change Screenname').'';
+ }
+ $discussoptions.=' ';
+ }
+ if ($msgoptions) { $msgoptions=''.&mt('Sending Messages').''.$msgoptions; }
+ if ($discussoptions) {
+ $discussoptions=''.&mt('Discussion Contributions').''.$discussoptions; }
+ return $msgoptions.$discussoptions;
+}
+
+sub resource_output {
+ my ($feedurl) = @_;
+ my $usersaw=&Apache::lonnet::ssi_body($feedurl);
+ $usersaw=~s/\]*\>//gi;
+ $usersaw=~s/\<\/body\>//gi;
+ $usersaw=~s/\//gi;
+ $usersaw=~s/\<\/html\>//gi;
+ $usersaw=~s/\//gi;
+ $usersaw=~s/\<\/head\>//gi;
+ $usersaw=~s/action\s*\=/would_be_action\=/gi;
+ return $usersaw;
+}
+
+sub clear_out_html {
+ my ($message,$override)=@_;
+ unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
+# Always allow the -tag
+ my %html=(M=>1);
+# Check if more is allowed
+ my $cid=$env{'request.course.id'};
+ if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
+ ($override)) {
+ # allows
+ #
+ #
+ %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
+ BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
+ M=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1,
+ H1=>1, H2=>1, H3=>1, H4=>1, H5=>1);
+ }
+# Do the substitution of everything that is not explicitly allowed
+ $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
+ {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge;
+ $message =~ s/(\\s*(\w+)[^\<\>]*)\>/
+ {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge;
+ return $message;
+}
+
+sub assemble_email {
+ my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
+ my $email=<<"ENDEMAIL";
+$message
+ENDEMAIL
+ my $citations=<<"ENDCITE";
+Previous attempts of student (if applicable)
+$prevattempts
+
+Original screen output (if applicable)
+$usersaw
+Correct Answer(s) (if applicable)
+$useranswer
+ENDCITE
+ return ($email,$citations);
+}
+
+sub secapply {
+ my $rec=shift;
+ my $defaultflag=shift;
+ $rec=~s/\s+//g;
+ $rec=~s/\@/\:/g;
+ my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
+ if ($sections) {
+ foreach (split(/\;/,$sections)) {
+ if (($_ eq $env{'request.course.sec'}) ||
+ ($defaultflag && ($_ eq '*'))) {
+ return $adr;
+ }
+ }
+ } else {
+ return $rec;
+ }
+ return '';
+}
+
+=pod
+
+=over 4
+
+=item *
+
+decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag);
+
+Arguments
+ $feedurl - /res/ url of resource (only need if $author is true)
+ $author,$question,$course,$policy - all true/false parameters
+ if true will attempt to find the addresses of user that should receive
+ this type of feedback (author - feedback to author of resource $feedurl,
+ $question 'Resource Content Questions', $course 'Course Content Question',
+ $policy 'Course Policy')
+ (Additionally it also checks $env for whether the corresponding form.
+ element exists, for ease of use in a html response context)
+
+ $defaultflag - (internal should be left blank) if true gather addresses
+ that aren't for a section even if I have a section
+ (used for reccursion internally, first we look for
+ addresses for our specific section then we recurse
+ and look for non section addresses)
+
+Returns
+ $typestyle - string of html text, describing what addresses were found
+ %to - a hash, which keys are addresses of users to send messages to
+ the keys will look like name:domain
+
+=cut
+
+sub decide_receiver {
+ my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
+ my $typestyle='';
+ my %to=();
+ if ($env{'form.author'}||$author) {
+ $typestyle.='Submitting as Author Feedback ';
+ $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
+ $to{$2.':'.$1}=1;
+ }
+ if ($env{'form.question'}||$question) {
+ $typestyle.='Submitting as Question ';
+ foreach (split(/\,/,
+ $env{'course.'.$env{'request.course.id'}.'.question.email'})
+ ) {
+ my $rec=&secapply($_,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ($env{'form.course'}||$course) {
+ $typestyle.='Submitting as Comment ';
+ foreach (split(/\,/,
+ $env{'course.'.$env{'request.course.id'}.'.comment.email'})
+ ) {
+ my $rec=&secapply($_,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ($env{'form.policy'}||$policy) {
+ $typestyle.='Submitting as Policy Feedback ';
+ foreach (split(/\,/,
+ $env{'course.'.$env{'request.course.id'}.'.policy.email'})
+ ) {
+ my $rec=&secapply($_,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ((scalar(%to) eq '0') && (!$defaultflag)) {
+ ($typestyle,%to)=
+ &decide_receiver($feedurl,$author,$question,$course,$policy,1);
+ }
+ return ($typestyle,%to);
+}
+
+sub feedback_available {
+ my ($question,$course,$policy)=@_;
+ my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
+ return scalar(%to);
+}
+
+sub send_msg {
+ my ($title,$feedurl,$email,$citations,$attachmenturl,%to)=@_;
+ my $status='';
+ my $sendsomething=0;
+ if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; }
+ unless ($title=~/\w/) { $title=&mt('Feedback'); }
+ foreach (keys %to) {
+ if ($_) {
+ my $declutter=&Apache::lonnet::declutter($feedurl);
+ unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
+ $title.' ['.$declutter.']',$email,$citations,$feedurl,
+ $attachmenturl)=~/ok/) {
+ $status.=' '.&mt('Error sending message to').' '.$_.' ';
+ } else {
+ $sendsomething++;
+ }
+ }
+ }
+
+ my %record=&Apache::lonnet::restore('_feedback');
+ my ($temp)=keys %record;
+ unless ($temp=~/^error\:/) {
+ my %newrecord=();
+ $newrecord{'resource'}=$feedurl;
+ $newrecord{'subnumber'}=$record{'subnumber'}+1;
+ unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
+ $status.=' '.&mt('Not registered').' ';
+ }
+ }
+
+ return ($status,$sendsomething);
+}
+
+sub adddiscuss {
+ my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
+ my $status='';
+ my $realsymb;
+ if ($symb=~/^bulletin___/) {
+ my $filename=(&Apache::lonnet::decode_symb($symb))[2];
+ $filename=~s|^adm/wrapper/||;
+ $realsymb=&Apache::lonnet::symbread($filename);
+ }
+ if (&discussion_open(undef,$realsymb) &&
+ &Apache::lonnet::allowed('pch',$env{'request.course.id'}.
+ ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
+
+ my %contrib=('message' => $email,
+ 'sendername' => $env{'user.name'},
+ 'senderdomain' => $env{'user.domain'},
+ 'screenname' => $env{'environment.screenname'},
+ 'plainname' => $env{'environment.firstname'}.' '.
+ $env{'environment.middlename'}.' '.
+ $env{'environment.lastname'}.' '.
+ $env{'enrironment.generation'},
+ 'attachmenturl'=> $attachmenturl,
+ 'subject' => $subject);
+ if ($env{'form.replydisc'}) {
+ $contrib{'replyto'}=(split(/\:\:\:/,$env{'form.replydisc'}))[1];
+ }
+ if ($anon) {
+ $contrib{'anonymous'}='true';
+ }
+ if (($symb) && ($email)) {
+ if ($env{'form.editdisc'}) {
+ $contrib{'ip'}=$ENV{'REMOTE_ADDR'};
+ $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'};
+ $contrib{'timestamp'} = time;
+ $contrib{'history'} = '';
+ my $numoldver = 0;
+ my ($oldsymb,$oldidx)=split(/\:\:\:/,$env{'form.editdisc'});
+ &Apache::lonenc::check_decrypt(\$oldsymb);
+ $oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
+# get timestamp for last post and history
+ my %oldcontrib=&Apache::lonnet::restore($oldsymb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ if (defined($oldcontrib{$oldidx.':replyto'})) {
+ $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'};
+ }
+ if (defined($oldcontrib{$oldidx.':history'})) {
+ if ($oldcontrib{$oldidx.':history'} =~ /:/) {
+ my @oldversions = split/:/,$oldcontrib{$oldidx.':history'};
+ $numoldver = @oldversions;
+ } else {
+ $numoldver = 1;
+ }
+ $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':';
+ }
+ my $numnewver = $numoldver + 1;
+ if (defined($oldcontrib{$oldidx.':subject'})) {
+ if ($oldcontrib{$oldidx.':subject'} =~ /^/) {
+ $contrib{'subject'} = ''.&HTML::Entities::encode($contrib{'subject'},'<>&"').'';
+ $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'};
+ } else {
+ $contrib{'subject'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').''.&HTML::Entities::encode($contrib{'subject'},'<>&"').'';
+ }
+ }
+ if (defined($oldcontrib{$oldidx.':message'})) {
+ if ($oldcontrib{$oldidx.':message'} =~ /^/) {
+ $contrib{'message'} = ''.&HTML::Entities::encode($contrib{'message'},'<>&"').'';
+ $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'};
+ } else {
+ $contrib{'message'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').''.&HTML::Entities::encode($contrib{'message'},'<>&"').'';
+ }
+ }
+ $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'};
+ my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'},
+ $oldsymb,$oldidx,\%contrib,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ $status='Editing class discussion'.($anon?' (anonymous)':'');
+ } else {
+ $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
+ &Apache::lonnet::store(\%contrib,$symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
+ my %storenewentry=($symb => time);
+ $status.=' '.&mt('Updating discussion time').': '.
+ &Apache::lonnet::put('discussiontimes',\%storenewentry,
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ }
+ my %record=&Apache::lonnet::restore('_discussion');
+ my ($temp)=keys %record;
+ unless ($temp=~/^error\:/) {
+ my %newrecord=();
+ $newrecord{'resource'}=$symb;
+ $newrecord{'subnumber'}=$record{'subnumber'}+1;
+ $status.=' '.&mt('Registering').': '.
+ &Apache::lonnet::cstore(\%newrecord,'_discussion');
+ }
+ } else {
+ $status.='Failed.';
+ }
+ return $status.' ';
+}
+
+# ----------------------------------------------------------- Preview function
+
+sub show_preview {
+ my ($r) = @_;
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ my $message=&clear_out_html($env{'form.comment'});
+ &newline_to_br(\$message);
+ $message=&Apache::lonspeller::markeduptext($message);
+ $message=&Apache::lontexconvert::msgtexconverted($message);
+ my $subject=&clear_out_html($env{'form.subject'});
+ $subject=~s/\n/\ /g;
+ $subject=&Apache::lontexconvert::msgtexconverted($subject);
+ my $start_page=
+ &Apache::loncommon::start_page('Preview',undef,
+ {'only_body' => 1,});
+
+ my $end_page = &Apache::loncommon::end_page();
+
+ $r->print($start_page.''.
+ 'Subject: '.$subject.'
'.
+ $message.' | '.$end_page);
+}
+
+
+sub newline_to_br {
+ my ($message)=@_;
+ my $newmessage;
+ my $parser=HTML::LCParser->new($message);
+ while (my $token=$parser->get_token()) {
+ if ($token->[0] eq 'T') {
+ my $text=$token->[1];
+ $text=~s/\n/\ /g;
+ $newmessage.=$text;
+ } elsif ($token->[0] eq 'D' || $token->[0] eq 'C') {
+ $newmessage.=$token->[1];
+ } elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') {
+ $newmessage.=$token->[2];
+ } elsif ($token->[0] eq 'S') {
+ $newmessage.=$token->[4];
+ }
+
+ }
+ $$message=$newmessage;
+}
+
+sub generate_preview_button {
+ my ($formname,$fieldname)=@_;
+ unless ($formname) { $formname='mailform'; }
+ unless ($fieldname) { $fieldname='comment'; }
+ my $pre=&mt("Show Preview and Check Spelling");
+ return(<
+
+
+
+
+ENDPREVIEW
+}
+
+sub modify_attachments {
+ my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_;
+ my $orig_subject = &Apache::lonnet::unescape($env{'form.subject'});
+ my $subject=&clear_out_html($orig_subject);
+ $subject=~s/\n/\ /g;
+ $subject=&Apache::lontexconvert::msgtexconverted($subject);
+ my $timestamp=$env{'form.timestamp'};
+ my $numoldver=$env{'form.numoldver'};
+
+ my $msg = '';
+ my %attachments = ();
+ my %currattach = ();
+ if ($idx) {
+ &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold);
+ }
+ &Apache::lonenc::check_encrypt(\$symb);
+ my $js = <
+ function setAction () {
+ document.modattachments.action = document.modattachments.origpage.value;
+ document.modattachments.submit();
+ }
+
+END
+
+ my $start_page =
+ &Apache::loncommon::start_page('Discussion Post Attachments',$js);
+ my $end_page =
+ &Apache::loncommon::end_page();
+
+ $r->print(<
+
+
+
+
+
+
+
+
+
+
+END
+ foreach (@{$currnewattach}) {
+ $r->print(''."\n");
+ }
+ foreach (@{$currdelold}) {
+ $r->print(''."\n");
+ }
+ $r->print(<
+
+$end_page
+END
+ return;
+}
+
+sub process_attachments {
+ my ($currnewattach,$currdelold,$keepold) = @_;
+
+ @{$currnewattach}=
+ &Apache::loncommon::get_env_multiple('form.currnewattach');
+ @{$currdelold}=
+ &Apache::loncommon::get_env_multiple('form.deloldattach');
+ if (exists($env{'form.delnewattach'})) {
+ my @currdelnew =
+ &Apache::loncommon::get_env_multiple('form.delnewattach');
+ my @currnew = ();
+ foreach my $newone (@{$currnewattach}) {
+ my $delflag = 0;
+ foreach (@currdelnew) {
+ if ($newone eq $_) {
+ $delflag = 1;
+ last;
+ }
+ }
+ unless ($delflag) {
+ push @currnew, $newone;
+ }
+ }
+ @{$currnewattach} = @currnew;
+ }
+ @{$keepold} = &Apache::loncommon::get_env_multiple('form.keepold');
+}
+
+sub generate_attachments_button {
+ my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach,$numoldver,$mode) = @_;
+ my $origpage = $ENV{'REQUEST_URI'};
+ my $att=$attachnum.' '.&mt("attachments");
+ my $response = (<
+Click to add/remove attachments:
+
+
+
+
+
+
+
+
+
+ENDATTACH
+ if (defined($deloldattach)) {
+ if (@{$deloldattach} > 0) {
+ foreach (@{$deloldattach}) {
+ $response .= ''."\n";
+ }
+ }
+ }
+ if (defined($currnewattach)) {
+ if (@{$currnewattach} > 0) {
+ foreach (@{$currnewattach}) {
+ $response .= ''."\n";
+ }
+ }
+ }
+ $response .= '';
+ return $response;
+}
+
+sub extract_attachments {
+ my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_;
+ %{$attachments}=();
+ &get_post_attachments($attachments,$attachmenturls);
+ foreach my $id (sort keys %{$attachments}) {
+ if (exists($$attachments{$id}{$numoldver})) {
+ if (defined($currdelold)) {
+ if (@{$currdelold} > 0) {
+ unless (grep/^$id$/,@{$currdelold}) {
+ $$currattach{$id} = $$attachments{$id}{$numoldver};
+ }
+ } else {
+ $$currattach{$id} = $$attachments{$id}{$numoldver};
+ }
+ } else {
+ $$currattach{$id} = $$attachments{$id}{$numoldver};
+ }
+ }
+ }
+ my @attached = (sort { $a <=> $b } keys %{$currattach});
+ if (@attached == 1) {
+ my $id = $attached[0];
+ my $attachurl;
+ if ($attachmenturls =~ m/^/) {
+ $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
+ } else {
+ $attachurl = $$attachments{$id}{'filename'};
+ }
+ $attachurl=~m|/([^/]+)$|;
+ $$message.=' '.
+ $1.' ';
+ &Apache::lonnet::allowuploaded('/adm/feedback',
+ $attachurl);
+ } elsif (@attached > 1) {
+ $$message.='';
+ foreach (@attached) {
+ my $id = $_;
+ my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
+ my ($fname)
+ =($attachurl=~m|/([^/]+)$|);
+ $$message .= '- '.
+ $fname.'
';
+ &Apache::lonnet::allowuploaded('/adm/feedback',
+ $attachurl);
+ }
+ $$message .= ' ';
+ }
+}
+
+sub construct_attachmenturl {
+ my ($currnewattach,$keepold,$symb,$idx)=@_;
+ my $oldattachmenturl;
+ my $newattachmenturl;
+ my $startnum = 0;
+ my $currver = 0;
+ if (($env{'form.editdisc'}) && ($idx)) {
+ my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ $oldattachmenturl = $contrib{$idx.':attachmenturl'};
+ if ($contrib{$idx.':history'}) {
+ if ($contrib{$idx.':history'} =~ /:/) {
+ my @oldversions = split/:/,$contrib{$idx.':history'};
+ $currver = 1 + scalar(@oldversions);
+ } else {
+ $currver = 2;
+ }
+ } else {
+ $currver = 1;
+ }
+ if ($oldattachmenturl) {
+ if ($oldattachmenturl =~ m/^/) {
+ my %attachments = ();
+ my $prevver = $currver-1;
+ &get_post_attachments(\%attachments,$oldattachmenturl);
+ my $numattach = scalar(keys %attachments);
+ $startnum += $numattach;
+ foreach my $num (sort {$a <=> $b} keys %attachments) {
+ $newattachmenturl .= ''.$attachments{$num}{'filename'}.'';
+ foreach $_ (sort {$a <=> $b} keys %{$attachments{$num}}) {
+ unless ($_ eq 'filename') {
+ $newattachmenturl .= ''.$attachments{$num}{$_}.'';
+ }
+ }
+ if (grep/^$num$/,@{$keepold}) {
+ $newattachmenturl .= ''.$attachments{$num}{$prevver}.'';
+ }
+ $newattachmenturl .= '';
+ }
+ } else {
+ $newattachmenturl = ''.&HTML::Entities::encode($oldattachmenturl).'n';
+ unless (grep/^0$/,@{$keepold}) {
+ $newattachmenturl .= 'n';
+ }
+ $newattachmenturl .= '';
+ $startnum ++;
+ }
+ }
+ }
+ for (my $i=0; $i<@{$currnewattach}; $i++) {
+ my $attachnum = $startnum + $i;
+ $newattachmenturl .= ''.&HTML::Entities::encode($$currnewattach[$i]).'n';
+ }
+ return $newattachmenturl;
+}
+
+sub has_discussion {
+ my $resourcesref = shift;
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my @allres=$navmap->retrieveResources();
+ foreach my $resource (@allres) {
+ if ($resource->hasDiscussion()) {
+ my $ressymb = $resource->wrap_symb();
+ push @{$resourcesref}, $ressymb;
+ }
+ }
+ return;
+}
+
+sub sort_filter_names {
+ my ($sort_types,$role_types,$status_types) = @_;
+ %{$sort_types} = (
+ ascdate => 'Date order - oldest first',
+ descdate => 'Date order - newest first',
+ thread => 'Threaded',
+ subject => 'By subject',
+ username => 'By domain and username',
+ lastfirst => 'By last name, first name'
+ );
+ %{$role_types} = (
+ all => 'All roles',
+ st => 'Students',
+ cc => 'Course Coordinators',
+ in => 'Instructors',
+ ta => 'TAs',
+ ep => 'Exam proctors',
+ ad => 'Administrators',
+ cr => 'Custom roles'
+ );
+ %{$status_types} = (
+ all => 'Roles of any status',
+ Active => 'Only active roles',
+ Expired => 'Only inactive roles'
+ );
+}
+
+sub handler {
+ my $r = shift;
+ if ($r->header_only) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ return OK;
+ }
+
+# --------------------------- Get query string for limited number of parameters
+
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export']);
+ if ($env{'form.editdisc'}) {
+ if (!(&editing_allowed())) {
+ my $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0];
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
+ my $feedurl=&Apache::lonnet::clutter($url);
+ &redirect_back($r,$feedurl,&mt('Editing not permitted').' ', '0','0','','',$env{'form.previous'},'','','',);
+ return OK;
+ }
+ }
+ if ($env{'form.discsymb'}) {
+ my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.discsymb'});
+ my $readkey = $symb.'_read';
+ my $chgcount = 0;
+ my %readinghash = &Apache::lonnet::get('nohist_'.$env{'request.course.id'}.'_discuss',[$readkey],$env{'user.domain'},$env{'user.name'});
+ foreach my $key (keys %env) {
+ if ($key =~ m/^form\.postunread_(\d+)/) {
+ if ($readinghash{$readkey} =~ /\.$1\./) {
+ $readinghash{$readkey} =~ s/\.$1\.//;
+ $chgcount ++;
+ }
+ } elsif ($key =~ m/^form\.postread_(\d+)/) {
+ unless ($readinghash{$readkey} =~ /\.$1\./) {
+ $readinghash{$readkey} .= '.'.$1.'.';
+ $chgcount ++;
+ }
+ }
+ }
+ if ($chgcount > 0) {
+ &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
+ \%readinghash,$env{'user.domain'},$env{'user.name'});
+ }
+ &redirect_back($r,$feedurl,&mt('Marked postings read/unread').' ',
+ '0','0','','',$env{'form.previous'},'','','',);
+ return OK;
+ }
+ if ($env{'form.allversions'}) {
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+
+ $r->print(&Apache::loncommon::start_page('Discussion Post Versions'));
+
+ my $crs='/'.$env{'request.course.id'};
+ if ($env{'request.course.sec'}) {
+ $crs.='_'.$env{'request.course.sec'};
+ }
+ $crs=~s|_|/|g;
+ my $seeid=&Apache::lonnet::allowed('rin',$crs);
+ my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'});
+ ($symb)=&get_feedurl_and_clean_symb($symb);
+ if ($idx > 0) {
+ my %messages = ();
+ my %subjects = ();
+ my %attachmsgs = ();
+ my %allattachments = ();
+ my %imsfiles = ();
+ my ($screenname,$plainname);
+ my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ $r->print(&get_post_contents(\%contrib,$idx,$seeid,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname));
+ }
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
+ }
+ if ($env{'form.posterlist'}) {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'});
+ &print_showposters($r,$symb,$env{'form.previous'},$feedurl,
+ $env{'form.sortposts'});
+ return OK;
+ }
+ if ($env{'form.userpick'}) {
+ my @posters = &Apache::loncommon::get_env_multiple('form.stuinfo');
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.userpick'});
+ my $numpicks = @posters;
+ my %discinfo;
+ $discinfo{$symb.'_userpick'} = join('&',@posters);
+ &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
+ \%discinfo,$env{'user.domain'},$env{'user.name'});
+ &redirect_back($r,$feedurl,&mt('Changed sort/filter').' ','0','0','',
+ '',$env{'form.previous'},$env{'form.sortposts'},'','','',
+ $numpicks);
+ return OK;
+ }
+ if ($env{'form.applysort'}) {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'});
+ &redirect_back($r,$feedurl,&mt('Changed sort/filter').' ','0','0','',
+ '',$env{'form.previous'},$env{'form.sortposts'},
+ $env{'form.rolefilter'},$env{'form.statusfilter'},
+ $env{'form.sectionpick'});
+ return OK;
+ } elsif ($env{'form.cmd'} eq 'sortfilter') {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
+ &print_sortfilter_options($r,$symb,$env{'form.previous'},$feedurl);
+ return OK;
+ } elsif ($env{'form.navtime'}) {
+ my %discinfo = ();
+ my @resources = ();
+ if (defined($env{'form.navmaps'})) {
+ if ($env{'form.navmaps'} =~ /:/) {
+ @resources = split/:/,$env{'form.navmaps'};
+ } else {
+ @resources = ("$env{'form.navmaps'}");
+ }
+ } else {
+ &has_discussion(\@resources);
+ }
+ my $numitems = @resources;
+ my $feedurl = '/adm/navmaps';
+ if ($env{'form.navurl'}) { $feedurl .= '?'.$env{'form.navurl'}; }
+ my %lt = &Apache::lonlocal::texthash(
+ 'mnpa' => 'Marked "New" posts as read in a total of',
+ 'robb' => 'resources/bulletin boards.',
+ 'twnp' => 'There are currently no resources or bulletin boards with unread discussion postings.'
+ );
+ foreach (@resources) {
+ my $ressymb=$_;
+ &Apache::lonenc::check_decrypt(\$ressymb);
+ my $lastkey = $ressymb.'_lastread';
+ $discinfo{$lastkey} = $env{'form.navtime'};
+ }
+ my $textline = "$lt{'mnpa'} $numitems $lt{'robb'}";
+ if ($numitems > 0) {
+ &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
+ \%discinfo,$env{'user.domain'},$env{'user.name'});
+ } else {
+ $textline = "$lt{'twnp'}";
+ }
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
+ my $onload = 'onLoad=\'if (window.name!="loncapaclient") { this.document.reldt.submit(); self.window.close(); }\'';
+ my $start_page=
+ &Apache::loncommon::start_page('New posts marked as read',undef,
+ {'redirect' => [2,$feedurl],
+ 'only_body' => 1,
+ 'add_entries' => $onload});
+ my $end_page = &Apache::loncommon::end_page();
+ $r->print (<
+$textline
+
+
+$end_page
+ENDREDIR
+ return OK;
+ } elsif ($env{'form.modifydisp'}) {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'});
+ my ($dispchgA,$dispchgB,$markchg,$toggchg) =
+ split(/_/,$env{'form.changes'});
+ &print_display_options($r,$symb,$env{'form.previous'},$dispchgA,
+ $dispchgB,$markchg,$toggchg,$feedurl);
+ return OK;
+ } elsif ($env{'form.markondisp'} || $env{'form.markonread'} ||
+ $env{'form.allposts'} || $env{'form.onlyunread'} ||
+ $env{'form.onlyunmark'} || $env{'form.toggoff'} ||
+ $env{'form.toggon'} || $env{'form.markread'}) {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
+ my %discinfo;
+# ------------------------ Modify setting for read/unread toggle for each post
+ if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; }
+ if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; }
+# --------- Modify setting for identification of 'NEW' posts in this discussion
+ if ($env{'form.markondisp'}) {
+ $discinfo{$symb.'_lastread'} = time;
+ $discinfo{$symb.'_markondisp'} = 1;
+ }
+ if ($env{'form.markonread'}) {
+ if ( $env{'form.previous'} > 0 ) {
+ $discinfo{$symb.'_lastread'} = $env{'form.previous'};
+ }
+ $discinfo{$symb.'_markondisp'} = 0;
+ }
+# --------------------------------- Modify display setting for this discussion
+ if ($env{'form.allposts'}) {
+ $discinfo{$symb.'_showonlyunread'} = 0;
+ $discinfo{$symb.'_showonlyunmark'} = 0;
+ }
+ if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; }
+ if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; }
+# ----------------------------------------------------- Mark new posts not NEW
+ if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; }
+ &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
+ \%discinfo,$env{'user.domain'},$env{'user.name'});
+ my $previous=$env{'form.previous'};
+ if ($env{'form.markondisp'}) { $previous=undef; }
+ &redirect_back($r,$feedurl,&mt('Changed display status').' ',
+ '0','0','','',$previous);
+ return OK;
+ } elsif (($env{'form.hide'}) || ($env{'form.unhide'})) {
+# ----------------------------------------------------------------- Hide/unhide
+ my $entry=$env{'form.hide'}?$env{'form.hide'}:$env{'form.unhide'};
+ my ($symb,$idx)=split(/\:\:\:/,$entry);
+ ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb);
+
+ my $crs='/'.$env{'request.course.id'};
+ if ($env{'request.course.sec'}) {
+ $crs.='_'.$env{'request.course.sec'};
+ }
+ $crs=~s/\_/\//g;
+ my $seeid=&Apache::lonnet::allowed('rin',$crs);
+
+ if ($env{'form.hide'} && !$seeid && !(&editing_allowed())) {
+ &redirect_back($r,$feedurl,&mt('Deletion not permitted').' ', '0','0','','',$env{'form.previous'},'','','',);
+ return OK;
+ }
+
+ my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+
+ my $currenthidden=$contrib{'hidden'};
+ my $currentstudenthidden=$contrib{'studenthidden'};
+
+ if ($env{'form.hide'}) {
+ $currenthidden.='.'.$idx.'.';
+ unless ($seeid) {
+ $currentstudenthidden.='.'.$idx.'.';
+ }
+ } else {
+ $currenthidden=~s/\.$idx\.//g;
+ }
+ my %newhash=('hidden' => $currenthidden);
+ if ( ($env{'form.hide'}) && (!$seeid) ) {
+ $newhash{'studenthidden'} = $currentstudenthidden;
+ }
+
+ &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+
+ &redirect_back($r,$feedurl,&mt('Changed discussion status').' ',
+ '0','0','','',$env{'form.previous'});
+ return OK;
+ } elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) {
+ my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
+ if ($env{'form.cmd'} eq 'threadedon') {
+ &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
+ &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
+ } else {
+ &Apache::lonnet::del('environment',['threadeddiscussion']);
+ &Apache::lonnet::delenv('environment\.threadeddiscussion');
+ }
+ &redirect_back($r,$feedurl,&mt('Changed discussion view mode').' ',
+ '0','0','','',$env{'form.previous'});
+ return OK;
+ } elsif ($env{'form.deldisc'}) {
+# --------------------------------------------------------------- Hide for good
+ my ($symb,$idx)=split(/\:\:\:/,$env{'form.deldisc'});
+ ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb);
+ my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ my %newhash=('deleted' => $contrib{'deleted'}.".$idx.");
+ &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ &redirect_back($r,$feedurl,&mt('Changed discussion status').' ',
+ '0','0','','',$env{'form.previous'});
+ return OK;
+ } elsif ($env{'form.preview'}) {
+# -------------------------------------------------------- User wants a preview
+ &show_preview($r);
+ return OK;
+ } elsif ($env{'form.attach'}) {
+# -------------------------------------------------------- Work on attachments
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','anondiscuss','discuss','blog']);
+ my (@currnewattach,@currdelold,@keepold);
+ &process_attachments(\@currnewattach,\@currdelold,\@keepold);
+ if (exists($env{'form.addnewattach.filename'})) {
+ unless (length($env{'form.addnewattach'})>131072) {
+ my $subdir = 'feedback/'.$env{'form.timestamp'};
+ my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir);
+ push @currnewattach, $newattachment;
+ }
+ }
+ my $attachmenturls;
+ my ($symb) = &get_feedurl_and_clean_symb($env{'form.attach'});
+ my $idx = $env{'form.idx'};
+ if ($idx) {
+ my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ $attachmenturls = $contrib{$idx.':attachmenturl'};
+ }
+ &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx,
+ $attachmenturls);
+ return OK;
+ } elsif ($env{'form.export'}) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.export'});
+ my $mode='board';
+ my $status='OPEN';
+ my $previous=$env{'form.previous'};
+ if ($feedurl =~ /\.(problem|exam|quiz|assess|survey|form|library|task)$/) {
+ $mode='problem';
+ $status=$Apache::inputtags::status[-1];
+ }
+ my $discussion = &list_discussion($mode,$status,$symb);
+ my $start_page =
+ &Apache::loncommon::start_page('Resource Feedback and Discussion');
+ my $end_page =
+ &Apache::loncommon::end_page();
+ $r->print($start_page.$discussion.$end_page);
+ return OK;
+ } else {
+# ------------------------------------------------------------- Normal feedback
+ my $feedurl=$env{'form.postdata'};
+ $feedurl=~s/^http\:\/\///;
+ $feedurl=~s/^$ENV{'SERVER_NAME'}//;
+ $feedurl=~s/^$ENV{'HTTP_HOST'}//;
+ $feedurl=~s/\?.+$//;
+
+ my $symb;
+ if ($env{'form.replydisc'}) {
+ $symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0];
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
+ $feedurl=&Apache::lonnet::clutter($url);
+ } elsif ($env{'form.editdisc'}) {
+ $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0];
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
+ $feedurl=&Apache::lonnet::clutter($url);
+ } elsif ($env{'form.origpage'}) {
+ $symb="";
+ } else {
+ $symb=&Apache::lonnet::symbread($feedurl);
+ }
+ unless ($symb) {
+ $symb=$env{'form.symb'};
+ if ($symb) {
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
+ $feedurl=&Apache::lonnet::clutter($url);
+ }
+ }
+ &Apache::lonenc::check_decrypt(\$symb);
+ my $goahead=1;
+ if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form|task)$/) {
+ unless ($symb) { $goahead=0; }
+ }
+ # backward compatibility (bulletin boards used to be 'wrapped')
+ &dewrapper(\$feedurl);
+ if (!$goahead) {
+ # Ambiguous Problem Resource
+ $r->internal_redirect('/adm/ambiguous');
+ return OK;
+ }
+# Go ahead with feedback, no ambiguous reference
+ unless (
+ (
+ ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
+ )
+ ||
+ ($env{'request.course.id'} && ($feedurl!~m:^/adm:))
+ ||
+ ($env{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
+ ) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+# Unable to give feedback
+ &no_redirect_back($r,$feedurl);
+ return OK;
+ }
+# --------------------------------------------------- Print login screen header
+ unless ($env{'form.sendit'}) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ my $options=&screen_header($feedurl,$symb);
+ if ($options) {
+ &mail_screen($r,$feedurl,$options);
+ } else {
+ &fail_redirect($r,$feedurl);
+ }
+ return OK;
+ }
+
+# Get previous user input
+ my $prevattempts=&Apache::loncommon::get_previous_attempt(
+ $symb,$env{'user.name'},$env{'user.domain'},
+ $env{'request.course.id'});
+
+# Get output from resource
+ my $usersaw=&resource_output($feedurl);
+
+# Get resource answer (need to allow student to view grades for this to work)
+ &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
+ my $useranswer=&Apache::loncommon::get_student_answers(
+ $symb,$env{'user.name'},$env{'user.domain'},
+ $env{'request.course.id'});
+ &Apache::lonnet::delenv('allowed.vgr');
+# Get attachments, if any, and not too large
+ my $attachmenturl='';
+ if (($env{'form.origpage'}) || ($env{'form.editdisc'}) ||
+ ($env{'form.replydisc'})) {
+ my ($symb,$idx);
+ if ($env{'form.replydisc'}) {
+ ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'});
+ } elsif ($env{'form.editdisc'}) {
+ ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'});
+ } elsif ($env{'form.origpage'}) {
+ $symb = $env{'form.symb'};
+ }
+ &Apache::lonenc::check_decrypt(\$symb);
+ my @currnewattach = ();
+ my @deloldattach = ();
+ my @keepold = ();
+ &process_attachments(\@currnewattach,\@deloldattach,\@keepold);
+ $symb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
+ $attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx);
+ } elsif ($env{'form.attachment.filename'}) {
+ unless (length($env{'form.attachment'})>131072) {
+ $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback');
+ }
+ }
+# Filter HTML out of message (could be nasty)
+ my $message=&clear_out_html($env{'form.comment'});
+
+# Assemble email
+ my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
+ $usersaw,$useranswer);
+
+# Who gets this?
+ my ($typestyle,%to) = &decide_receiver($feedurl);
+
+# Actually send mail
+ my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}),$feedurl,$email,$citations,
+ $attachmenturl,%to);
+
+# Discussion? Store that.
+
+ my $numpost=0;
+ if ($env{'form.discuss'} || $env{'form.anondiscuss'}) {
+ my $subject = &clear_out_html($env{'form.subject'});
+ my $anonmode=(defined($env{'form.anondiscuss'}));
+ $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl,
+ $subject);
+ $numpost++;
+ }
+
+# Add to blog?
+
+ my $blog='';
+ if ($env{'form.blog'}) {
+ my $subject = &clear_out_html($env{'form.subject'});
+ $status.=&Apache::lonrss::addentry($env{'user.name'},
+ $env{'user.domain'},
+ 'CourseBlog_'.$env{'request.course.id'},
+ $subject,$message,$feedurl,'public');
+ $blog=' '.&mt('Added to my course blog').' ';
+ }
+
+# Receipt screen and redirect back to where came from
+ &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'});
+ }
+ return OK;
}
+sub wrap_symb {
+ my ($ressymb)=@_;
+ if ($ressymb =~ /bulletin___\d+___/) {
+ unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
+ $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
+ }
+ }
+ return $ressymb;
+}
+sub dewrapper {
+ my ($feedurl)=@_;
+ if ($$feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
+ $$feedurl=~s|^/adm/wrapper||;
+ }
+}
+
+sub get_feedurl {
+ my ($symb)=@_;
+ my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
+ my $feedurl = &Apache::lonnet::clutter($url);
+ &dewrapper(\$feedurl);
+ return $feedurl;
+}
+
+sub get_feedurl_and_clean_symb {
+ my ($symb)=@_;
+ &Apache::lonenc::check_decrypt(\$symb);
+# backward compatibility (bulletin boards used to be 'wrapped')
+ unless ($symb =~ m|bulletin___\d+___adm/wrapper|) {
+ $symb=~s|(bulletin___\d+___)|$1adm/wrapper|;
+ }
+ my $feedurl = &get_feedurl($symb);
+ return ($symb,$feedurl);
+}
+
+sub editing_allowed {
+ my $can_edit = 0;
+ my $cid = $env{'request.course.id'};
+ my $role = (split(/\./,$env{'request.role'}))[0];
+ my $section = $env{'request.course.sec'};
+ my $allow_editing_config =
+ $env{'course.'.$cid.'.allow_discussion_post_editing'};
+ if ($allow_editing_config =~ m/^\s*yes\s*$/i) {
+ $can_edit = 1;
+ } else {
+ foreach my $editor (split(/,/,$allow_editing_config)) {
+ my ($editor_role,$editor_sec) = split(/:/,$editor);
+ if ($editor_role eq $role
+ && defined($editor_sec)
+ && defined($section)
+ && $editor_sec eq $section) {
+ $can_edit = 1;
+ last;
+ }
+ if ($editor_role eq $role
+ && !defined($editor_sec)) {
+ $can_edit = 1;
+ }
+ }
+ }
+ return $can_edit;
+}
+
1;
__END__
|