Diff for /loncom/imspackages/imsprocessor.pm between versions 1.2 and 1.3

version 1.2, 2004/03/09 16:44:01 version 1.3, 2004/03/16 19:20:58
Line 3  package Apache::imsprocessor; Line 3  package Apache::imsprocessor;
 use Apache::lonnet;  use Apache::lonnet;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use strict;  use strict;
   
   sub ims_config {
       my ($areas,$cmsmap,$areaname) = @_;
       @{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users");
       %{$$cmsmap{bb5}} = (
                   announce => 'resource/x-bb-announcement',
                   board => 'resource/x-bb-discussionboard',
                   doc => 'resource/x-bb-document',
                   extlink => 'resource/x-bb-externallink',
                   pool => 'assessment/x-bb-pool',
                   quiz => 'assessment/x-bb-quiz',
                   staff => 'resource/x-bb-staffinfo',
                   survey => 'assessment/x-bb-survey',
                   users => 'course/x-bb-user',
                   );
    
       %{$$cmsmap{angel}} =  (
                   board => 'BOARD',
                   extlink => 'LINK',
                   msg => 'MESSAGE',
                   quiz => 'QUIZ',
                   survey => 'FORM',
                   );
   
       @{$$cmsmap{angel}{doc}} = ('FILE','PAGE');
   
   
       %{$areaname} = (
                   announce => 'Announcements',
                   board => 'Discussion Boards',
                   doc => 'Documents, pages, and folders',
                   extlink => 'Links to external sites',
                   pool => 'Question pools',
                   quiz => 'Quizzes',
                   staff => 'Staff information',
                   survey => 'Surveys',
                   users => 'Enrollment',
                   );
            
   }
     
 sub create_tempdir {  sub create_tempdir {
     my ($caller,$pathinfo,$timenow) = @_;         my ($context,$pathinfo,$timenow) = @_;   
     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');      my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
     my $tempdir;      my $tempdir;
     if ($caller eq 'DOCS') {      if ($context eq 'DOCS') {
         $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;          $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
         if (!-e "$tempdir") {          if (!-e "$tempdir") {
             mkdir("$tempdir",0770);              mkdir("$tempdir",0770);
Line 17  sub create_tempdir { Line 57  sub create_tempdir {
         if (!-e "$tempdir") {          if (!-e "$tempdir") {
             mkdir("$tempdir",0770);              mkdir("$tempdir",0770);
         }           } 
     } elsif ($caller eq "CSTR") {      } elsif ($context eq "CSTR") {
         if (!-e "$pathinfo/temp") {          if (!-e "$pathinfo/temp") {
             mkdir("$pathinfo/temp",0770);              mkdir("$pathinfo/temp",0770);
         }          }
Line 26  sub create_tempdir { Line 66  sub create_tempdir {
     return $tempdir;      return $tempdir;
 }  }
   
   sub uploadzip {
       my ($context,$tempdir,$source) = @_;
       my $fname;
       if ($context eq 'DOCS') {
           $fname=$ENV{'form.uploadname.filename'};
   # Replace Windows backslashes by forward slashes
           $fname=~s/\\/\//g;
   # Get rid of everything but the actual filename
           $fname=~s/^.*\/([^\/]+)$/$1/;
   # Replace spaces by underscores
           $fname=~s/\s+/\_/g;
   # Replace all other weird characters by nothing
           $fname=~s/[^\w\.\-]//g;
   # See if there is anything left
           unless ($fname) { return 'error: no uploaded file'; }
   # Save the file
           chomp($ENV{'form.uploadname'});
           open(my $fh,'>'.$tempdir.'/'.$fname);
           print $fh $ENV{'form.uploadname'};
           close($fh);
       } elsif ($context eq 'CSTR') {
           if ($source =~ m/\/([^\/]+)$/) {
               $fname = $1;
               my $destination = $tempdir.'/'.$fname;
               rename($source,$destination);
           }
       }
       return $fname;   
   }
   
 sub expand_zip {  sub expand_zip {
     my ($tempdir,$filename) = @_;      my ($tempdir,$filename) = @_;
     my $zipfile = "$tempdir/$filename";      my $zipfile = "$tempdir/$filename";
Line 60  sub process_manifest { Line 130  sub process_manifest {
                       contentscount => 0,                        contentscount => 0,
                       resnum => 'toplevel',                        resnum => 'toplevel',
                       );                        );
     %{$$resources{'toplevel'}} = ();      %{$$resources{'toplevel'}} = (
                                     revitm => 'Top'
                                    );
     
     if ($cms eq 'angel') {      if ($cms eq 'angel') {
         $$resources{'toplevel'}{type} = "FOLDER";          $$resources{'toplevel'}{type} = "FOLDER";
Line 212  sub copy_resources { Line 284  sub copy_resources {
                 foreach my $file (@{$$hrefs{$key}}) {                  foreach my $file (@{$$hrefs{$key}}) {
                     my $source = $tempdir.'/'.$key.'/'.$file;                      my $source = $tempdir.'/'.$key.'/'.$file;
                     my $filename = '';                      my $filename = '';
                     my $fpath = $timenow.'/resfiles/'.$key.'/';                       my $fpath = $timenow.'/resfiles/'.$key.'/';
                     if ($cms eq 'bb5') {                      if ($cms eq 'angel') {
                         if ($file =~ m-/-) {                          if ($file eq 'pg'.$key.'.htm') {
                             my @items = split/\//,$file;                              next;
                             $filename = pop @items;  
                             $fpath .= join('/',@items);  
                             $fpath .= '/';  
                         } else {  
                             $filename = $file;  
                         }  
                         &Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source);                              
                     } elsif ($cms eq 'angel') {  
                         $file =~ s-\\-/-g;  
                         unless ($file eq 'pg'.$key.'.htm') {  
                             if ($file =~ m-/-) {  
                                 my @items = split/\//,$file;  
                                 $filename = pop @items;  
                                 $fpath = join('/',@items);  
                                 $fpath .= '/';  
                             } else {  
                                 $filename = $file;  
                             }  
                             &Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source);                              
                         }                          }
                     }                      }
                       $file =~ s-\\-/-g;
                       $file = $fpath.$file;
                       my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source);
                 }                  }
             }              }
         }          }
Line 274  sub copy_resources { Line 330  sub copy_resources {
     }      }
 }  }
   
   sub process_coursefile {
       my ($crs,$cdom,$chome,$file,$source)=@_;
       my $fetchresult = '';
       my $fpath = '';
       my $fname = $file;
       ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);
       $fpath=$cdom.'/'.$crs.'/'.$fpath;
       my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
       unless ($fpath eq '') {
           my @parts=split(/\//,$fpath);
           foreach my $part (@parts) {
               $filepath.= '/'.$part;
               if ((-e $filepath)!=1) {
                   mkdir($filepath,0777);
               }
           }
       }
       if ($source eq '') {
           $fetchresult eq 'no source file provided';
       } else {
           my $destination = $filepath.'/'.$fname;
           rename($source,$destination);
           $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
           unless ($fetchresult eq 'ok') {
               &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);
           }
       }
       return $fetchresult;
   }
   
 sub process_resinfo {  sub process_resinfo {
     my ($cms,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_;      my ($cms,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles) = @_;
     my $board_id = time;      my $board_id = time;
Line 301  sub process_resinfo { Line 387  sub process_resinfo {
                 &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);                  &angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles);
             } elsif ($$resources{$key}{type} eq "QUIZ") {              } elsif ($$resources{$key}{type} eq "QUIZ") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                   push @{$quizzes}, $key;
 #               &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);  #               &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
             } elsif ($$resources{$key}{type} eq "FORM") {              } elsif ($$resources{$key}{type} eq "FORM") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
                   push @{$surveys}, $key;
 #                &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);  #                &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles);
             } elsif ($$resources{$key}{type} eq "DROPBOX") {              } elsif ($$resources{$key}{type} eq "DROPBOX") {
                 %{$$resinfo{$key}} = ();                  %{$$resinfo{$key}} = ();
Line 312  sub process_resinfo { Line 400  sub process_resinfo {
     } elsif ($cms eq 'bb5') {      } elsif ($cms eq 'bb5') {
         foreach my $key (sort keys %{$resources}) {          foreach my $key (sort keys %{$resources}) {
             if ($$resources{$key}{type} eq "resource/x-bb-document") {              if ($$resources{$key}{type} eq "resource/x-bb-document") {
                 %{$$resinfo{$key}} = ();  
                 unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {                  unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
                       %{$$resinfo{$key}} = ();
                     &process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles);                      &process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles);
                 }                  }
             } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {              } elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") {
Line 355  sub process_resinfo { Line 443  sub process_resinfo {
                 unless ($announce_handling eq 'ignore') {                  unless ($announce_handling eq 'ignore') {
                     push @{$announcements}, $key;                      push @{$announcements}, $key;
                     %{$$resinfo{$key}} = ();                      %{$$resinfo{$key}} = ();
                     &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$items,$resinfo,$seqstem,$resrcfiles);                      &process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
                 }                  }
             }              }
         }          }
           if (@{$announcements}) {
               $$items{'Top'}{'contentscount'} ++;
           }
           if (@{$boards}) {
               $$items{'Top'}{'contentscount'} ++;
           }
           if (@{$quizzes}) {
               $$items{'Top'}{'contentscount'} ++;
           }
           if (@{$surveys}) {
               $$items{'Top'}{'contentscount'} ++;
           
           }
     }      }
     $$total{'board'} = $board_count;  
   
     if (@{$announcements}) {      $$total{'board'} = $board_count;
         $$items{'Top'}{'contentscount'} ++;      $$total{'quiz'} = @{$quizzes};
     }      $$total{'surv'} = @{$surveys};
     if (@{$boards}) {  
         $$items{'Top'}{'contentscount'} ++;  
     }  
     if (@{$quizzes}) {  
         $$items{'Top'}{'contentscount'} ++;  
         $$total{'quiz'} = @{$quizzes};  
     }  
     if (@{$surveys}) {  
         $$items{'Top'}{'contentscount'} ++;  
         $$total{'surv'} = @{$surveys};  
     }  
 }  }
   
 sub build_structure {  sub build_structure {
     my ($cms,$context,$destdir,$resinfo,$items,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;      my ($cms,$context,$destdir,$items,$resinfo,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_;
   
     my %flag = ();      my %flag = ();
     my %count = ();      my %count = ();
     my %pagecontents = ();      my %pagecontents = ();
Line 571  sub build_structure { Line 659  sub build_structure {
             my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';              my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
             open(PAGEFILE,">$filename");              open(PAGEFILE,">$filename");
             print PAGEFILE qq|<map>              print PAGEFILE qq|<map>
 <resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>  <resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>
 <link to="2" index="1" from="1">\n|;  <link to="2" index="1" from="1">\n|;
             if (@{$pagecontents{$key}[$i]} == 1) {              if (@{$pagecontents{$key}[$i]} == 1) {
                 print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;                  print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|;
             } elsif (@{$pagecontents{$key}[$i]} == 2)  {              } elsif (@{$pagecontents{$key}[$i]} == 2)  {
                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>|;                  print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|;
             } else {              } else {
                 for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {                  for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
                     my $curr_id = $j+1;                      my $curr_id = $j+1;
Line 586  sub build_structure { Line 674  sub build_structure {
 <link to="$next_id" index="$curr_id" from="$curr_id">\n|;  <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
                 }                  }
                 my $final_id = @{$pagecontents{$key}[$i]};                  my $final_id = @{$pagecontents{$key}[$i]};
                 print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;                  print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|;
             }              }
             print PAGEFILE "</map>";              print PAGEFILE "</map>";
             close(PAGEFILE);              close(PAGEFILE);
Line 618  sub make_structure { Line 706  sub make_structure {
         $$flag{$key}{file} = 1;          $$flag{$key}{file} = 1;
     } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {      } elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) )  {
         if ($$flag{$key}{page}) {          if ($$flag{$key}{page}) {
             if ($$count{key}{page} == -1) {              if ($$count{$key}{page} == -1) {
                 print STDERR "Array index is -1, we shouldnt be here\n";                  print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n";
             } else {               } else { 
                 push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;                  push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem;
             }              }
Line 651  sub process_specials { Line 739  sub process_specials {
     my $nextnum = 0;      my $nextnum = 0;
     my $seqstem = '';      my $seqstem = '';
     if ($context eq 'CSTR') {      if ($context eq 'CSTR') {
         $seqstem = '/res/'.$udom.'/'.$uname.'/'.$newdir;          $seqstem = "/res/$udom/$uname/$newdir";
     } elsif ($context eq 'DOCS') {      } elsif ($context eq 'DOCS') {
         $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;          $seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow;
     }      }
Line 1542  sub process_assessment { Line 1630  sub process_assessment {
     foreach my $id (@allids) {      foreach my $id (@allids) {
         my $output = qq|<problem>          my $output = qq|<problem>
 |;  |;
         $$total{problem} ++;          $$total{prob} ++;
         if ($$settings{$id}{class} eq "QUESTION_ESSAY") {          if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
             $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />              $output .= qq|<startouttext />$$settings{$id}{text}<endouttext />
  <essayresponse>   <essayresponse>
Line 1751  sub process_assessment { Line 1839  sub process_assessment {
   
 # ---------------------------------------------------------------- Process Blackboard Announcements  # ---------------------------------------------------------------- Process Blackboard Announcements
 sub process_announce {  sub process_announce {
     my ($res,$docroot,$destdir,$settings,$items,$globalresref,$seqstem,$resrcfiles) = @_;      my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_;
     my $xmlfile = $docroot.'/'.$res.".dat";      my $xmlfile = $docroot.'/'.$res.".dat";
     my @state = ();      my @state = ();
     my @assess = ();      my @assess = ();
Line 1812  sub process_announce { Line 1900  sub process_announce {
       
     if (@assess > 0) {      if (@assess > 0) {
         foreach my $id (@assess) {          foreach my $id (@assess) {
             $$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/$$items{$$settings{startassessment}{$id}{assessment_id}}{revitm}.sequence'>here</a> to enter the folder the contains the problems in this assessment.";              $$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/pages/$$settings{startassessment}{$id}{assessment_id}.page' target='quizpage'>here</a> to enter the page that contains the problems in this assessment.";
         }          }
     }      }
   
Line 1825  sub process_announce { Line 1913  sub process_announce {
 <body bgcolor='#ffffff'>  <body bgcolor='#ffffff'>
 <table>  <table>
  <tr>   <tr>
   <td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{date}</td>    <td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td>
  </tr>   </tr>
 </table>  </table>
 <br/>  <br/>

Removed from v.1.2  
changed lines
  Added in v.1.3


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