File:  [LON-CAPA] / loncom / interface / lontiny.pm
Revision 1.1: download - view: text, annotated - select for diffs
Fri Jan 12 13:33:38 2018 UTC (6 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Bug 6400 Tiny URL for deep-linking.
  Requires Short::URL and String::CRC32 modules from CPAN. Dependency on
  perl-Short-URL needs to be added to LONCAPA-prerequisites.

    1: # The LearningOnline Network with CAPA
    2: # Extract domain, courseID, and symb from a shortened URL,
    3: # and switch role to a role in designated course.
    4: #
    5: # $Id: lontiny.pm,v 1.1 2018/01/12 13:33:38 raeburn Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: 
   30: package Apache::lontiny;
   31: 
   32: use strict;
   33: use Apache::Constants qw(:common :http);
   34: use Apache::lonnet;
   35: use Apache::loncommon;
   36: use Apache::lonhtmlcommon;
   37: use Apache::lonroles;
   38: use Apache::lonlocal;
   39: use LONCAPA qw(:DEFAULT :match);
   40: 
   41: sub handler {
   42:     my $r = shift;
   43:     my %user;
   44:     my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
   45:     if ($handle ne '') { 
   46:         if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
   47:             my ($cdom,$key) = ($1,$2);
   48:             if (&Apache::lonnet::domain($cdom) ne '') {
   49:                 my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
   50:                 my $tinyurl;
   51:                 my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
   52:                 if (defined($cached)) {
   53:                     $tinyurl = $result;
   54:                 } else {
   55:                     my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
   56:                     if ($currtiny{$key} ne '') {
   57:                         $tinyurl = $currtiny{$key};
   58:                         &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
   59:                     }
   60:                 }
   61:                 if ($tinyurl) {
   62:                     my ($cnum,$symb) = split(/\&/,$tinyurl);
   63:                     if ($cnum =~ /^$match_courseid$/) {
   64:                         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
   65:                         if ($chome ne 'no_host') {
   66:                             my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
   67:                             my @possroles = ('in','ta','ep','st','cr','ad');
   68:                             if ($crsenv{'type'} eq 'Community') {
   69:                                 unshift(@possroles,'co');
   70:                             } else {
   71:                                 unshift(@possroles,'cc');
   72:                             }
   73:                             my %roleshash = &Apache::lonnet::get_my_roles($env{'user.uname'},
   74:                                                                           $env{'user.domain'},
   75:                                                                           'userroles',undef,
   76:                                                                           \@possroles,[$cdom],1);
   77:                             my (%possroles,$hassection);
   78:                             if (keys(%roleshash)) {
   79:                                 foreach my $entry (keys(%roleshash)) {
   80:                                     if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
   81:                                         $possroles{$1} = $2;
   82:                                         if ($2 ne '') {
   83:                                             $hassection = 1;
   84:                                         }
   85:                                     }
   86:                                 }
   87:                             }
   88:                             my @allposs = keys(%possroles);
   89:                             if (@allposs == 0) {
   90:                                 &show_roles($r,\%crsenv,\%possroles)
   91:                             } elsif (@allposs == 1) {
   92:                                 my $newrole = "$allposs[0]./$cdom/$cnum";
   93:                                 $newrole = "$allposs[0]./$cdom/$cnum";
   94:                                 if ($possroles{$allposs[0]} ne '') {
   95:                                     $newrole .= "/$possroles{$allposs[0]}"; 
   96:                                 }
   97:                                 my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
   98:                                                    '&destinationurl='.&HTML::Entities::encode($r->uri);
   99:                                 &do_redirect($r,$destination);
  100:                             } elsif (keys(%possroles) > 1) {
  101:                                 if (grep(/^(cc|co)$/,@allposs)) {
  102:                                     my $newrole;
  103:                                     if (exists($possroles{'cc'})) {
  104:                                         $newrole = 'cc';
  105:                                     } else {
  106:                                         $newrole = 'co';
  107:                                     }
  108:                                     $newrole .= "./$cdom/$cnum";
  109:                                     my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  110:                                                        '&destinationurl='.&HTML::Entities::encode($r->uri);
  111:                                     &do_redirect($r,$destination);
  112:                                 } else {
  113:                                     my $hascustom;
  114:                                     if (grep(/^cr\//,@allposs)) {
  115:                                         $hascustom = 1;
  116:                                     }
  117:                                     &show_roles($r,\%crsenv,\%possroles,$hassection,$hascustom);
  118:                                 }
  119:                             }
  120:                             return OK;
  121:                         }
  122:                     }
  123:                 }
  124:             }
  125:         }
  126:         &generic_error($r);
  127:         return OK;
  128:     } else {
  129:         return FORBIDDEN;
  130:     }
  131: }
  132: 
  133: sub do_redirect {
  134:     my ($r,$destination) = @_;
  135:     my $windowinfo = Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";');
  136:     my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
  137:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
  138:     &Apache::loncommon::content_type($r,'text/html');
  139:     $r->send_http_header;
  140:     $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
  141:               &Apache::lonhtmlcommon::scripttag('self.name="loncapaclient";').
  142:               '<h1>'.&mt('Welcome').'</h1>'.
  143:               '<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
  144:               '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
  145:               &Apache::loncommon::end_page());
  146:     return;
  147: }
  148: 
  149: sub show_roles {
  150:     my ($r,$crsenv,$possroles,$hassection,$hascustom) = @_;
  151:     &Apache::loncommon::content_type($r,'text/html');
  152:     $r->send_http_header;
  153:     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
  154:     if (ref($crsenv) eq 'HASH') {
  155:         $crsdesc = $crsenv->{'description'};
  156:         $crstype = $crsenv->{'type'};
  157:         $cdom = $crsenv->{'domain'};
  158:         $cnum = $crsenv->{'num'};
  159:     }
  160:     if ($crstype eq '') {
  161:         $crstype = 'Course';
  162:     }
  163:     my $lc_crstype = lc($crstype);
  164:     if ($crsdesc ne '') {
  165:         $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
  166:                       '<i>'.$crsdesc.'</i>');
  167:     }
  168:     if (ref($possroles) eq 'HASH') {
  169:         if (keys(%{$possroles}) > 0) {
  170:             $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
  171:             $title = 'Choose a role'; #Do not localize.
  172:             if ($crstype eq 'Community') {
  173:                 $preamble = &mt('You have the following active roles in this community:');
  174:             } else { 
  175:                 $preamble = &mt('You have the following active roles in this course:');
  176:             }
  177:             $datatable = '<form name="" action="/adm/roles">'.
  178:                          '<input type="hidden" name="newrole" value="" />'.
  179:                          '<input type="hidden" name="selectrole" value="1" />'.
  180:                          '<input type="hidden" name="destinationurl" value="'.$r->uri.'" />'.
  181:                          &Apache::loncommon::start_data_table().
  182:                          &Apache::loncommon::start_data_table_header_row().
  183:                          '<th></th><th>'.&mt('User role').'</th>';
  184:             if ($hassection) {
  185:                 $datatable .= '<th>'.&mt('Section').'</th>';
  186:             }
  187:             if ($hascustom) {
  188:                 $datatable .= '<th>'.&mt('Information').'</th>';
  189:             }
  190:             $datatable .= &Apache::loncommon::end_data_table_header_row();
  191:             my @available = sort(keys(%{$possroles}));
  192:             foreach my $role ('ad','in','ta','ep','st','cr') {
  193:                 foreach my $key (@available) {
  194:                     if ($key =~ m{^$role($|/)}) {
  195:                         my $trolecode = "$key./$cdom/$cnum";
  196:                         my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
  197:                         my $sec = $possroles->{$key};
  198:                         if ($sec ne '') {
  199:                             $trolecode .= '/'.$sec;
  200:                         }
  201:                         my $buttonname=$trolecode;
  202:                         $buttonname=~s/\W//g;
  203:                         $datatable .= &Apache::loncommon::start_data_table_row().
  204:                                       '<td><input name="'.$buttonname.'" type="button" value="'.
  205:                                       &mt('Select').'" onclick="javascript:enterrole(this.form,'.
  206:                                       "'$trolecode','$buttonname'".');" /></td>';
  207:                         if ($key =~ /^cr\//) {
  208:                             my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
  209:                             $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
  210:                             if ($hassection) {
  211:                                 $datatable .= '<td>'.$sec.'</td>';
  212:                             }
  213:                             $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
  214:                                           &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
  215:                                           '</td>';
  216:                         } else {
  217:                             if ($hassection) {
  218:                                 $datatable .= '<td>'.$rolename.'</td>';
  219:                                 if ($hascustom) {
  220:                                     $datatable .= '<td colspan="2">'.$sec.'</td>';
  221:                                 } else {
  222:                                     $datatable .= '<td>'.$sec.'</td>';
  223:                                 }
  224:                             } elsif ($hascustom) {
  225:                                 $datatable .= '<td colspan="2">'.$rolename.'</td>';
  226:                             } else {
  227:                                 $datatable .= '<td>'.$rolename.'</td>';
  228:                             }
  229:                         }
  230:                         $datatable .= &Apache::loncommon::end_data_table_row();
  231:                     }
  232:                 }
  233:             }
  234:             $datatable .= &Apache::loncommon::end_data_table().
  235:                           '</form>';
  236:             my $standby = &mt('Role selected. Please stand by.');
  237:             $js = <<"ENDJS";
  238: <script type="text/javascript">
  239: // <![CDATA[
  240: 
  241: active=true;
  242: 
  243: function enterrole (thisform,rolecode,buttonname) {
  244:     if (active) {
  245:         active=false;
  246:         document.title='$standby';
  247:         window.status='$standby';
  248:         thisform.newrole.value=rolecode;
  249:         thisform.submit();
  250:     } else {
  251:        alert('$standby');
  252:     }
  253: }
  254: 
  255: // ]]>
  256: </script>
  257: ENDJS
  258:         } else {
  259:             $title = 'No active role';
  260:             $preamble = &mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.");
  261:             $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
  262:         }
  263:     }
  264:     &Apache::loncommon::content_type($r,'text/html');
  265:     $r->send_http_header;
  266:     $r->print(&Apache::loncommon::start_page($title,$js,$args).
  267:               '<h3>'.$header.'</h3>'.
  268:               '<div>'.$preamble.'</div>'.
  269:               $datatable.
  270:               &Apache::loncommon::end_page());
  271:     return;
  272: }
  273: 
  274: sub generic_error {
  275:     my ($r) = @_;
  276:     my $linktext;
  277:     if ($env{'user.adv'}) {
  278:         $linktext = &mt('Continue to your roles page');
  279:     } else {
  280:         $linktext = &mt('Continue to your courses page');
  281:     }
  282:     my $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
  283:     my $msg = &mt('The page you requested does not exist.');
  284:     &Apache::loncommon::content_type($r,'text/html');
  285:     $r->send_http_header;
  286:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
  287:     $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
  288:               '<div class="LC_error">'.$msg.'</div>'.
  289:               '<p>'.$continuelink.'</p>'.
  290:               &Apache::loncommon::end_page());
  291:     return;
  292: }
  293: 
  294: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>