[BACK]Return to loncreatecourse.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncreatecourse.pm between versions 1.33 and 1.39

version 1.33, 2003/09/03 21:24:32 version 1.39, 2003/11/12 21:37:07
Line 47  use Apache::lonnet; Line 47  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonratedt;  use Apache::lonratedt;
 use Apache::londocs;  use Apache::londocs;
   use Apache::lonlocal;
 # -------------------------------------------- Return path to profile directory  
   
 sub propath {  
     my ($udom,$uname)=@_;  
     $udom=~s/\W//g;  
     $uname=~s/\W//g;  
     my $subdir=$uname.'__';  
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;  
     my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";  
     return $proname;  
 }   
   
 # ================================================ Get course directory listing  # ================================================ Get course directory listing
   
Line 68  sub crsdirlist { Line 57  sub crsdirlist {
     my %crsdata=&Apache::lonnet::coursedescription($courseid);      my %crsdata=&Apache::lonnet::coursedescription($courseid);
     my @listing=&Apache::lonnet::dirlist      my @listing=&Apache::lonnet::dirlist
  ($which,$crsdata{'domain'},$crsdata{'num'},   ($which,$crsdata{'domain'},$crsdata{'num'},
  &propath($crsdata{'domain'},$crsdata{'num'}));   &Apache::loncommon::propath($crsdata{'domain'},$crsdata{'num'}));
     my @output=();      my @output=();
     foreach (@listing) {      foreach (@listing) {
  unless ($_=~/^\./) {   unless ($_=~/^\./) {
Line 98  sub writefile { Line 87  sub writefile {
   'output',$which);    'output',$which);
 }  }
   
   # ===================================================================== Rewrite
   
   sub rewritefile {
       my ($contents,%rewritehash)=@_;
       foreach (keys %rewritehash) {
    my $pattern=$_;
    $pattern=~s/(\W)/\\$1/gs;
    my $new=$rewritehash{$_};
    $contents=~s/$pattern/$new/gs;
       }
       return $contents;
   }
   
 # ============================================================= Copy a userfile  # ============================================================= Copy a userfile
   
 sub copyfile {  sub copyfile {
     my ($origcrsid,$newcrsid,$which)=@_;      my ($origcrsid,$newcrsid,$which)=@_;
     return &writefile($newcrsid,$which,&readfile($origcrsid,$which));      unless ($which=~/\.sequence$/) {
    return &writefile($newcrsid,$which,
         &readfile($origcrsid,$which));
       } else {
    my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
    my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
    return &writefile($newcrsid,$which,
    &rewritefile(
                        &readfile($origcrsid,$which),
       (
          '/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'
       => '/uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/'
               )));
       }
 }  }
   
 # =============================================================== Copy a dbfile  # =============================================================== Copy a dbfile
Line 118  sub copydb { Line 133  sub copydb {
  ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});   ($which,\%data,$newcrsdata{'domain'},$newcrsdata{'num'});
 }  }
   
   # ========================================================== Copy resourcesdata
   
   sub copyresourcedb {
       my ($origcrsid,$newcrsid)=@_;
       my %origcrsdata=&Apache::lonnet::coursedescription($origcrsid);
       my %newcrsdata= &Apache::lonnet::coursedescription($newcrsid);
       my %data=&Apache::lonnet::dump
    ('resourcedata',$origcrsdata{'domain'},$origcrsdata{'num'});
       $origcrsid=~s/^\///;
       $origcrsid=~s/\//\_/;
       $newcrsid=~s/^\///;
       $newcrsid=~s/\//\_/;
       my %newdata=();
       undef %newdata;
       my $startdate=$data{$origcrsid.'.0.opendate'};
       my $today=time;
       my $delta=0;
       if ($startdate) {
    my $oneday=60*60*24;
    $delta=$today-$startdate;
    $delta=int($delta/$oneday)*$oneday;
       }
   # ugly retro fix for broken version of types
       foreach (keys %data) {
    if ($_=~/\wtype$/) {
       my $newkey=$_;
       $newkey=~s/type$/\.type/;
       $data{$newkey}=$data{$_};
       delete $data{$_};
    }
       }
   # adjust symbs
       my $pattern='uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/';
       $pattern=~s/(\W)/\\$1/gs;
       my $new=    'uploaded/'. $newcrsdata{'domain'}.'/'. $newcrsdata{'num'}.'/';
       foreach (keys %data) {
    if ($_=~/$pattern/) {
       my $newkey=$_;
       $newkey=~s/$pattern/$new/;
       $data{$newkey}=$data{$_};
       delete $data{$_};
    }
       }
   # adjust dates
       foreach (keys %data) {
    my $thiskey=$_;
    $thiskey=~s/^$origcrsid/$newcrsid/;
    $newdata{$thiskey}=$data{$_};
    if ($data{$_.'.type'}=~/^date/) {
       $newdata{$thiskey}=$newdata{$thiskey}+$delta;
    }
       }
       return &Apache::lonnet::put
    ('resourcedata',\%newdata,$newcrsdata{'domain'},$newcrsdata{'num'});
   }
   
 # ========================================================== Copy all userfiles  # ========================================================== Copy all userfiles
   
 sub copyuserfiles {  sub copyuserfiles {
Line 133  sub copydbfiles { Line 204  sub copydbfiles {
     foreach (&crsdirlist($origcrsid)) {      foreach (&crsdirlist($origcrsid)) {
  if ($_=~/\.db$/) {   if ($_=~/\.db$/) {
     unless       unless 
              ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate)/) {               ($_=~/^(nohist\_|discussiontimes|classlist|versionupdate|resourcedata)/) {
  &copydb($origcrsid,$newcrsid,$_);   &copydb($origcrsid,$newcrsid,$_);
      }       }
  }   }
Line 146  sub copycoursefiles { Line 217  sub copycoursefiles {
     my ($origcrsid,$newcrsid)=@_;      my ($origcrsid,$newcrsid)=@_;
     &copyuserfiles($origcrsid,$newcrsid);      &copyuserfiles($origcrsid,$newcrsid);
     &copydbfiles($origcrsid,$newcrsid);      &copydbfiles($origcrsid,$newcrsid);
       &copyresourcedb($origcrsid,$newcrsid);
 }  }
   
 # ===================================================== Phase one: fill-in form  # ===================================================== Phase one: fill-in form
Line 350  ENDENHEAD Line 422  ENDENHEAD
  } else {   } else {
     $r->print(      $r->print(
     '<br /><font color="green">Cloning course from '.$clonehome.'</font>');      '<br /><font color="green">Cloning course from '.$clonehome.'</font>');
       my %oldcenv=&Apache::lonnet::dump('environment',$crsudom,$crsunum);
 # Copy all files  # Copy all files
     &copycoursefiles($cloneid,$courseid);      &copycoursefiles($cloneid,$courseid);
   # Restore URL
       $cenv{'url'}=$oldcenv{'url'};
 # Restore title  # Restore title
     $cenv{'description'}=$cdescr;      $cenv{'description'}=$oldcenv{'description'};
   # Mark as cloned
       $cenv{'clonedfrom'}=$cloneid;
  }   }
     }      }
 #  #
Line 454  sub handler { Line 531  sub handler {
     my $r = shift;      my $r = shift;
   
     if ($r->header_only) {      if ($r->header_only) {
        $r->content_type('text/html');         &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;         $r->send_http_header;
        return OK;         return OK;
     }      }
   
     if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {      if (&Apache::lonnet::allowed('ccc',$ENV{'request.role.domain'})) {
        $r->content_type('text/html');         &Apache::loncommon::content_type($r,'text/html');
        $r->send_http_header;         $r->send_http_header;
   
        if ($ENV{'form.phase'} eq 'two') {         if ($ENV{'form.phase'} eq 'two') {
Removed from v.1.33  
changed lines
  Added in v.1.39

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