--- loncom/interface/portfolio.pm 2004/07/23 01:25:56 1.16
+++ loncom/interface/portfolio.pm 2007/06/11 20:56:38 1.181
@@ -1,3 +1,8 @@
+# The LearningOnline Network
+# portfolio browser
+#
+# $Id: portfolio.pm,v 1.181 2007/06/11 20:56:38 albertel Exp $
+#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
@@ -29,283 +34,2318 @@ use Apache::lonnet;
use Apache::lontexconvert;
use Apache::lonfeedback;
use Apache::lonlocal;
+use Apache::lonnet;
+use Apache::longroup;
+use Apache::lonhtmlcommon;
+use HTML::Entities;
+use LONCAPA;
+
+sub group_args {
+ my $output;
+ if (defined($env{'form.group'})) {
+ $output .= '&group='.$env{'form.group'};
+ if (defined($env{'form.ref'})) {
+ $output .= '&ref='.$env{'form.ref'};
+ }
+ }
+ return $output;
+}
+
+sub group_form_data {
+ my $output;
+ if (defined($env{'form.group'})) {
+ $output = '';
+ if (exists($env{'form.ref'})) {
+ $output .= '';
+ }
+ }
+ return $output;
+}
# receives a file name and path stub from username/userfiles/portfolio/
# returns an anchor tag consisting encoding filename and currentpath
-sub makeAnchor{
- my ($fileName, $currentPath) = @_;
- my $anchor = ''.$fileName.'';
+sub make_anchor {
+ my ($url, $anchor_fields, $inner_text) = @_;
+ if ($$anchor_fields{'continue'} ne 'true') {$$anchor_fields{'continue'} = 'false'};
+ my $anchor = ''.$inner_text.'';
return $anchor;
}
-# returns html with separated contents of the directory
-# returns a currentFile (bolds the selected file/dir)
-sub displayDirectory {
- my ($currentPath, $currentFile, @dirList,) = @_;
- my $displayOut='';
- my $fileName;
- my $upPath;
- if ($currentPath ne '/'){
- $displayOut = 'Listing of '.$currentPath.'
'.
- # provides the "up one directory level" function
- # it means shortening the currentpath to the parent directory
- $currentPath =~ m:(^/.*)(/.*/$):;
- if ($1 ne '/'){
- $upPath = $1.'/';
- }else{
- $upPath = $1;
+my $dirptr=16384;
+sub display_common {
+ my ($r,$url,$current_path,$is_empty,$dir_list,$can_upload)=@_;
+ my $namespace = &get_namespace();
+ my $port_path = &get_port_path();
+ if ($can_upload) {
+ my $groupitem = &group_form_data();
+
+ my $iconpath= $r->dir_config('lonIconsURL') . "/";
+ my %text=&Apache::lonlocal::texthash(
+ 'upload' => 'Upload',
+ 'upload_label' =>
+ 'Upload file to current directory:',
+ 'createdir' => 'Create Subdirectory',
+ 'createdir_label' =>
+ 'Create subdirectory in current directory:');
+ my $escuri = &HTML::Entities::encode($r->uri,'&<>"');
+ my $help_fileupload = &Apache::loncommon::help_open_topic('Portfolio AddFiles');
+ my $help_createdir = &Apache::loncommon::help_open_topic('Portfolio CreateDirectory');
+
+ # FIXME: This line should be deleted once Portfolio uses breadcrumbs
+ $r->print(&Apache::loncommon::help_open_topic('Portfolio About', 'Help on the portfolio'));
+
+ $r->print(<<"TABLE");
+
');
+ $r->print($line); # contains first two cells of table
+ my $lock_info;
+ if ($version_flag) { # versioned can't be versioned, so TRUE when root file
+ $r->print('
');
+ $r->print('
'.$version_flag.'
');
+ } else { # this is a graded or handed back file
+ my ($user,$domain) = &get_name_dom();
+ my $permissions_hash = &Apache::lonnet::get_portfile_permissions($domain,$user);
+ if (defined($$permissions_hash{$fullpath})) {
+ foreach my $array_item (@{$$permissions_hash{$fullpath}}) {
+ if (ref($array_item) eq 'ARRAY') {
+ if ($$array_item[-1] eq 'handback') {
+ $lock_info = 'Handback';
+ } elsif ($$array_item[-1] eq 'graded') {
+ $lock_info = 'Graded';
+ }
+ }
+ }
+ }
+ if ($lock_info) {
+ my %anchor_fields = ('lockinfo' => $fullpath);
+ if ($versions) { # hold the folder open
+ my ($fname,$version,$extension) = &Apache::grades::file_name_version_ext($fullpath);
+ $fname =~ s|^/||;
+ $anchor_fields{'showversions'} = $fname.'.'.$extension;
+ }
+ $lock_info = &make_anchor(undef,\%anchor_fields,$lock_info);
+ }
+ $r->print('
');
+ &close_form($r,$url);
+}
+
+sub delete_dir_confirmed {
+ my ($r,$url)=@_;
+ my $directory_name = $env{'form.currentpath'};
+ $directory_name =~ s|/$||; # remove any trailing slash
+ my ($uname,$udom) = &get_name_dom();
+ my $namespace = &get_namespace();
+ my $port_path = &get_port_path();
+ my $result=&Apache::lonnet::removeuserfile($uname,$udom,$port_path.
+ $directory_name);
+
+ if ($result ne 'ok') {
+ $r->print(' An error occured (dir) ('.$result.
+ ') while trying to delete '.$directory_name.' ');
+ } else {
+ # now remove from recent
+# $r->print(' removing '.$directory_name.' print(&done(undef,$url));
+}
+
+sub rename {
+ my ($r,$url)=@_;
+ my $file_name = $env{'form.currentpath'}.$env{'form.rename'};
+ my ($uname,$udom) = &get_name_dom();
+ $file_name = &prepend_group($file_name);
+ if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
+ $r->print("The file is locked and cannot be renamed. ");
+ $r->print(&done(undef,$url));
+ } else {
+ &open_form($r,$url);
+ $r->print('
'.&mt('Rename').' '.&display_file().' to
+ ?
');
+ &close_form($r,$url);
+ }
+}
+
+sub rename_confirmed {
+ my ($r,$url,$group)=@_;
+ my $filenewname=&Apache::lonnet::clean_filename($env{'form.filenewname'});
+ my ($uname,$udom) = &get_name_dom();
+ my $port_path = &get_port_path();
+ if ($filenewname eq '') {
+ $r->print(''.
+ &mt("Error: no valid filename was provided to rename to.").
+ ' ');
+ $r->print(&done(undef,$url));
+ return;
+ }
+ my $chg_access;
+ my $result=
+ &Apache::lonnet::renameuserfile($uname,$udom,
+ $port_path.$env{'form.currentpath'}.$env{'form.selectfile'},
+ $port_path.$env{'form.currentpath'}.$filenewname);
+ if ($result eq 'ok') {
+ $chg_access = &access_for_renamed($filenewname,$group,$udom,$uname);
+ } else {
+ $r->print(''.
+ &mt('An error occured ([_1]) while trying to rename [_2]'
+ .' to [_3]',$result,&display_file(),
+ &display_file('',$filenewname)).' ');
+ return;
+ }
+ if ($filenewname ne $env{'form.filenewname'}) {
+ $r->print(&mt("The new file name was changed from: [_1] to [_2]",
+ ''.&display_file('',$env{'form.filenewname'}).'',
+ ''.&display_file('',$filenewname).''));
+ }
+ $r->print($chg_access);
+ $r->print(&done(undef,$url));
+}
+
+sub access_for_renamed {
+ my ($filenewname,$group,$udom,$uname) = @_;
+ my $oldfile = $env{'form.currentpath'}.$env{'form.selectfile'};
+ $oldfile = &prepend_group($oldfile);
+ my $newfile = $env{'form.currentpath'}.$filenewname;
+ $newfile = &prepend_group($newfile);
+ my $current_permissions =
+ &Apache::lonnet::get_portfile_permissions($udom,$uname);
+ my %access_controls =
+ &Apache::lonnet::get_access_controls($current_permissions,
+ $group,$oldfile);
+ my $chg_text;
+ if (keys(%access_controls) > 0) {
+ my %change_old;
+ my %change_new;
+ foreach my $key (keys(%{$access_controls{$oldfile}})) {
+ $change_old{'delete'}{$key} = 1;
+ $change_new{'activate'}{$key} = $access_controls{$oldfile}{$key};
+ }
+ my ($outcome,$deloutcome,$new_values,$translation) =
+ &Apache::lonnet::modify_access_controls($oldfile,\%change_old,
+ $udom,$uname);
+ if ($outcome ne 'ok') {
+ $chg_text ='
'.&mt("An error occured ([_1]) while ".
+ "trying to delete access control records for the old name.",$outcome).
+ ' ';
+ } else {
+ if ($deloutcome ne 'ok') {
+ $chg_text = '
'.
+ &mt("An error occured ([_1]) while ".
+ "trying to delete access control records for the old name.",$deloutcome).
+ ' ';
+ }
+ }
+ ($outcome,$deloutcome,$new_values,$translation) =
+ &Apache::lonnet::modify_access_controls($newfile,\%change_new,
+ $udom,$uname);
+ if ($outcome ne 'ok') {
+ $chg_text .= '
'.
+ &mt("An error occured ([_1]) while ".
+ "trying to update access control records for the new name.",$outcome).
+ ' ';
+ }
+ if ($chg_text eq '') {
+ $chg_text = '
'.&mt('Access controls updated to reflect the name change.');
+ }
+ }
+ return $chg_text;
+}
+
+sub display_access {
+ my ($r,$url,$group,$can_setacl,$port_path,$action) = @_;
+ my ($uname,$udom) = &get_name_dom();
+ my $file_name = $env{'form.currentpath'}.$env{'form.access'};
+ $file_name = &prepend_group($file_name);
+ my $current_permissions = &Apache::lonnet::get_portfile_permissions($udom,
+ $uname);
+ my %access_controls = &Apache::lonnet::get_access_controls($current_permissions,$group,$file_name);
+ my $aclcount = keys(%access_controls);
+ my ($header,$info);
+ if ($action eq 'chgaccess') {
+ $header = '
'.&mt('Allowing others to retrieve file: [_1]',$port_path.$env{'form.currentpath'}.$env{'form.access'}).'
';
+ $info .= &mt('Access to this file by others can be set to be one or more of the following types: public, passphrase-protected or conditional.');
+ $info .= '
'.&mt('Public files are available to anyone without the need for login.');
+ $info .= '
'.&mt('Passphrase-protected files do not require log-in, but will require the viewer to enter the passphrase you set.');
+ $info .= '
'.&explain_conditionals();
+ $info .= '
'.
+ &mt('A listing of files viewable without log-in is available at: ')."http://$ENV{'SERVER_NAME'}/adm/$udom/$uname/aboutme/portfolio. ";
+ if ($group eq '') {
+ $info .= &mt("For logged in users a 'Display file listing' link will also appear (when there are viewable files) on your personal information page:");
+ } else {
+ $info .= &mt("For logged in users a 'Display file listing' link will also appear (when there are viewable files) on the course information page:");
+ }
+ $info .= " http://$ENV{'SERVER_NAME'}/adm/$udom/$uname/aboutme ";
+ if ($group ne '') {
+ $info .= &mt("Users with privileges to edit course contents may add a course information page to a course using the 'Course Info' button in DOCS").' ';
+ }
+ } else {
+ $header = '
'.&mt('Conditional access controls for file: [_1]',$port_path.$env{'form.currentpath'}.$env{'form.access'}).'
'.
+ &explain_conditionals().' ';
+ }
+ if ($can_setacl) {
+ &open_form($r,$url);
+ $r->print($header.$info);
+ $r->print(' '.&Apache::loncommon::help_open_topic('Portfolio ShareFile SetAccess', 'Help on setting up share access'));
+ $r->print(&Apache::loncommon::help_open_topic('Portfolio ShareFile ChangeSetting', 'Help on changing settings'));
+ $r->print(&Apache::loncommon::help_open_topic('Portfolio ShareFile StopAccess', 'Help on removing share access'));
+ &access_setting_table($r,$url,$file_name,$access_controls{$file_name},
+ $action);
+ my $button_text = {
+ 'continue' => &mt('Proceed'),
+ 'cancel' => &mt('Back to directory listing'),
+ };
+ &close_form($r,$url,$button_text);
+ } else {
+ $r->print($header);
+ if ($aclcount) {
+ $r->print($info);
+ }
+ &view_access_settings($r,$url,$access_controls{$file_name},$aclcount);
+ }
+}
+
+sub explain_conditionals {
+ return
+ &mt('Conditional files are accessible to logged-in users with accounts in the LON-CAPA network, who satisfy the conditions you set.').' '."\n".
+ &mt('The conditions can include affiliation with a particular course, or a user account in a specific domain.').' '."\n".
+ &mt('Alternatively access can be granted to people with specific LON-CAPA usernames and domains.');
+}
+
+sub view_access_settings {
+ my ($r,$url,$access_controls,$aclcount) = @_;
+ my ($showstart,$showend);
+ my %todisplay;
+ foreach my $key (sort(keys(%{$access_controls}))) {
+ my ($num,$scope,$end,$start) = &unpack_acc_key($key);
+ $todisplay{$scope}{$key} = $$access_controls{$key};
+ }
+ if ($aclcount) {
+ $r->print(&mt('
';
+ return $output;
+}
+
+sub role_options_window {
+ my ($r) = @_;
+ my $type = $env{'form.type'};
+ my $rolenum = $env{'form.setroles'};
+ my ($num,$role_id) = ($rolenum =~ /^([\d_]+)_(\d+)$/);
+ my $role_elements;
+ foreach my $item ('role','access','section','group') {
+ $role_elements .= "'".$item.'_'.$rolenum."',";
+ }
+ $role_elements =~ s/,$//;
+ my $role_selects = &role_selectors($num,$role_id,$type,undef,
+ 'rolepicker');
+ $r->print(<<"END_SCRIPT");
+
+END_SCRIPT
+ $r->print(&mt('Select roles, course status, section(s) and group(s) for users who will be able to access the portfolio file.'));
+ $r->print('
'.&mt('Roles').'
'.&mt('[_1] status',$type).'
'.&mt('Sections').'
'.&mt('Groups').'
'.$role_selects.'
');
+ return;
+}
+
+sub select_files {
+ my ($r) = @_;
+ if ($env{'form.continue'} eq 'true') {
+ # here we update the selections for the currentpath
+ # eventually, have to handle removing those not checked, but . . .
+ my @items=&Apache::loncommon::get_env_multiple('form.checkfile');
+ if (scalar(@items)){
+ &Apache::lonnet::save_selected_files($env{'user.name'}, $env{'form.currentpath'}, @items);
+ }
+ } else {
+ #empty the file for a fresh start
+ &Apache::lonnet::clear_selected_files($env{'user.name'});
+ }
+ my @files = &Apache::lonnet::files_not_in_path($env{'user.name'}, $env{'form.currentpath'});
+ my $java_files = join ",", @files;
+ if ($java_files) {
+ $java_files.=',';
+ }
+ my $javascript =(<
+ function finishSelect() {
+ENDSMP
+ $javascript .= 'fileList = "'.$java_files.'";';
+ $javascript .= (<
+ENDSMP
+ $r->print($javascript);
+ $r->print("
Select portfolio files
+ Check as many as you wish in response to the problem. ");
+ my @otherfiles=&Apache::lonnet::files_not_in_path($env{'user.name'}, $env{'form.currentpath'});
+ if (@otherfiles) {
+ $r->print("Files selected from other directories: ");
+ foreach my $file (@otherfiles) {
+ $r->print($file." ");
+ }
+ }
+}
+
+
+sub check_for_upload {
+ my ($path,$fname,$group,$element) = @_;
+ my $disk_quota = &get_quota($group);
+ my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?)
+
+ my $portfolio_root = &get_portfolio_root();
+ my $port_path = &get_port_path();
+ my ($uname,$udom) = &get_name_dom();
+ # Fixme --- Move the checking for existing file to LOND error return
+ my @dir_list=&get_dir_list($portfolio_root,$path);
+ my $found_file = 0;
+ my $locked_file = 0;
+ foreach my $line (@dir_list) {
+ my ($file_name)=split(/\&/,$line,2);
+ if ($file_name eq $fname){
+ $file_name = $path.$file_name;
+ $file_name = &prepend_group($file_name);
+ $found_file = 1;
+ if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') {
+ $locked_file = 1;
+ }
+ }
+ }
+ my $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$portfolio_root);
+
+ if (($current_disk_usage + $filesize) > $disk_quota){
+ my $msg = 'Unable to upload '.$fname.' (size = '.$filesize.' kilobytes). Disk quota will be exceeded.'.
+ ' Disk quota is '.$disk_quota.' kilobytes. Your current disk usage is '.$current_disk_usage.' kilobytes.';
+ return ('will_exceed_quota',$msg);
+ } elsif ($found_file) {
+ if ($locked_file) {
+ my $msg = ''.'Unable to upload '.$fname.', a locked file by that name was found in '.$port_path.$path.''.
+ ' You will be able to rename or delete existing '.$fname.' after a grade has been assigned.';
+ return ('file_locked',$msg);
+ } else {
+ my $msg = ''.'Unable to upload '.$fname.', a file by that name was found in '.$port_path.$path.''.
+ ' To upload, rename or delete existing '.$fname.' in '.$port_path.$path;
+ return ('file_exists',$msg);
+ }
+ }
+}
+
+sub upload {
+ my ($r,$url,$group)=@_;
+ my $fname=&Apache::lonnet::clean_filename($env{'form.uploaddoc.filename'});
+
+ my ($state,$msg) = &check_for_upload($env{'form.currentpath'},
+ $fname,$group,'uploaddoc');
+
+ if ($state eq 'will_exceed_quota'
+ || $state eq 'file_locked'
+ || $state eq 'file_exists' ) {
+ $r->print($msg.&done('Back',$url));
+ return;
+ }
+
+ my $port_path = &get_port_path();
+ my (%allfiles,%codebase,$mode);
+ if ($env{'form.uploaddoc.filename'} =~ m/(\.htm|\.html|\.shtml)$/i) {
+ $mode = 'parse';
+
+ }
+ my $result=
+ &Apache::lonnet::userfileupload('uploaddoc','',
+ $port_path.$env{'form.currentpath'},
+ $mode,\%allfiles,\%codebase);
+ if ($result !~ m|^/uploaded/|) {
+ $r->print(''.'An error occured ('.$result.
+ ') while trying to upload '.&display_file().' ');
+ $r->print(&done('Back',$url));
+ } else {
+ if (%allfiles) {
+ my $state = <
+
+
+
+STATE
+ $r->print("
Completed upload of the file. This file contained references to other files. You can upload these now: