[system] / branches / rel-2-1-patches / webwork-modperl / lib / WeBWorK / ContentGenerator.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-1-patches/webwork-modperl/lib/WeBWorK/ContentGenerator.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1865 Revision 1866
1################################################################################ 1################################################################################
2# WeBWorK Online Homework Delivery System 2# WeBWorK Online Homework Delivery System
3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 3# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.79 2004/03/06 18:50:00 gage Exp $ 4# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v 1.80 2004/03/06 21:49:32 sh002i Exp $
5# 5#
6# This program is free software; you can redistribute it and/or modify it under 6# This program is free software; you can redistribute it and/or modify it under
7# the terms of either: (a) the GNU General Public License as published by the 7# the terms of either: (a) the GNU General Public License as published by the
8# Free Software Foundation; either version 2, or (at your option) any later 8# Free Software Foundation; either version 2, or (at your option) any later
9# version, or (b) the "Artistic License" which comes with this package. 9# version, or (b) the "Artistic License" which comes with this package.
… …
36=cut 36=cut
37 37
38use strict; 38use strict;
39use warnings; 39use warnings;
40use Apache::Constants qw(:common); 40use Apache::Constants qw(:common);
41use CGI qw(); 41use CGI qw(*ul *li);
42use URI::Escape; 42use URI::Escape;
43use WeBWorK::Authz; 43use WeBWorK::Authz;
44use WeBWorK::DB; 44use WeBWorK::DB;
45use WeBWorK::Utils qw(readFile); 45use WeBWorK::Utils qw(readFile);
46 46
… …
583 CGI::h3("Warning messages"), 583 CGI::h3("Warning messages"),
584 CGI::ul(CGI::li(\@warnings)), 584 CGI::ul(CGI::li(\@warnings)),
585 ; 585 ;
586} 586}
587 587
588=item systemLink($urlpath, %options)
589
590Generate a link to another part of the system. $urlpath is WeBWorK::URLPath
591object from which the base path will be taken. %options can consist of:
592
593=over
594
595=item authen
596
597Boolen, whether to include authentication information in the resulting URL. If
598not given, a true value is assumed.
599
600=item realUserID
601
602If C<authen> is true, the current real user ID is replaced with this value.
603
604=item sessionKey
605
606If C<authen> is true, the current session key is replaced with this value.
607
608=item effectiveUserID
609
610If C<authen> is true, the current effective user ID is replaced with this value.
611
612=back
613
614=cut
615
616sub systemLink {
617 my ($self, $urlpath, %options) = @_;
618 my $r = $self->{r};
619
620 my $authen = $options{authen} || 1;
621
622 my $url = $r->location . $urlpath->path;
623
624 if ($authen) {
625 my $realUserID = $options{realUserID} || $r->param("user");
626 my $sessionKey = $options{sessionKey} || $r->param("key");
627 my $effectiveUserID = $options{effectiveUserID} || $r->param("effectiveUser");
628
629 my @params;
630 defined $realUserID and push @params, "user=$realUserID";
631 defined $sessionKey and push @params, "key=$sessionKey";
632 defined $effectiveUserID and push @params, "effectiveUser=$effectiveUserID";
633
634 $url .= "?" . join("&", @params) if @params;
635 }
636
637 return $url;
638}
639
588=back 640=back
589 641
590=cut 642=cut
591 643
592################################################################################ 644################################################################################
… …
649Links that should appear on every page. Defined in WeBWorK::ContentGenerator by 701Links that should appear on every page. Defined in WeBWorK::ContentGenerator by
650default. 702default.
651 703
652=cut 704=cut
653 705
706sub links {
707 my ($self) = @_;
708 my $r = $self->{r};
709 my $db = $r->db;
710 my $urlpath = $r->urlpath;
711
712 # we're linking to other places in the same course, so grab the courseID from the current path
713 my $courseID = $urlpath->arg("courseID");
714
715 # to make things more concise
716 my %args = ( courseID => $courseID );
717 my $pfx = "WeBWorK::ContentGenerator::";
718
719 my $PermissionLevel = $db->getPermissionLevel($r->param("user")); # checked
720 my $permLevel = $PermissionLevel ? $PermissionLevel->permission : 0;
721
722 my $iResult = "";
723
724 if ($permLevel > 0) {
725 my $ipfx = "${pfx}Instructor::";
726
727 my $userID = $r->param("effectiveUser");
728 my $setID = $urlpath->arg("setID");
729 my $problemID = $urlpath->arg("problemID");
730
731 my $instr = $urlpath->newFromModule("${ipfx}Index", %args);
732 my $userList = $urlpath->newFromModule("${ipfx}UserList", %args);
733
734 # set list links
735 my $setList = $urlpath->newFromModule("${ipfx}ProblemSetList", %args);
736 my $setDetail = $urlpath->newFromModule("${ipfx}ProblemSetEditor", %args, setID => $setID);
737 my $problemEditor = $urlpath->newFromModule("${ipfx}PGProblemEditor", %args, setID => $setID, problemID => $problemID);
738
739 my $mail = $urlpath->newFromModule("${ipfx}SendMail", %args);
740 my $scoring = $urlpath->newFromModule("${ipfx}Scoring", %args);
741
742 # statistics links
743 my $stats = $urlpath->newFromModule("${ipfx}Stats", %args);
744 my $userStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "student", userID => $userID);
745 my $setStats = $urlpath->newFromModule("${ipfx}Stats", %args, statType => "set", setID => $setID);
746
747 my $files = $urlpath->newFromModule("${ipfx}FileXfer", %args);
748
749 $iResult .= CGI::start_li();
750 $iResult .= CGI::span({style=>"font-size:larger"}, CGI::a({href=>$self->systemLink($instr)}, $instr->name));
751 $iResult .= CGI::start_ul();
752 $iResult .= CGI::li(CGI::a({href=>$self->systemLink($userList)}, $userList->name));
753 $iResult .= CGI::start_li();
754 $iResult .= CGI::a({href=>$self->systemLink($setList)}, $setList->name);
755 if ($setID ne "") {
756 $iResult .= CGI::start_ul();
757 $iResult .= CGI::start_li();
758 $iResult .= CGI::a({href=>$self->systemLink($setDetail)}, $setID);
759 if ($problemID ne "") {
760 $iResult .= CGI::ul(
761 CGI::li(CGI::a({href=>$self->systemLink($problemEditor)}, $problemID))
762 );
763 }
764 $iResult .= CGI::end_li();
765 $iResult .= CGI::end_ul();
766 }
767 $iResult .= CGI::end_li();
768 $iResult .= CGI::li(CGI::a({href=>$self->systemLink($mail)}, $mail->name));
769 $iResult .= CGI::li(CGI::a({href=>$self->systemLink($scoring)}, $scoring->name));
770 $iResult .= CGI::start_li();
771 $iResult .= CGI::a({href=>$self->systemLink($stats)}, $stats->name);
772 if ($userID ne "") {
773 $iResult .= CGI::ul(
774 CGI::li(CGI::a({href=>$self->systemLink($userStats)}, $userID))
775 );
776 }
777 if ($setID ne "") {
778 $iResult .= CGI::ul(
779 CGI::li(CGI::a({href=>$self->systemLink($setStats)}, $setID))
780 );
781 }
782 $iResult .= CGI::end_li();
783 $iResult .= CGI::li(CGI::a({href=>$self->systemLink($files)}, $files->name));
784 $iResult .= CGI::end_ul();
785 $iResult .= CGI::end_li();
786 }
787
788 my $sets = $urlpath->newFromModule("${pfx}ProblemSets", %args);
789 my $options = $urlpath->newFromModule("${pfx}Options", %args);
790 my $grades = $urlpath->newFromModule("${pfx}Grades", %args);
791 my $logout = $urlpath->newFromModule("${pfx}Logout", %args);
792
793 return CGI::ul({class=>"LinkMenu"},
794 CGI::li(CGI::span({style=>"font-size:larger"},
795 CGI::a({href=>$self->systemLink($sets)}, "Problem Sets"))),
796 CGI::li(CGI::a({href=>$self->systemLink($options)}, $options->name)),
797 CGI::li(CGI::a({href=>$self->systemLink($grades)}, $grades->name)),
798 CGI::li(CGI::a({href=>$self->systemLink($logout)}, $logout->name)),
799 $iResult,
800 );
801}
802
654# FIXME: drunk code. rewrite. 803# FIXME: drunk code. rewrite.
655# also, this should be structured s.t. subclasses can add items to the links 804# also, this should be structured s.t. subclasses can add items to the links
656# area, i.e. "stacking" 805# area, i.e. "stacking"
657sub links { 806sub links_crap {
658 my $self = shift; 807 my $self = shift;
659 my @components = @_; 808 my @components = @_;
660 my $ce = $self->{ce}; 809 my $ce = $self->{ce};
661 my $db = $self->{db}; 810 my $db = $self->{db};
662 my $userName = $self->{r}->param("user"); 811 my $userName = $self->{r}->param("user");
Legend:
Removed from v.1865  
changed lines
  Added in v.1866
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9