| … | |
… | |
| 440 | # FIXME: drunk code. rewrite. |
440 | # FIXME: drunk code. rewrite. |
| 441 | # also, this should be structured s.t. subclasses can add items to the links |
441 | # also, this should be structured s.t. subclasses can add items to the links |
| 442 | # area, i.e. "stacking" |
442 | # area, i.e. "stacking" |
| 443 | sub links { |
443 | sub links { |
| 444 | my $self = shift; |
444 | my $self = shift; |
|
|
445 | my @components = @_; |
| 445 | my $ce = $self->{ce}; |
446 | my $ce = $self->{ce}; |
| 446 | my $db = $self->{db}; |
447 | my $db = $self->{db}; |
| 447 | my $userName = $self->{r}->param("user"); |
448 | my $userName = $self->{r}->param("user"); |
| 448 | my $courseName = $ce->{courseName}; |
449 | my $courseName = $ce->{courseName}; |
| 449 | my $root = $ce->{webworkURLs}->{root}; |
450 | my $root = $ce->{webworkURLs}->{root}; |
| … | |
… | |
| 452 | return "" unless defined $key; |
453 | return "" unless defined $key; |
| 453 | |
454 | |
| 454 | # URLs to parts of the system |
455 | # URLs to parts of the system |
| 455 | my $probSets = "$root/$courseName/?" . $self->url_authen_args(); |
456 | my $probSets = "$root/$courseName/?" . $self->url_authen_args(); |
| 456 | my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); |
457 | my $prefs = "$root/$courseName/options/?" . $self->url_authen_args(); |
| 457 | my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args(); |
|
|
| 458 | my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args(); |
|
|
| 459 | my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args(); |
|
|
| 460 | my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args(); |
|
|
| 461 | my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); |
458 | my $help = "$ce->{webworkURLs}->{docs}?" . $self->url_authen_args(); |
| 462 | my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); |
459 | my $logout = "$root/$courseName/logout/?" . $self->url_authen_args(); |
| 463 | |
460 | |
| 464 | return join("", |
461 | return join("", |
| 465 | CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), |
462 | CGI::a({-href=>$probSets}, "Problem Sets"), CGI::br(), |
| 466 | CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(), |
463 | CGI::a({-href=>$prefs}, "User Prefs"), CGI::br(), |
| 467 | CGI::a({-href=>$help}, "Help"), CGI::br(), |
464 | CGI::a({-href=>$help}, "Help"), CGI::br(), |
| 468 | CGI::a({-href=>$logout}, "Log Out"), CGI::br(), |
465 | CGI::a({-href=>$logout}, "Log Out"), CGI::br(), |
| 469 | ($permLevel > 0 |
466 | ($permLevel > 0 |
|
|
467 | ? $self->instructor_links(@components) : "" |
|
|
468 | ), |
|
|
469 | ); |
|
|
470 | } |
|
|
471 | sub instructor_links { |
|
|
472 | my $self = shift; |
|
|
473 | my @components = @_; |
|
|
474 | my $args = pop(@components); # get hash of option arguments |
|
|
475 | my $courseName = $self->{ce}->{courseName}; |
|
|
476 | my $root = $self->{ce}->{webworkURLs}->{root}; |
|
|
477 | |
|
|
478 | my $instructor = "$root/$courseName/instructor/?" . $self->url_authen_args(); |
|
|
479 | my $sets = "$root/$courseName/instructor/sets/?" . $self->url_authen_args(); |
|
|
480 | my $users = "$root/$courseName/instructor/users/?" . $self->url_authen_args(); |
|
|
481 | my $email = "$root/$courseName/instructor/send_mail/?" . $self->url_authen_args(); |
|
|
482 | my ($set, $prob) = @components; |
|
|
483 | # Add direct links to sets e.g. 3:4 for set3 problem 4 |
|
|
484 | my $setURL = (defined($set)) ? "$root/$courseName/instructor/sets/$set/?" . |
|
|
485 | $self->url_authen_args() : ''; |
|
|
486 | my $probURL = (defined($set) && defined($prob)) ? "$root/$courseName/instructor/pgProblemEditor/$set/$prob?" . |
|
|
487 | $self->url_authen_args() : ''; |
|
|
488 | my $setProb = ($setURL) ? CGI::a({-href=>$setURL},$set ) : ''; |
|
|
489 | |
|
|
490 | $setProb .= ':'.CGI::a({-href=>$probURL},$prob) if $setProb && $probURL; |
| 470 | ? join("", |
491 | join("", |
| 471 | CGI::hr(), |
492 | CGI::hr(), |
| 472 | CGI::a({-href=>$instructor}, "Instructor") , CGI::br(), |
493 | CGI::a({-href=>$instructor}, "Instructor") , CGI::br(), |
| 473 | ' ',CGI::a({-href=>$sets}, "Set List") , CGI::br(), |
494 | ' ',CGI::a({-href=>$sets}, "Set List") ," ", $setProb, CGI::br(), |
| 474 | ' ',CGI::a({-href=>$users}, "Class List") , CGI::br(), |
495 | ' ',CGI::a({-href=>$users}, "Class List") , CGI::br(), |
| 475 | ' ',CGI::a({-href=>$email}, "Send Email") , CGI::br(), |
496 | ' ',CGI::a({-href=>$email}, "Send Email") , CGI::br(), |
| 476 | |
497 | |
| 477 | ) : "" |
|
|
| 478 | ), |
|
|
| 479 | ); |
498 | ) |
| 480 | } |
|
|
| 481 | |
499 | |
|
|
500 | } |
| 482 | # &if_can will return 1 if the current object->can("do $_[1]") |
501 | # &if_can will return 1 if the current object->can("do $_[1]") |
| 483 | sub if_can ($$) { |
502 | sub if_can ($$) { |
| 484 | my ($self, $arg) = (@_); |
503 | my ($self, $arg) = (@_); |
| 485 | |
504 | |
| 486 | if ($self->can("$arg")) { |
505 | if ($self->can("$arg")) { |
Parent Directory
| 
Revision Log
| 
Patch