Annotation of loncom/imspackages/imsimport.pm, revision 1.1
1.1 ! raeburn 1: package Apache::imsimport;
! 2:
! 3: use strict;
! 4: use Apache::Constants qw(:common :http :methods);
! 5: use Apache::loncacc;
! 6: use Apache::loncommon();
! 7: use Apache::Log();
! 8: use Apache::lonnet;
! 9: use HTML::Parser;
! 10: use HTML::Entities();
! 11: use Apache::lonlocal;
! 12: use Apache::lonupload;
! 13: use File::Basename();
! 14: # ---------------------------------------------------------------- Display Control
! 15: sub display_control {
! 16: # figure out what page we're on and where we're heading.
! 17: my $page = $ENV{'form.page'};
! 18: my $command = $ENV{'form.go'};
! 19: my $current_page = &calculate_page($page,$command);
! 20: return $current_page;
! 21: }
! 22:
! 23: # CALCULATE THE CURRENT PAGE
! 24: sub calculate_page($$) {
! 25: my ($prev,$dir) = @_;
! 26: return 0 if $prev eq ''; # start with first page
! 27: return $prev + 1 if $dir eq 'NextPage';
! 28: return $prev - 1 if $dir eq 'PreviousPage';
! 29: return $prev if $dir eq 'ExitPage';
! 30: return 0 if $dir eq 'BackToStart';
! 31: }
! 32:
! 33: # ---------------------------------------------------------------- Jscript Zero
! 34: sub jscript_zero {
! 35: my ($fullpath,$jsref) = @_;
! 36: my $source = '';
! 37: if (exists($ENV{'form.go'}) ) {
! 38: $source = $ENV{'form.go'};
! 39: }
! 40: $$jsref = <<"END_OF_ONE";
! 41: function verify() {
! 42: if ((document.forms.dataForm.newdir.value == '') || (!document.forms.dataForm.newdir.value)) {
! 43: alert("You must choose a destination directory for the import")
! 44: return false
! 45: }
! 46: if (document.forms.dataForm.source.selectedIndex == 0) {
! 47: alert("You must choose the Course Management System from which the IMS package was exported");
! 48: return false
! 49: }
! 50: return true
! 51: }
! 52:
! 53: function nextPage() {
! 54: if (verify()) {
! 55: document.forms.dataForm.go.value="NextPage"
! 56: document.forms.dataForm.submit()
! 57: }
! 58: }
! 59:
! 60: function createWin() {
! 61: document.dataForm.newdir.value = "";
! 62: newWindow = window.open("","CreateDir","HEIGHT=400,WIDTH=750,scrollbars=yes")
! 63: newWindow.document.open()
! 64: newWindow.document.write("<html><head><title>Create IMS import directory</title><meta http-equiv='pragma' content='no-cache'>\\n")
! 65: newWindow.document.write("</head><body bgcolor='#CCFFDD' topmargin='0' leftmargin='0' marginheight='0'marginwidth='0' rightmargin='0'>\\n")
! 66: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
! 67: newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='600' bgcolor='#CCFFDD'>\\n")
! 68: newWindow.document.write("<tr><td width='2'> </td><td width='3'> </td>\\n")
! 69: newWindow.document.write("<td><h3>Location: <tt>$fullpath</tt></h3><h3>New Directory</h3></td></tr>\\n")
! 70: newWindow.document.write("<tr><td width='2'> </td><td width='3'> </td>\\n")
! 71: newWindow.document.write("<td><form name='fileaction' action='/adm/cfile' method='post'>\\n")
! 72: newWindow.document.write("<font face='arial,helvetica,sans-serif'>Enter the name of the new directory where you will store the contents of your IMS package.<br /><br />")
! 73: newWindow.document.write("<input type='hidden' name='filename' value='$fullpath'>")
! 74: newWindow.document.write("<input type='hidden' name='action' value='newdir'>")
! 75: newWindow.document.write("<input type='hidden' name='callingmode' value='imsimport'>")
! 76: newWindow.document.write("$fullpath<input type='text' name='newfilename' value=''/>")
! 77: newWindow.document.write("<input type='button' value='Go' onClick='document.fileaction.submit();' />")
! 78: newWindow.document.write("</td></tr>\\n")
! 79: newWindow.document.write("</table></body></html>")
! 80: newWindow.document.close()
! 81: newWindow.focus()
! 82: }
! 83: END_OF_ONE
! 84:
! 85: }
! 86:
! 87: # ---------------------------------------------------------------- Display Zero
! 88: sub display_zero {
! 89: my ($r,$uname,$fn,$page) = @_;
! 90:
! 91: $r->print(<<"END_OF_ONE");
! 92: <h3><font face='arial,helvetica,sans-serif'>Step 1: Selection of IMS package type and destination directory for the package contents</b> </font></h3>
! 93: <form name="dataForm" method="post">
! 94: <table border='0' bgcolor='#CCFFDD' cellspacing='0' cellpadding ='0' width='100%'>
! 95: <tr>
! 96: <td colspan='2'>
! 97: <table border='0' cellspacing='0' cellpadding='0'>
! 98: <tr>
! 99: <td colspan='2' align='left'>
! 100: </td>
! 101: </tr>
! 102: <tr bgcolor='#ccddaa'>
! 103: <td width='30' align='top'>
! 104: </td>
! 105: <td width='100%' align='left'>
! 106: <font size='+1' face='arial,helvetica,sans-serif'><b>Specify the Course Management system used to create the package.</b></font>
! 107: </td>
! 108: </tr>
! 109: <tr>
! 110: <td colspan='2'> </td>
! 111: </tr>
! 112: <tr>
! 113: <td> </td>
! 114: <td>
! 115: <font face='Arial,Helvetica,sans-serif'>
! 116: Please choose the CMS used to create your IMS content package.</font>
! 117: </td>
! 118: </tr>
! 119: <tr>
! 120: <td colspan='2'> </td>
! 121: </tr>
! 122: <tr>
! 123: <tr>
! 124: <td> </td>
! 125: <td>
! 126: <font face='Arial,Helvetica,sans-serif'>
! 127: <select name="source">
! 128: <option value='-1' selected="true">Please select
! 129: <option value='bb5'>Blackboard 4 or 5
! 130: <option value='bb6'>Blackboard 6
! 131: <option value='angel'>ANGEL
! 132: <option value='webct'>WebCT
! 133: </select>
! 134: </td>
! 135: </tr>
! 136: <tr>
! 137: <td colspan='2'> </td>
! 138: </tr>
! 139: <tr bgcolor='#ccddaa'>
! 140: <td width='30' align='top'>
! 141: </td>
! 142: <td width='100%' align='left'>
! 143: <font size='+1' face='arial,helvetica,sans-serif'><b>Create a directory where you will unpack your IMS package.</b></font>
! 144: </td>
! 145: </tr>
! 146: <tr>
! 147: <td colspan='2'> </td>
! 148: </tr>
! 149: <tr>
! 150: <td> </td>
! 151: <td>
! 152: <font face='Arial,Helvetica,sans-serif'>
! 153: Please choose a destination LON-CAPA directory in which to store the contents of the IMS package file</font>
! 154: </td>
! 155: </tr>
! 156: <tr>
! 157: <td colspan='2'> </td>
! 158: </tr>
! 159: <tr>
! 160: <td> </td>
! 161: <td><input type="button" name="createdir" value="Create Directory" onClick="javascript:createWin()"><input type="hidden" name="newdir" value=""></td>
! 162: </tr>
! 163: <tr>
! 164: <td colspan='2'> </td>
! 165: </tr>
! 166: <tr>
! 167: <td> </td>
! 168: <td><font face='arial,helvetica,sans-serif'>If you have created a destination directory you should use the "Next Page" button to complete the process of unpacking your IMS package.</font></td>
! 169: </tr>
! 170: <tr>
! 171: <td colspan='2'>
! 172: <input type='hidden' name="go" value="">
! 173: <input type="hidden" name="uploaduname" value="$uname">
! 174: <input type="hidden" name="filename" value="$fn">
! 175: <input type='hidden' name="page" value="$page">
! 176: <input type="hidden" name="phase" value="three">
! 177: </td>
! 178: </tr>
! 179: <tr>
! 180: <td colspan='2'> </td>
! 181: </tr>
! 182: <tr>
! 183: <td colspan='2'>
! 184: <table border='0' cellspacing='0' cellpadding='0' width="100%">
! 185: <tr>
! 186: <td align='left'>
! 187: </td>
! 188: <td align='right'>
! 189: <input type="button" name="nextpage" value="Continue to step 2" onClick="javascript:nextPage()">
! 190: </td>
! 191: </tr>
! 192: </table>
! 193: </td>
! 194: </tr>
! 195: </table>
! 196: </td>
! 197: </tr>
! 198: </table>
! 199: </form>
! 200: END_OF_ONE
! 201: }
! 202:
! 203: # ---------------------------------------------------------------- Display One
! 204:
! 205: sub expand_bb5 {
! 206: my ($r,$uname,$udom,$fn,$page) = @_;
! 207: my @state = ();
! 208: my @seq = "Top";
! 209: my $lastitem;
! 210: my %resnum = ();
! 211: my %title = ();
! 212: my %filepath = ();
! 213: my %contentscount = ('Top' => 0);
! 214: my %contents = ();
! 215: my %parentseq = ();
! 216: my %base = ();
! 217: my %file = ();
! 218: my %type = ();
! 219: my %href = ();
! 220: my $identifier = '';
! 221: my %resinfo = ();
! 222: my $numfolders = 0;
! 223: my $numpages = 0;
! 224: my $docroot = $ENV{'form.newdir'};
! 225: if (!-e "$docroot/temp") {
! 226: mkdir "$docroot/temp";
! 227: }
! 228: my $newdir = '';
! 229: if ($docroot =~ m|public_html/(.+)$|) {
! 230: $newdir = $1;
! 231: }
! 232: my $dirname = "/res/$udom/$uname/$newdir";
! 233: my $zipfile = '/home/'.$uname.'/public_html'.$fn;
! 234: if ($fn =~ m|\.zip$|i) {
! 235: open(OUTPUT, "unzip -o $zipfile -d $docroot/temp 2> /dev/null |");
! 236: while (<OUTPUT>) {
! 237: print "$_<br />";
! 238: }
! 239: close(OUTPUT);
! 240: }
! 241:
! 242: my $xmlfile = $docroot.'/temp/imsmanifest.xml';
! 243: # print STDERR "XML file is $xmlfile\n";
! 244: my $p = HTML::Parser->new
! 245: (
! 246: xml_mode => 1,
! 247: start_h =>
! 248: [sub {
! 249: my ($tagname, $attr) = @_;
! 250: push @state, $tagname;
! 251: my $num = @state - 3;
! 252: my $start = $num;
! 253: my $statestr = '';
! 254: foreach (@state) {
! 255: $statestr .= "$_ ";
! 256: }
! 257: if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq "tableofcontents") ) {
! 258: my $searchstr = "manifest organizations tableofcontents";
! 259: while ($num > 0) {
! 260: $searchstr .= " item";
! 261: $num --;
! 262: }
! 263: if (("@state" eq $searchstr) && (@state > 3)) {
! 264: my $itm = $attr->{identifier};
! 265: $resnum{$itm} = $attr->{identifierref};
! 266: $title{$itm} = $attr->{title};
! 267: if ($start > @seq) {
! 268: unless ($lastitem eq '') {
! 269: push @seq, $lastitem;
! 270: unless ( defined($contents{$seq[-1]}) ) {
! 271: @{$contents{$seq[-1]}} = ();
! 272: }
! 273: push @{$contents{$seq[-1]}},$itm;
! 274: $parentseq{$itm} = $seq[-1];
! 275: }
! 276: }
! 277: elsif ($start < @seq) {
! 278: my $diff = @seq - $start;
! 279: while ($diff > 0) {
! 280: pop @seq;
! 281: $diff --;
! 282: }
! 283: if (@seq) {
! 284: push @{$contents{$seq[-1]}}, $itm;
! 285: }
! 286: } else {
! 287: push @{$contents{$seq[-1]}}, $itm;
! 288: }
! 289: my $path;
! 290: if (@seq > 1) {
! 291: $path = join(',',@seq);
! 292: } elsif (@seq > 0) {
! 293: $path = $seq[0];
! 294: }
! 295: $filepath{$itm} = $path;
! 296: $contentscount{$seq[-1]} ++;
! 297: $lastitem = $itm;
! 298: }
! 299: } elsif ("@state" eq "manifest resources resource" ) {
! 300: $identifier = $attr->{identifier};
! 301: $base{$identifier} = $attr->{baseurl};
! 302: $file{$identifier} = $attr->{file};
! 303: $type{$identifier} = $attr->{type};
! 304: } elsif ("@state" eq "manifest resources resource file") {
! 305: push@{$href{$identifier}},$attr->{href};
! 306: }
! 307: }, "tagname, attr"],
! 308: text_h =>
! 309: [sub {
! 310: my ($text) = @_;
! 311: }, "dtext"],
! 312: end_h =>
! 313: [sub {
! 314: my ($tagname) = @_;
! 315: pop @state;
! 316: }, "tagname"],
! 317: );
! 318:
! 319: $p->parse_file($xmlfile);
! 320: $p->eof;
! 321:
! 322: my $topnum = 0;
! 323: my $destdir = $docroot;
! 324: # print STDERR "Destdir is $destdir\n";
! 325: if (!-e "$destdir") {
! 326: mkdir("$destdir",0755);
! 327: }
! 328: if (!-e "$destdir/sequences") {
! 329: mkdir("$destdir/sequences",0755);
! 330: }
! 331: if (!-e "$destdir/resfiles") {
! 332: mkdir("$destdir/resfiles",0755);
! 333: }
! 334: if (!-e "$destdir/pages") {
! 335: mkdir("$destdir/pages",0755);
! 336: }
! 337: if (!-e "$destdir/problems") {
! 338: mkdir("$destdir/problems",0755);
! 339: }
! 340: open(FILE,">$destdir/sequences/ims_import.sequence");
! 341: print FILE "<map>\n";
! 342:
! 343: foreach my $key (sort keys %href) {
! 344: foreach my $file (@{$href{$key}}) {
! 345: my $filepath = $file;
! 346: if (!-e "$destdir/resfiles/$key") {
! 347: mkdir("$destdir/resfiles/$key",0755);
! 348: }
! 349: while ($filepath =~ m-(\w+)/(.+)-) {
! 350: $filepath = $2;
! 351: if (!-e "$destdir/resfiles/$key/$1") {
! 352: mkdir("$destdir/resfiles/$key/$1",0755);
! 353: }
! 354: }
! 355: system("cp $docroot/temp/$key/$file $destdir/resfiles/$key/$file");
! 356: }
! 357: }
! 358:
! 359: foreach my $key (sort keys %type) {
! 360: if ($type{$key} eq "resource/x-bb-document") {
! 361: %{$resinfo{$key}} = ();
! 362: &process_content($key,$docroot,$destdir,\%{$resinfo{$key}},$udom,$uname);
! 363: } elsif ($type{$key} eq "resource/x-bb-staffinfo") {
! 364: %{$resinfo{$key}} = ();
! 365: &process_staff($key,$docroot,$destdir,\%{$resinfo{$key}});
! 366: } elsif ($type{$key} eq "resource/x-bb-externallink") {
! 367: %{$resinfo{$key}} = ();
! 368: &process_link($key,$docroot,$destdir,\%{$resinfo{$key}});
! 369: } elsif ($type{$key} eq "resource/x-bb-discussionboard") {
! 370: %{$resinfo{$key}} = ();
! 371: &process_db($key,$docroot,$destdir,\%{$resinfo{$key}});
! 372: } elsif ($type{$key} eq "resource/x-bb-announcement") {
! 373: %{$resinfo{$key}} = ();
! 374: &process_announce($key,$docroot,$destdir,\%{$resinfo{$key}});
! 375: } elsif ($type{$key} eq "assessment/x-bb-pool") {
! 376: %{$resinfo{$key}} = ();
! 377: &process_assessment($key,$docroot,'pool',$dirname,$destdir,\%{$resinfo{$key}});
! 378: } elsif ($type{$key} eq "assessment/x-bb-quiz") {
! 379: %{$resinfo{$key}} = ();
! 380: &process_assessment($key,$docroot,'quiz',$dirname,$destdir,\%{$resinfo{$key}});
! 381: } elsif ($type{$key} eq "assessment/x-bb-survey") {
! 382: %{$resinfo{$key}} = ();
! 383: &process_assessment($key,$docroot,'survey',$dirname,$destdir,\%{$resinfo{$key}});
! 384: } elsif ($type{$key} eq "assessment/x-bb-group") {
! 385: %{$resinfo{$key}} = ();
! 386: &process_group($key,$docroot,$destdir,\%{$resinfo{$key}});
! 387: } elsif ($type{$key} eq "resource/x-bb-user") {
! 388: %{$resinfo{$key}} = ();
! 389: &process_user($key,$docroot,$destdir,\%{$resinfo{$key}});
! 390: }
! 391: }
! 392:
! 393: my $nextnum = 0;
! 394: open(TOPFILE,">$destdir/sequences/ims_import.sequence");
! 395: print TOPFILE "<map>\n";
! 396: my $fileopen = 0;
! 397: my $areakey;
! 398: my $areacount = 0;
! 399: my $lastentry = '';
! 400: my $notlastentry = '';
! 401: my %pagecount = ();
! 402: my %pagecontents = ();
! 403: my %pageflag = ();
! 404: my %seqflag = ();
! 405: my %seqcount = ();
! 406:
! 407: foreach my $key (sort keys %resnum) {
! 408: # print STDERR "$key $filepath{$key} $resnum{$key} $title{$key}\n";
! 409: $pageflag{$key} = 0;
! 410: $seqflag{$key} = 0;
! 411: $seqcount{$key} = 0;
! 412: $pagecount{$key} = -1;
! 413: if ($filepath{$key} eq 'Top') {
! 414: $topnum ++;
! 415: $nextnum = $topnum +1;
! 416: print TOPFILE qq|<resource id="$topnum" src="/res/$udom/$uname/$newdir/sequences/$key.sequence" title="$title{$key}"|;
! 417: if ($topnum == 1) {
! 418: print TOPFILE qq| type="start"></resource>
! 419: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
! 420: if ($topnum == $contentscount{'Top'}) {
! 421: print TOPFILE qq|<resource id="$nextnum" src="" type="finish"></resource>\n|;
! 422: }
! 423: } else {
! 424: if ($topnum == $contentscount{'Top'}) {
! 425: print TOPFILE qq| type="finish"></resource>\n|;
! 426: } else {
! 427: print TOPFILE qq|></resource>
! 428: <link from="$topnum" to="$nextnum" index="$topnum"></link>\n|;
! 429: }
! 430: }
! 431: my $seqname = $title{$key};
! 432: $seqname =~ s/\s//g;
! 433: $seqname =~ tr/A-Z/a-z/;
! 434: if ($fileopen) {
! 435: if ($areacount == 0) {
! 436: print AREAFILE qq|<resource id="1" src="" type="start">
! 437: <link from="1" to="2" index="1"></link>
! 438: <resource id="2" src="" type="finish">\n|;
! 439: } elsif ($areacount == 1) {
! 440: print AREAFILE qq|<resource id="2" src="" type="finish">\n|;
! 441: } else {
! 442: print AREAFILE qq|$lastentry\n|;
! 443: }
! 444: print AREAFILE "</map>\n";
! 445: close(AREAFILE);
! 446: $fileopen = 0;
! 447: }
! 448: $areakey = $key;
! 449: @{$pagecontents{$areakey}} = ();
! 450: open(AREAFILE,">$destdir/sequences/$key.sequence");
! 451: print AREAFILE "<map>\n";
! 452: $fileopen = 1;
! 453: $areacount = 0;
! 454: } else {
! 455: if ($filepath{$key} eq "Top,$areakey") {
! 456: # print STDERR "$key $filepath{$key} $resnum{$key} $title{$key}\n";
! 457: my $src = '';
! 458: if ($areacount == 0) {
! 459: if ($resinfo{$resnum{$key}}{'isfolder'} eq "true") {
! 460: $src = 'sequences/'.$key.".sequence";
! 461: $pageflag{$areakey} = 0;
! 462: $seqflag{$areakey} = 1;
! 463: } else {
! 464: if ($pageflag{$areakey}) {
! 465: push @{$pagecontents{$areakey}[$pagecount{$areakey}]},$key;
! 466: } else {
! 467: $pagecount{$areakey} ++;
! 468: $src = 'pages/'.$areakey.'_'.$pagecount{$areakey}.'.page';
! 469: @{$pagecontents{$areakey}[$pagecount{$areakey}]} = ("$key");
! 470: $seqflag{$areakey} = 0;
! 471: }
! 472: }
! 473: unless ($pageflag{$areakey}) {
! 474: print AREAFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$key}" type="start">
! 475: <link from="1" to="2" index="1"></link>\n|;
! 476: $areacount ++;
! 477: $notlastentry = "";
! 478: unless ($seqflag{$areakey}) {
! 479: $pageflag{$areakey} = 1;
! 480: }
! 481: }
! 482: } else {
! 483: my $id = $areacount +1;
! 484: my $nextid = $id +1;
! 485: $areacount ++;
! 486: if ($resinfo{$resnum{$key}}{'isfolder'} eq "true") {
! 487: $src = 'sequences/'.$key.".sequence";
! 488: $pageflag{$areakey} = 0;
! 489: $seqflag{$areakey} = 1;
! 490: } else {
! 491: if ($pageflag{$areakey}) {
! 492: push @{$pagecontents{$areakey}[$pagecount{$areakey}]},$key;
! 493: } else {
! 494: $pagecount{$areakey} ++ ;
! 495: $src = 'pages/'.$areakey.'_'.$pagecount{$areakey}.'.page';
! 496: @{$pagecontents{$areakey}[$pagecount{$areakey}]} = ("$key");
! 497: $seqflag{$areakey} = 0;
! 498: }
! 499: }
! 500: unless ($pageflag{$areakey}) {
! 501: print AREAFILE $notlastentry.qq|<resource id="$id" src="/res/$udom/$uname/$newdir/$src" title="$title{$key}" |;
! 502: unless ($seqflag{$areakey}) {
! 503: $pageflag{$areakey} = 1;
! 504: }
! 505: }
! 506: $lastentry = qq|type="finish"></resource>|;
! 507: $notlastentry = qq|></resource>
! 508: <link from="$id" to="$nextid" index="$id"></link>\n|;
! 509: }
! 510: }
! 511: my $src ="";
! 512: my $next_id = 1;
! 513: my $curr_id = 0;
! 514: if ( (($type{$resnum{$key}} eq "resource/x-bb-document") || ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") || ($type{$resnum{$key}} eq "resource/x-bb-externallink")) && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) {
! 515: # if ( ($type{$resnum{$key}} eq "resource/x-bb-staffinfo") && ($resinfo{$resnum{$key}}{'isfolder'} eq "true") ) {
! 516: # print "$key $filepath{$key} $resnum{$key} $title{$key}\n";
! 517: # print "Folder for item - $key - res - $resnum{$key}\n";
! 518: # print "$key, $contentscount{$key}\n";
! 519: # foreach (@{$contents{$key}}) {
! 520: # print "$key, $_\n";
! 521: # }
! 522: # print STDERR "Contents Count for $key is $contentscount{$key}\n";
! 523: open(LOCFILE,">$destdir/sequences/$key.sequence");
! 524: print LOCFILE "<map>\n";
! 525: if ($contentscount{$key} == 0) {
! 526: print LOCFILE qq|<resource id="1" src="" type="start"></resource>
! 527: <link from="1" to="2" index="1"></link>
! 528: <resource id="2" src="" type="finish"></resource>\n|;
! 529: } else {
! 530: if ($resinfo{$resnum{$contents{$key}[0]}}{'isfolder'} eq "true") {
! 531: $src = 'sequences/'.$contents{$key}[0].".sequence";
! 532: $pageflag{$key} = 0;
! 533: $seqflag{$key} = 1;
! 534: $seqcount{$key} ++;
! 535: } else {
! 536: if ($pageflag{$key}) {
! 537: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[0];
! 538: } else {
! 539: $pagecount{$key} ++;
! 540: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 541: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[0]");
! 542: $seqflag{$key} = 0;
! 543: }
! 544: }
! 545: unless ($pageflag{$key}) {
! 546: print LOCFILE qq|<resource id="1" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[0]}" type="start"|;
! 547: unless ($seqflag{$key}) {
! 548: $pageflag{$key} = 1;
! 549: }
! 550: }
! 551: if ($contentscount{$key} == 1) {
! 552: print LOCFILE qq|></resource>
! 553: <link from="1" to="2" index="1"></link>
! 554: <resource id="2" src="" type="finish"></resource>\n|;
! 555: } else {
! 556: if ($contentscount{$key} > 2 ) {
! 557: for (my $i=1; $i<$contentscount{$key}-1; $i++) {
! 558: if ($resinfo{$resnum{$contents{$key}[$i]}}{'isfolder'} eq "true") {
! 559: $src = 'sequences/'.$contents{$key}[$i].".sequence";
! 560: $pageflag{$key} = 0;
! 561: $seqflag{$key} = 1;
! 562: $seqcount{$key} ++;
! 563: } else {
! 564: if ($pageflag{$key}) {
! 565: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$i];
! 566: } else {
! 567: $pagecount{$key} ++;
! 568: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 569: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$i]");
! 570: $seqflag{$key} = 0;
! 571: }
! 572: }
! 573: unless ($pageflag{$key}) {
! 574: $curr_id ++;
! 575: $next_id ++;
! 576: print LOCFILE qq|></resource>
! 577: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
! 578: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$i]}"|;
! 579: unless ($seqflag{$key}) {
! 580: $pageflag{$key} = 1;
! 581: }
! 582: }
! 583: }
! 584: }
! 585: if ($resinfo{$resnum{$contents{$key}[$contentscount{$key}-1]}}{'isfolder'} eq "true") {
! 586: $src = 'sequences/'.$contents{$key}[$contentscount{$key}-1].".sequence";
! 587: $pageflag{$key} = 0;
! 588: $seqflag{$key} = 1;
! 589: } else {
! 590: if ($pageflag{$key}) {
! 591: push @{$pagecontents{$key}[$pagecount{$key}]},$contents{$key}[$contentscount{$key}-1];
! 592: } else {
! 593: $pagecount{$key} ++;
! 594: $src = 'pages/'.$key.'_'.$pagecount{$key}.'.page';
! 595: @{$pagecontents{$key}[$pagecount{$key}]} = ("$contents{$key}[$contentscount{$key}-1]");
! 596: }
! 597: }
! 598: if ($pageflag{$key}) {
! 599: if ($seqcount{$key} + $pagecount{$key} +1 == 1) {
! 600: print LOCFILE qq|></resource>
! 601: <link from="1" index="1" to="2">
! 602: <resource id ="2" src="" title="" type="finish"></resource>\n|;
! 603: } else {
! 604: print LOCFILE qq| type="finish"></resource>\n|;
! 605: }
! 606: print STDERR "seqcount is $seqcount{$key}, pagecount is $pagecount{$key} for $key\n";
! 607: } else {
! 608: $curr_id ++;
! 609: $next_id ++;
! 610: print LOCFILE qq|></resource>
! 611: <link from="$curr_id" to="$next_id" index="$curr_id"></link>
! 612: <resource id="$next_id" src="/res/$udom/$uname/$newdir/$src" title="$title{$contents{$key}[$contentscount{$key}-1]}" type="finish"></resource>\n|;
! 613: }
! 614: }
! 615: }
! 616: print LOCFILE "</map>\n";
! 617: close(LOCFILE);
! 618: }
! 619: }
! 620: }
! 621: print TOPFILE "</map>";
! 622: close(TOPFILE);
! 623: foreach my $key (sort keys %pagecontents) {
! 624: for (my $i=0; $i<@{$pagecontents{$key}}; $i++) {
! 625: my $filestem = "/res/$udom/$uname/$newdir";
! 626: my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page';
! 627: open(PAGEFILE,">$filename");
! 628: print PAGEFILE qq|<map>
! 629: <resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][0]}.html" id="1" type="start" title="$title{$pagecontents{$key}[$i][0]}"></resource>
! 630: <link to="2" index="1" from="1">\n|;
! 631: if (@{$pagecontents{$key}[$i]} == 1) {
! 632: print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|;
! 633: } elsif (@{$pagecontents{$key}[$i]} == 2) {
! 634: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][1]}.html" id="2" type="finish" title="$title{$pagecontents{$key}[$i][1]}"></resource>|;
! 635: } else {
! 636: for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) {
! 637: my $curr_id = $j+1;
! 638: my $next_id = $j+2;
! 639: my $resource = $filestem.'/resfiles/'.$resnum{$pagecontents{$key}[$i][$j]}.'.html';
! 640: print PAGEFILE qq|<resource src="$resource" id="$curr_id" title="$title{$pagecontents{$key}[$i][$j]}"></resource>
! 641: <link to="$next_id" index="$curr_id" from="$curr_id">\n|;
! 642: }
! 643: my $final_id = @{$pagecontents{$key}[$i]};
! 644: print PAGEFILE qq|<resource src="$filestem/resfiles/$resnum{$pagecontents{$key}[$i][-1]}.html" id="$final_id" type="finish" title="$title{$pagecontents{$key}[$i][-1]}"></resource>\n|;
! 645: }
! 646: print PAGEFILE "</map>";
! 647: close(PAGEFILE);
! 648: }
! 649: }
! 650: system(" rm -r $docroot/temp");
! 651: }
! 652:
! 653: sub process_user {
! 654: my ($res,$docroot,$destdir,$settings) = @_;
! 655: my $xmlfile = $docroot."/temp/".$res.".dat";
! 656: my $filecount = 0;
! 657: my @state;
! 658: my $userid = '';
! 659: my $linknum = 0;
! 660:
! 661: my $p = HTML::Parser->new
! 662: (
! 663: xml_mode => 1,
! 664: start_h =>
! 665: [sub {
! 666: my ($tagname, $attr) = @_;
! 667: push @state, $tagname;
! 668: if (@state eq " USERS USER") {
! 669: $userid = $attr->{value};
! 670: %{$$$settings{$userid}} = ();
! 671: @{$$settings{$userid}{links}} = ();
! 672: } elsif (@state eq "USERS USER LOGINID") {
! 673: $$settings{$userid}{loginid} = $attr->{value};
! 674: } elsif (@state eq "USERS USER PASSPHRASE") {
! 675: $$settings{$userid}{passphrase} = $attr->{value};
! 676: } elsif ("@state" eq "USERS USER STUDENTID" ) {
! 677: $$settings{$userid}{studentid} = $attr->{value};
! 678: } elsif ("@state" eq "USERS USER NAMES FAMILY" ) {
! 679: $$settings{$userid}{family} = $attr->{value};
! 680: } elsif ("@state" eq "USERS USER NAMES GIVEN" ) {
! 681: $$settings{$userid}{given} = $attr->{value};
! 682: } elsif ("@state" eq "USERS USER ADDRESSES BUSINESS DATA EMAIL") {
! 683: $$settings{$userid}{email} = $attr->{value};
! 684: } elsif ("@state" eq "USERS USER USER_ROLE") {
! 685: $$settings{$userid}{user_role} = $attr->{value};
! 686: } elsif ("@state" eq "USERS USER FLAGS ISAVAILABLE") {
! 687: $$settings{$userid}{isavailable} = $attr->{value};
! 688: } elsif ("@state" eq "USERS USER PERSONALPAGE FILELIST IMAGE") {
! 689: $$settings{$userid}{image} = $attr->{value};
! 690: } elsif ( ($state[-2] eq "LINKLIST") && ($state[-1] eq "LINK") ) {
! 691: %{$$settings{$userid}{links}[$linknum]} = ();
! 692: $$settings{$userid}{links}[$linknum]{url} = $attr->{value};
! 693: $linknum ++;
! 694: }
! 695: }, "tagname, attr"],
! 696: text_h =>
! 697: [sub {
! 698: my ($text) = @_;
! 699: if ("@state" eq "USERS USER PERSONALPAGE TITLE") {
! 700: $$settings{$userid}{title} = $text;
! 701: } elsif ("@state" eq "USERS USER PERSONALPAGE DESCRIPTION") {
! 702: $$settings{$userid}{description} = $text;
! 703: } elsif (($state[-2] eq "LINK") && ($state[-1] eq "TITLE")) {
! 704: $$settings{$userid}{links}[$linknum]{title} = $text;
! 705: } elsif (($state[-3] eq "LINK") && ($state[-2] eq "DESCRIPTION") && ($state[-1] eq "TEXT")) {
! 706: $$settings{$userid}{links}[$linknum]{text} = $text;
! 707: }
! 708: }, "dtext"],
! 709: end_h =>
! 710: [sub {
! 711: my ($tagname) = @_;
! 712: if (@state eq "USERS USER") {
! 713: $linknum = 0;
! 714: }
! 715: pop @state;
! 716: }, "tagname"],
! 717: );
! 718: $p->unbroken_text(1);
! 719: $p->parse_file($xmlfile);
! 720: $p->eof;
! 721: }
! 722:
! 723: sub process_group {
! 724: my ($res,$docroot,$destdir,$settings) = @_;
! 725: my $xmlfile = $docroot."/".$res.".dat";
! 726: my $filecount = 0;
! 727: my @state;
! 728: my $grp;
! 729:
! 730: my $p = HTML::Parser->new
! 731: (
! 732: xml_mode => 1,
! 733: start_h =>
! 734: [sub {
! 735: my ($tagname, $attr) = @_;
! 736: push @state, $tagname;
! 737: if (@state eq "GROUPS GROUP") {
! 738: $grp = $attr->{id};
! 739: }
! 740: if (@state eq "GROUPS GROUP TITLE") {
! 741: $$settings{$grp}{title} = $attr->{value};
! 742: } elsif (@state eq "GROUPS GROUP FLAGS ISAVAILABLE") {
! 743: $$settings{$grp}{isavailable} = $attr->{value};
! 744: } elsif (@state eq "GROUPS GROUP FLAGS HASCHATROOM") {
! 745: $$settings{$grp}{chat} = $attr->{value};
! 746: } elsif ("@state" eq "GROUPS GROUP FLAGS HASDISCUSSIONBOARD") {
! 747: $$settings{$grp}{discussion} = $attr->{value};
! 748: } elsif ("@state" eq "GROUPS GROUP FLAGS HASTRANSFERAREA") {
! 749: $$settings{$grp}{transfer} = $attr->{value};
! 750: } elsif ("@state" eq "GROUPS GROUP FLAGS ISPUBLIC") {
! 751: $$settings{$grp}{public} = $attr->{value};
! 752: }
! 753: }, "tagname, attr"],
! 754: text_h =>
! 755: [sub {
! 756: my ($text) = @_;
! 757: if ("@state" eq "GROUPS DESCRIPTION") {
! 758: $$settings{$grp}{description} = $text;
! 759: # print "Staff text is $text\n";
! 760: }
! 761: }, "dtext"],
! 762: end_h =>
! 763: [sub {
! 764: my ($tagname) = @_;
! 765: pop @state;
! 766: }, "tagname"],
! 767: );
! 768: $p->unbroken_text(1);
! 769: $p->parse_file($xmlfile);
! 770: $p->eof;
! 771: }
! 772:
! 773: sub process_staff {
! 774: my ($res,$docroot,$destdir,$settings) = @_;
! 775: my $xmlfile = $docroot."/temp/".$res.".dat";
! 776: my $filecount = 0;
! 777: my @state;
! 778: %{$$settings{name}} = ();
! 779: %{$$settings{office}} = ();
! 780:
! 781: my $p = HTML::Parser->new
! 782: (
! 783: xml_mode => 1,
! 784: start_h =>
! 785: [sub {
! 786: my ($tagname, $attr) = @_;
! 787: push @state, $tagname;
! 788: if (@state eq "STAFFINFO TITLE") {
! 789: $$settings{title} = $attr->{value};
! 790: } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
! 791: $$settings{textcolor} = $attr->{value};
! 792: } elsif (@state eq "STAFFINFO BIOGRAPHY FLAGS ISHTML") {
! 793: $$settings{ishtml} = $attr->{value};
! 794: } elsif ("@state" eq "STAFFINFO FLAGS ISAVAILABLE" ) {
! 795: $$settings{isavailable} = $attr->{value};
! 796: } elsif ("@state" eq "STAFFINFO FLAGS ISFOLDER" ) {
! 797: $$settings{isfolder} = $attr->{value};
! 798: } elsif ("@state" eq "STAFFINFO POSITION" ) {
! 799: $$settings{position} = $attr->{value};
! 800: } elsif ("@state" eq "STAFFINFO HOMEPAGE" ) {
! 801: $$settings{homepage} = $attr->{value};
! 802: } elsif ("@state" eq "STAFFINFO IMAGE") {
! 803: $$settings{image} = $attr->{value};
! 804: }
! 805: }, "tagname, attr"],
! 806: text_h =>
! 807: [sub {
! 808: my ($text) = @_;
! 809: if ("@state" eq "STAFFINFO BIOGRAPHY TEXT") {
! 810: $$settings{text} = $text;
! 811: # print "Staff text is $text\n";
! 812: } elsif ("@state" eq "STAFFINFO CONTACT PHONE") {
! 813: $$settings{phone} = $text;
! 814: } elsif ("@state" eq "STAFFINFO CONTACT EMAIL") {
! 815: $$settings{email} = $text;
! 816: } elsif ("@state" eq "STAFFINFO CONTACT NAME FORMALTITLE") {
! 817: $$settings{name}{formaltitle} = $text;
! 818: } elsif ("@state" eq "STAFFINFO CONTACT NAME FAMILY") {
! 819: $$settings{name}{family} = $text;
! 820: } elsif ("@state" eq "STAFFINFO CONTACT NAME GIVEN") {
! 821: $$settings{name}{given} = $text;
! 822: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE HOURS") {
! 823: $$settings{office}{hours} = $text;
! 824: } elsif ("@state" eq "STAFFINFO CONTACT OFFICE ADDRESS") {
! 825: $$settings{office}{address} = $text;
! 826: }
! 827: }, "dtext"],
! 828: end_h =>
! 829: [sub {
! 830: my ($tagname) = @_;
! 831: pop @state;
! 832: }, "tagname"],
! 833: );
! 834: $p->unbroken_text(1);
! 835: $p->parse_file($xmlfile);
! 836: $p->eof;
! 837: }
! 838:
! 839: sub process_link {
! 840: my ($res,$docroot,$destdir,$settings) = @_;
! 841: my $xmlfile = $docroot."/temp/".$res.".dat";
! 842: my @state = ();
! 843: %{$$settings{name}} = ();
! 844: %{$$settings{office}} = ();
! 845:
! 846: my $p = HTML::Parser->new
! 847: (
! 848: xml_mode => 1,
! 849: start_h =>
! 850: [sub {
! 851: my ($tagname, $attr) = @_;
! 852: push @state, $tagname;
! 853: if (@state eq "EXTERNALLINK TITLE") {
! 854: $$settings{title} = $attr->{value};
! 855: } elsif (@state eq "EXTERNALLINK TEXTCOLOR") {
! 856: $$settings{textcolor} = $attr->{value};
! 857: } elsif (@state eq "EXTERNALLINK DESCRIPTION FLAGS ISHTML") {
! 858: $$settings{ishtml} = $attr->{value};
! 859: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISAVAILABLE" ) {
! 860: $$settings{isavailable} = $attr->{value};
! 861: } elsif ("@state" eq "EXTERNALLINKS FLAGS LAUNCHINNEWWINDOW" ) {
! 862: $$settings{newwindow} = $attr->{value};
! 863: } elsif ("@state" eq "EXTERNALLINKS FLAGS ISFOLDER" ) {
! 864: $$settings{isfolder} = $attr->{value};
! 865: } elsif ("@state" eq "EXTERNALLINKS POSITION" ) {
! 866: $$settings{position} = $attr->{value};
! 867: } elsif ("@state" eq "EXTERNALLINKS URL" ) {
! 868: $$settings{url} = $attr->{value};
! 869: }
! 870: }, "tagname, attr"],
! 871: text_h =>
! 872: [sub {
! 873: my ($text) = @_;
! 874: if ("@state" eq "EXTERNALLINKS DESCRIPTION TEXT") {
! 875: $$settings{text} = $text;
! 876: }
! 877: }, "dtext"],
! 878: end_h =>
! 879: [sub {
! 880: my ($tagname) = @_;
! 881: pop @state;
! 882: }, "tagname"],
! 883: );
! 884: $p->unbroken_text(1);
! 885: $p->parse_file($xmlfile);
! 886: $p->eof;
! 887: }
! 888:
! 889: sub process_db {
! 890: my ($res,$docroot,$destdir,$settings) = @_;
! 891: my $xmlfile = $docroot."/temp/".$res.".dat";
! 892: my @state = ();
! 893: my %threads; # all quotes, keyed by message ID
! 894: my $msg_id; # the current message ID
! 895: my %message; # the current message being accumulated for $msg_id
! 896:
! 897: my $p = HTML::Parser->new
! 898: (
! 899: xml_mode => 1,
! 900: start_h =>
! 901: [sub {
! 902: my ($tagname, $attr) = @_;
! 903: push @state, $tagname;
! 904: my $depth = 0;
! 905: my @seq = ();
! 906: if (@state eq "FORUM TITLE") {
! 907: $$settings{title} = $attr->{value};
! 908: } elsif (@state eq "STAFFINFO BIOGRAPHY TEXTCOLOR") {
! 909: $$settings{textcolor} = $attr->{value};
! 910: } elsif (@state eq "FORUM DESCRIPTION FLAGS ISHTML") {
! 911: $$settings{ishtml} = $attr->{value};
! 912: } elsif (@state eq "FORUM DESCRIPTION FLAGS ISNEWLINELITERAL") {
! 913: $$settings{newline} = $attr->{value};
! 914: } elsif ("@state" eq "FORUM POSITION" ) {
! 915: $$settings{position} = $attr->{value};
! 916: } elsif ("@state" eq "FORUM FLAGS ISREADONLY") {
! 917: $$settings{isavailable} = $attr->{value};
! 918: } elsif ("@state" eq "FORUM FLAGS ISAVAILABLE" ) {
! 919: $$settings{isavailable} = $attr->{value};
! 920: } elsif ("@state" eq "FORUM FLAGS ALLOWANONYMOUSPOSTINGS" ) {
! 921: $$settings{isfolder} = $attr->{value};
! 922: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
! 923: if ($state[@state-1] eq "MSG") {
! 924: $depth = @state - 3;
! 925: if ($depth > @seq) {
! 926: unless ($msg_id eq '') {
! 927: push @seq, $msg_id;
! 928: }
! 929: }
! 930: if ($depth < @seq) {
! 931: pop @seq;
! 932: }
! 933: $msg_id = $attr->{value};
! 934: %message = ();
! 935: $message{depth} = $depth;
! 936: if ($depth > 0) {
! 937: $message{parent} = $seq[-1];
! 938: } else {
! 939: $message{parent} = "None";
! 940: }
! 941: } elsif ($state[@state-1] eq "TITLE") {
! 942: $message{title} = $attr->{value};
! 943: } elsif ( ( $state[@state-3] eq "MESSAGETEXT" ) && ( $state[@state-2] eq "FLAGS" ) && ( $state[@state-1] eq "ISHTML" ) ) {
! 944: $message{ishtml} = $attr->{value};
! 945: } elsif ( ( $state[@state-3] eq "MESSAGETEXT" ) && ( $state[@state-2] eq "FLAGS" ) && ( $state[@state-1] eq "ISNEWLINELITERAL" ) ) {
! 946: $message{newline} = $attr->{value};
! 947: } elsif ( ( $state[@state-2] eq "DATES" ) && ( $state[@state-1] eq "CREATED" ) ) {
! 948: $message{created} = $attr->{value};
! 949: } elsif ( $state[@state-2] eq "FLAGS") {
! 950: if ($state[@state-1] eq "ISANONYMOUS") {
! 951: $message{isanonymous} = $attr->{value};
! 952: }
! 953: } elsif ( $state[@state-2] eq "USER" ) {
! 954: if ($state[@state-1] eq "USERID") {
! 955: $message{userid} = $attr->{value};
! 956: } elsif ($state[@state-1] eq "USERNAME") {
! 957: $message{username} = $attr->{value};
! 958: } elsif ($state[@state-1] eq "EMAIL") {
! 959: $message{email} = $attr->{value};
! 960: }
! 961: } elsif ( ($state[@state-2] eq "FILELIST") && ($state[@state-2] eq "IMAGE") ) {
! 962: $message{attachment} = $attr->{value};
! 963: }
! 964: }
! 965: }, "tagname, attr"],
! 966: text_h =>
! 967: [sub {
! 968: my ($text) = @_;
! 969: if ("@state" eq "FORUM DESCRIPTION TEXT") {
! 970: $$settings{text} = $text;
! 971: } elsif ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
! 972: if ( ($state[@state-2] eq "MESSAGETEXT") && ($state[@state-1] eq "TEXT") ){
! 973: $message{text} = $text;
! 974: }
! 975: }
! 976: }, "dtext"],
! 977: end_h =>
! 978: [sub {
! 979: my ($tagname) = @_;
! 980: if ( ($state[0] eq "FORUM") && ($state[1] eq "MESSAGETHREADS") && ($state[2] eq "MSG") ) {
! 981: if ($state[@state-1] eq "MSG") {
! 982: push @{$threads{$msg_id}}, { %message };
! 983: }
! 984: }
! 985: pop @state;
! 986: }, "tagname"],
! 987: );
! 988: $p->unbroken_text(1);
! 989: $p->parse_file($xmlfile);
! 990: $p->eof;
! 991: }
! 992:
! 993: sub process_assessment {
! 994: my ($res,$docroot,$container,$dirname,$destdir,$settings) = @_;
! 995: my $xmlfile = $docroot."/temp/".$res.".dat";
! 996: # print "XML file is $xmlfile\n";
! 997: my @state = ();
! 998: my @allids = ();
! 999: my %allanswers = ();
! 1000: my %allchoices = ();
! 1001: my $id; # the current question ID
! 1002: my $answer_id; # the current answer ID
! 1003: my %toptag = ( pool => 'POOL',
! 1004: quiz => 'ASSESSMENT',
! 1005: survey => 'ASSESSMENT'
! 1006: );
! 1007: # print "process_assessment is called, incoming: $res,$docroot,$container,$destdir\n";
! 1008:
! 1009: my $p = HTML::Parser->new
! 1010: (
! 1011: xml_mode => 1,
! 1012: start_h =>
! 1013: [sub {
! 1014: my ($tagname, $attr) = @_;
! 1015: push @state, $tagname;
! 1016: my $depth = 0;
! 1017: my @seq = ();
! 1018: my $class;
! 1019: my $state_str = join(" ",@state);
! 1020: # print "Current state is $state_str\n";
! 1021: if ($container eq "pool") {
! 1022: if ("@state" eq "POOL TITLE") {
! 1023: $$settings{title} = $attr->{value};
! 1024: # print "Title is $attr->{value}\n";
! 1025: }
! 1026: } else {
! 1027: if ("@state" eq "ASSESSMENT TITLE") {
! 1028: $$settings{title} = $attr->{value};
! 1029: } elsif ("@state" eq "ASSESSMENT FLAG" ) {
! 1030: $$settings{isnewline} = $attr->{value};
! 1031: } elsif ("@state" eq "ASSESSMENT FLAGS ISAVAILABLE") {
! 1032: $$settings{isavailable} = $attr->{value};
! 1033: } elsif ("@state" eq "ASSESSMENT FLAGS ISANONYMOUS" ) {
! 1034: $$settings{isanonymous} = $attr->{id};
! 1035: } elsif ("@state" eq "ASSESSMENT FLAGS GIVE FEEDBACK" ) {
! 1036: $$settings{feedback} = $attr->{id};
! 1037: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWCORRECT" ) {
! 1038: $$settings{showcorrect} = $attr->{id};
! 1039: } elsif ("@state" eq "ASSESSMENT FLAGS SHOWRESULTS" ) {
! 1040: $$settings{showresults} = $attr->{id};
! 1041: } elsif ("@state" eq "ASSESSMENT FLAGS ALLOWMULTIPLE" ) {
! 1042: $$settings{allowmultiple} = $attr->{id};
! 1043: } elsif ("@state" eq "ASSESSMENT ASSESSMENTTYPE" ) {
! 1044: $$settings{type} = $attr->{id};
! 1045: }
! 1046: }
! 1047: if ("@state" eq "$toptag{$container} QUESTIONLIST QUESTION") {
! 1048: $id = $attr->{id};
! 1049: push @allids, $id;
! 1050: %{$$settings{$id}} = ();
! 1051: @{$allanswers{$id}} = ();
! 1052: $$settings{$id}{class} = $attr->{class};
! 1053: unless ($container eq "pool") {
! 1054: $$settings{$id}{points} = $attr->{points};
! 1055: }
! 1056: @{$$settings{$id}{correctanswer}} = ();
! 1057: } elsif ( ($state[0] eq $toptag{$container}) && ($state[-1] =~ m/^QUESTION_(\w+)$/) ) {
! 1058: $id = $attr->{id};
! 1059: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISHTML") ) {
! 1060: $$settings{$id}{html} = $attr->{value};
! 1061: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") && ($state[4] eq "ISNEWLINELITERAL") ) {
! 1062: $$settings{$id}{newline} = $attr->{value};
! 1063: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "IMAGE") ) {
! 1064: $$settings{$id}{image} = $attr->{value};
! 1065: $$settings{$id}{style} = $attr->{style};
! 1066: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "URL") ) {
! 1067: $$settings{$id}{url} = $attr->{value};
! 1068: $$settings{$id}{name} = $attr->{name};
! 1069: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "ANSWER") ) {
! 1070: $answer_id = $attr->{id};
! 1071: push @{$allanswers{$id}},$answer_id;
! 1072: %{$$settings{$id}{$answer_id}} = ();
! 1073: $$settings{$id}{$answer_id}{position} = $attr->{position};
! 1074: if ($$settings{$id}{class} eq 'QUESTION_MATCH') {
! 1075: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
! 1076: $$settings{$id}{$answer_id}{type} = 'answer';
! 1077: }
! 1078: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[-1] eq "CHOICE") ) {
! 1079: $answer_id = $attr->{id};
! 1080: push @{$allchoices{$id}},$answer_id;
! 1081: %{$$settings{$id}{$answer_id}} = ();
! 1082: $$settings{$id}{$answer_id}{position} = $attr->{position};
! 1083: $$settings{$id}{$answer_id}{placement} = $attr->{placement};
! 1084: $$settings{$id}{$answer_id}{type} = 'choice';
! 1085: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "IMAGE") ) {
! 1086: $$settings{$id}{$answer_id}{image} = $attr->{value};
! 1087: $$settings{$id}{$answer_id}{style} = $attr->{style};
! 1088: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "URL") ) {
! 1089: $$settings{$id}{$answer_id}{url} = $attr->{value};
! 1090: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "IMAGE") ) {
! 1091: $$settings{$id}{$answer_id}{image} = $attr->{value};
! 1092: $$settings{$id}{$answer_id}{style} = $attr->{style};
! 1093: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "URL") ) {
! 1094: $$settings{$id}{$answer_id}{url} = $attr->{value};
! 1095: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "CORRECTANSWER") ) {
! 1096: my $corr_answer = $attr->{answer_id};
! 1097: push @{$$settings{$id}{correctanswer}}, $corr_answer;
! 1098: # print "Answer $corr_answer for question $id is correct\n";
! 1099: my $type = $1;
! 1100: if ($type eq 'TRUEFALSE') {
! 1101: $$settings{$id}{$corr_answer}{answer_position} = $attr->{position};
! 1102: } elsif ($type eq 'ORDER') {
! 1103: $$settings{$id}{$corr_answer}{order} = $attr->{order};
! 1104: } elsif ($type eq 'MATCH') {
! 1105: $$settings{$id}{$corr_answer}{choice_id} = $attr->{choice_id};
! 1106: }
! 1107: }
! 1108: }, "tagname, attr"],
! 1109: text_h =>
! 1110: [sub {
! 1111: my ($text) = @_;
! 1112: unless ($container eq "pool") {
! 1113: if ("@state" eq "ASSESSMENT DESCRIPTION TEXT") {
! 1114: $$settings{description} = $text;
! 1115: } elsif ("@state" eq "ASSESSMENT INSTRUCTIONS ") {
! 1116: $$settings{instructions}{text} = $text;
! 1117: }
! 1118: }
! 1119: if ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "TEXT") ) {
! 1120: $$settings{$id}{text} = $text;
! 1121: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "ANSWER") && ($state[3] eq "TEXT") ) {
! 1122: $$settings{$id}{$answer_id}{text} = $text;
! 1123: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "CHOICE") && ($state[3] eq "TEXT") ) {
! 1124: $$settings{$id}{$answer_id}{text} = $text;
! 1125: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_CORRECT") ) {
! 1126: $$settings{$id}{feedback_corr} = $text;
! 1127: } elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "GRADABLE") && ($state[3] eq "FEEDBACK_WHEN_INCORRECT") ) {
! 1128: $$settings{$id}{feedback_incorr} = $text;
! 1129: }
! 1130: }, "dtext"],
! 1131: end_h =>
! 1132: [sub {
! 1133: my ($tagname) = @_;
! 1134: pop @state;
! 1135: }, "tagname"],
! 1136: );
! 1137: $p->unbroken_text(1);
! 1138: $p->parse_file($xmlfile);
! 1139: $p->eof;
! 1140:
! 1141: my $dirtitle = $$settings{'title'};
! 1142: $dirtitle =~ s/\W//g;
! 1143: $dirtitle .= '_'.$res;
! 1144: if (!-e "$destdir/problems/$dirtitle") {
! 1145: mkdir("$destdir/problems/$dirtitle",0755);
! 1146: }
! 1147: my $newdir = "$destdir/problems/$dirtitle";
! 1148: foreach my $id (@allids) {
! 1149: # print "Current ID is $id, type is $$settings{$id}{class} \n";
! 1150: if ($$settings{$id}{class} eq "QUESTION_ESSAY") {
! 1151: my $output;
! 1152: if ($container eq 'pool') {
! 1153: $output = qq|<problem>
! 1154: <startouttext />$$settings{$id}{text}<endouttext />
! 1155: |;
! 1156: } else {
! 1157: $output = qq|<problem>
! 1158: <startouttext />$$settings{$id}{text}<endouttext />
! 1159: |;
! 1160: }
! 1161: $output .= qq|
! 1162: <essayresponse>
! 1163: <textfield></textfield>
! 1164: </essayresponse>
! 1165: <postanswerdate>
! 1166: $$settings{$id}{feedbackcorr}
! 1167: </postanswerdate>
! 1168: |;
! 1169: if ($container eq 'pool') {
! 1170: $output .= qq|</problem>
! 1171: |;
! 1172: open(PROB,">$newdir/$id.problem");
! 1173: print PROB $output;
! 1174: close PROB;
! 1175: } else {
! 1176: $output .= qq|</problem>
! 1177: |;
! 1178: open(PROB,">$newdir/$id.problem");
! 1179: print PROB $output;
! 1180: close PROB;
! 1181: }
! 1182: } else {
! 1183: my $output;
! 1184: if ($container eq 'pool') {
! 1185: $output = qq|<problem>
! 1186: |;
! 1187: } else {
! 1188: $output = qq|<problem>
! 1189: |;
! 1190: }
! 1191: $output .= qq|<startouttext />$$settings{$id}{text}\n|;
! 1192: if ( defined($$settings{$id}{image}) ) {
! 1193: if ( $$settings{$id}{style} eq 'embed' ) {
! 1194: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{image}" /><br />|;
! 1195: } else {
! 1196: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{image}">Link to file</a><br />|;
! 1197: }
! 1198: }
! 1199: if ( defined($$settings{$id}{url}) ) {
! 1200: $output .= qq|<br /><a href="$$settings{$id}{url}">$$settings{$id}{name}</a><br />|;
! 1201: }
! 1202: $output .= qq|
! 1203: <endouttext />|;
! 1204: if ($$settings{$id}{class} eq 'QUESTION_MULTIPLECHOICE') {
! 1205: my $numfoils = @{$allanswers{$id}};
! 1206: $output .= qq|
! 1207: <radiobuttonresponse max="$numfoils" randomize="yes">
! 1208: <foilgroup>
! 1209: |;
! 1210: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1211: $output .= " <foil name=\"foil".$k."\" value=\"";
! 1212: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
! 1213: $output .= "true\" location=\"";
! 1214: } else {
! 1215: $output .= "false\" location=\"";
! 1216: }
! 1217: if (lc ($allanswers{$id}[$k]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/) {
! 1218: $output .= "bottom\"";
! 1219: } else {
! 1220: $output .= "random\"";
! 1221: }
! 1222: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text};
! 1223: if ( defined($$settings{$id}{$allanswers{$id}[$k]}{image}) ) {
! 1224: if ( $$settings{$id}{$allanswers{$id}[$k]}{style} eq 'embed' ) {
! 1225: $output .= qq|<br /><img src="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" /><br />|;
! 1226: } else {
! 1227: $output .= qq|<br /><a href="$dirname/resfiles/$res/$$settings{$id}{$allanswers{$id}[$k]}{image}" />Link to file</a><br/>|;
! 1228: }
! 1229: }
! 1230: $output .= qq|<endouttext /></foil>\n|;
! 1231: }
! 1232: chomp($output);
! 1233: $output .= qq|
! 1234: </foilgroup>
! 1235: </radiobuttonresponse>
! 1236: |;
! 1237: } elsif ($$settings{$id}{class} eq 'QUESTION_TRUEFALSE') {
! 1238: my $numfoils = @{$allanswers{$id}};
! 1239: # print "Number of foils is $numfoils\n";
! 1240: $output .= qq|
! 1241: <radiobuttonresponse max="$numfoils" randomize="yes">
! 1242: <foilgroup>
! 1243: |;
! 1244: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1245: $output .= " <foil name=\"foil".$k."\" value=\"";
! 1246: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
! 1247: $output .= "true\" location=\"random\"";
! 1248: } else {
! 1249: $output .= "false\" location=\"random\"";
! 1250: }
! 1251: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
! 1252: }
! 1253: chomp($output);
! 1254: $output .= qq|
! 1255: </foilgroup>
! 1256: </radiobuttonresponse>
! 1257: |;
! 1258: } elsif ($$settings{$id}{class} eq 'QUESTION_MULTIPLEANSWER') {
! 1259: my $numfoils = @{$allanswers{$id}};
! 1260: # print "Number of foils is $numfoils\n";
! 1261: $output .= qq|
! 1262: <optionresponse max="$numfoils" randomize="yes">
! 1263: <foilgroup options="('True','False')">
! 1264: |;
! 1265: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1266: $output .= " <foil name=\"foil".$k."\" value=\"";
! 1267: if (grep/^$allanswers{$id}[$k]$/,@{$$settings{$id}{correctanswer}}) {
! 1268: $output .= "True\"";
! 1269: } else {
! 1270: $output .= "False\"";
! 1271: }
! 1272: $output .= "\><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
! 1273: }
! 1274: chomp($output);
! 1275: $output .= qq|
! 1276: </foilgroup>
! 1277: </radiobuttonresponse>
! 1278: |;
! 1279: } elsif ($$settings{$id}{class} eq 'QUESTION_ORDER') {
! 1280: my $numfoils = @{$allanswers{$id}};
! 1281: $output .= qq|
! 1282: <rankresponse max="$numfoils" randomize="yes">
! 1283: <foilgroup>
! 1284: |;
! 1285: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1286: $output .= " <foil location=\"random\" name=\"foil".$k."\" value=\"".$$settings{$id}{$allanswers{$id}[$k]}{order}."\"><startouttext />".$$settings{$id}{$allanswers{$id}[$k]}{text}."<endouttext /></foil>\n";
! 1287: }
! 1288: chomp($output);
! 1289: $output .= qq|
! 1290: </foilgroup>
! 1291: </rankresponse>
! 1292: |;
! 1293: } elsif ($$settings{$id}{class} eq 'QUESTION_FILLINBLANK') {
! 1294: my $numerical = 1;
! 1295: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1296: unless ($$settings{$id}{$allanswers{$id}[$k]}{text} =~ m/^\d+\.?\d*$/) {
! 1297: $numerical = 0;
! 1298: }
! 1299: }
! 1300: if ($numerical) {
! 1301: my $numans;
! 1302: my $tol;
! 1303: if (@{$allanswers{$id}} == 1) {
! 1304: $tol = 5;
! 1305: $numans = $$settings{$id}{$allanswers{$id}[0]}{text};
! 1306: } else {
! 1307: my $min = $$settings{$id}{$allanswers{$id}[0]}{text};
! 1308: my $max = $$settings{$id}{$allanswers{$id}[0]}{text};
! 1309: for (my $k=1; $k<@{$allanswers{$id}}; $k++) {
! 1310: if ($$settings{$id}{$allanswers{$id}[$k]}{text} <= $min) {
! 1311: $min = $$settings{$id}{$allanswers{$id}[$k]}{text};
! 1312: }
! 1313: if ($$settings{$id}{$allanswers{$id}[$k]}{text} >= $max) {
! 1314: $max = $$settings{$id}{$allanswers{$id}[$k]}{text};
! 1315: }
! 1316: }
! 1317: $numans = ($max + $min)/2;
! 1318: $tol = 100*($max - $min)/($numans*2);
! 1319: }
! 1320: $output .= qq|
! 1321: <numericalresponse answer="$numans">
! 1322: <responseparam type="tolerance" default="$tol%" name="tol" description="Numerical Tolerance" />
! 1323: <responseparam name="sig" type="int_range,0-16" default="0,15" description="Significant Figures"
! 1324: />
! 1325: <textline />
! 1326: </numericalresponse>
! 1327: |;
! 1328: } else {
! 1329: if (@{$allanswers{$id}} == 1) {
! 1330: $output .= qq|
! 1331: <stringresponse answer="$$settings{$id}{$allanswers{$id}[0]}{text}" type="ci">
! 1332: <textline>
! 1333: </textline>
! 1334: </stringresponse>
! 1335: |;
! 1336: } else {
! 1337: my @answertext = ();
! 1338: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1339: $$settings{$id}{$allanswers{$id}[$k]}{text} =~ s/\|/\|/g;
! 1340: push @answertext, $$settings{$id}{$allanswers{$id}[$k]}{text};
! 1341: }
! 1342: my $regexpans = join('|',@answertext);
! 1343: $regexpans = '/^('.$regexpans.')\b/';
! 1344: $output .= qq|
! 1345: <stringresponse answer="$regexpans" type="re">
! 1346: <textline>
! 1347: </textline>
! 1348: </stringresponse>
! 1349: |;
! 1350: }
! 1351: }
! 1352: } elsif ($$settings{$id}{class} eq "QUESTION_MATCH") {
! 1353: $output .= qq|
! 1354: <matchresponse max="10" randomize="yes">
! 1355: <foilgroup>
! 1356: <itemgroup>
! 1357: |;
! 1358: for (my $k=0; $k<@{$allchoices{$id}}; $k++) {
! 1359: $output .= qq|
! 1360: <item name="$allchoices{$id}[$k]">
! 1361: <startouttext />$$settings{$id}{$allchoices{$id}[$k]}{text}<endouttext />
! 1362: </item>
! 1363: |;
! 1364: }
! 1365: $output .= qq|
! 1366: </itemgroup>
! 1367: |;
! 1368: for (my $k=0; $k<@{$allanswers{$id}}; $k++) {
! 1369: $output .= qq|
! 1370: <foil location="random" value="$$settings{$id}{$allanswers{$id}[$k]}{choice_id}" name="$allanswers{$id}[$k]">
! 1371: <startouttext />$$settings{$id}{$allanswers{$id}[$k]}{text}<endouttext />
! 1372: </foil>
! 1373: |;
! 1374: }
! 1375: $output .= qq|
! 1376: </foilgroup>
! 1377: </matchresponse>
! 1378: |;
! 1379: }
! 1380: if ($container eq 'pool') {
! 1381: $output .= qq|</problem>
! 1382: |;
! 1383: open(PROB,">$newdir/$id.problem");
! 1384: print PROB $output;
! 1385: close PROB;
! 1386: } else {
! 1387: $output .= qq|</problem>
! 1388: |;
! 1389: open(PROB,">$newdir/$id.problem");
! 1390: print PROB $output;
! 1391: close PROB;
! 1392: }
! 1393:
! 1394: }
! 1395: }
! 1396: }
! 1397:
! 1398:
! 1399: sub create_ess {
! 1400: my ($newdir,$qnid,$qsettings,$container) = @_;
! 1401: my $output;
! 1402: if ($container eq 'pool') {
! 1403: $output = qq|<problem>
! 1404: <startouttext />$$qsettings{text}<endouttext />
! 1405: |;
! 1406: } else {
! 1407: $output = qq|<problem>
! 1408: <startouttext />$$qsettings{text}<endouttext />
! 1409: |;
! 1410: }
! 1411: $output .= qq|
! 1412: <essayresponse>
! 1413: <textfield></textfield>
! 1414: </essayresponse>
! 1415: <postanswerdate>
! 1416: $$qsettings{feedbackcorr}
! 1417: </postanswerdate>
! 1418: |;
! 1419: if ($container eq 'pool') {
! 1420: $output .= qq|</problem>
! 1421: |;
! 1422: open(PROB,">$newdir/$qnid.problem");
! 1423: print PROB $output;
! 1424: close PROB;
! 1425: } else {
! 1426: $output .= qq|</problem>
! 1427: |;
! 1428: open(PROB,">$newdir/$qnid.problem");
! 1429: print PROB $output;
! 1430: close PROB;
! 1431: }
! 1432: return;
! 1433: }
! 1434:
! 1435: sub process_announce {
! 1436: my ($res,$docroot,$destdir,$settings) = @_;
! 1437: my $xmlfile = $docroot."/temp/".$res.".dat";
! 1438: my @state = ();
! 1439: my $id;
! 1440: my $p = HTML::Parser->new
! 1441: (
! 1442: xml_mode => 1,
! 1443: start_h =>
! 1444: [sub {
! 1445: my ($tagname, $attr) = @_;
! 1446: push @state, $tagname;
! 1447: if ("@state" eq "ANNOUNCEMENT TITLE") {
! 1448: $$settings{title} = $attr->{value};
! 1449: $$settings{startassessment} = ();
! 1450: # print "Title is $$settings{title}\n";
! 1451: } elsif (@state eq "ANNOUNCEMENT DESCRIPTION FLAGS ISHTML") {
! 1452: $$settings{ishtml} = $attr->{value};
! 1453: } elsif ("@state" eq "ANNOUNCEMENT DESCRIPTION FLAGS ISNEWLINELITERAL" ) {
! 1454: $$settings{isnewline} = $attr->{value};
! 1455: } elsif ("@state" eq "CONTENT ISPERMANENT" ) {
! 1456: $$settings{ispermanent} = $attr->{value};
! 1457: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT" ) {
! 1458: $id = $attr->{id};
! 1459: $$settings{startassessment}{$id} = ();
! 1460: } elsif ("@state" eq "ANNOUNCEMENT FILES STARTASSESSMENT ATTRIB" ) {
! 1461: my $key = $attr->{key};
! 1462: $$settings{startassessment}{$id}{$key} = $attr->{value};
! 1463: }
! 1464: }, "tagname, attr"],
! 1465: text_h =>
! 1466: [sub {
! 1467: my ($text) = @_;
! 1468: if ("@state" eq "ANNOUNCEMENT DESCRIPTION TEXT") {
! 1469: $$settings{maindata}{text} = $text;
! 1470: # print "TEXT $text\n";
! 1471: }
! 1472: }, "dtext"],
! 1473: end_h =>
! 1474: [sub {
! 1475: my ($tagname) = @_;
! 1476: pop @state;
! 1477: }, "tagname"],
! 1478: );
! 1479: $p->unbroken_text(1);
! 1480: $p->parse_file($xmlfile);
! 1481: $p->eof;
! 1482: }
! 1483:
! 1484: sub process_content {
! 1485: my ($res,$docroot,$destdir,$settings,$dom,$user) = @_;
! 1486: my $xmlfile = $docroot."/temp/".$res.".dat";
! 1487: my $destresdir = $destdir;
! 1488: $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
! 1489: my $filecount = 0;
! 1490: my @state;
! 1491: @{$$settings{files}} = ();
! 1492: my $p = HTML::Parser->new
! 1493: (
! 1494: xml_mode => 1,
! 1495: start_h =>
! 1496: [sub {
! 1497: my ($tagname, $attr) = @_;
! 1498: push @state, $tagname;
! 1499: if (@state eq "CONTENT MAINDATA") {
! 1500: %{$$settings{maindata}} = ();
! 1501: } elsif (@state eq "CONTENT MAINDATA TEXTCOLOR") {
! 1502: $$settings{maindata}{color} = $attr->{value};
! 1503: } elsif (@state eq "CONTENT MAINDATA FLAGS ISHTML") {
! 1504: $$settings{maindata}{ishtml} = $attr->{value};
! 1505: } elsif (@state eq "CONTENT MAINDATA FLAGS ISNEWLINELITERAL") {
! 1506: $$settings{maindata}{isnewline} = $attr->{value};
! 1507: } elsif ("@state" eq "CONTENT FLAGS ISAVAILABLE" ) {
! 1508: $$settings{isavailable} = $attr->{value};
! 1509: } elsif ("@state" eq "CONTENT FLAGS ISFOLDER" ) {
! 1510: $$settings{isfolder} = $attr->{value};
! 1511: } elsif ("@state" eq "CONTENT FLAGS LAUNCHINNEWWINDOW" ) {
! 1512: $$settings{newwindow} = $attr->{value};
! 1513: } elsif ("@state" eq "CONTENT FILES") {
! 1514: # @{$$settings{files}} = ();
! 1515: } elsif ("@state" eq "CONTENT FILES FILEREF") {
! 1516: %{$$settings{files}[$filecount]} = ();
! 1517: %{$$settings{files}[$filecount]{registry}} = ();
! 1518: } elsif ("@state" eq "CONTENT FILES FILEREF RELFILE" ) {
! 1519: $$settings{files}[$filecount]{'relfile'} = $attr->{value};
! 1520: } elsif ("@state" eq "CONTENT FILES FILEREF MIMETYPE") {
! 1521: $$settings{files}[$filecount]{mimetype} = $attr->{value};
! 1522: } elsif ("@state" eq "CONTENT FILES FILEREF CONTENTTYPE") {
! 1523: $$settings{files}[$filecount]{contenttype} = $attr->{value};
! 1524: } elsif ("@state" eq "CONTENT FILES FILEREF FILEACTION") {
! 1525: $$settings{files}[$filecount]{fileaction} = $attr->{value};
! 1526: } elsif ("@state" eq "CONTENT FILES FILEREF PACKAGEPARENT") {
! 1527: $$settings{files}[$filecount]{packageparent} = $attr->{value};
! 1528: } elsif ("@state" eq "CONTENT FILES FILEREF LINKNAME") {
! 1529: $$settings{files}[$filecount]{linkname} = $attr->{value};
! 1530: } elsif ("@state" eq "CONTENT FILES FILEREF REGISTRY REGISTRYENTRY") {
! 1531: my $key = $attr->{key};
! 1532: $$settings{files}[$filecount]{registry}{$key} = $attr->{value};
! 1533: }
! 1534: }, "tagname, attr"],
! 1535: text_h =>
! 1536: [sub {
! 1537: my ($text) = @_;
! 1538: if ("@state" eq "CONTENT TITLE") {
! 1539: $$settings{title} = $text;
! 1540: } elsif ("@state" eq "CONTENT MAINDATA TEXT") {
! 1541: $$settings{maindata}{text} = $text;
! 1542: } elsif ("@state" eq "CONTENT FILES FILEREF REFTEXT") {
! 1543: $$settings{files}[$filecount]{reftext} = $text;
! 1544: }
! 1545: }, "dtext"],
! 1546: end_h =>
! 1547: [sub {
! 1548: my ($tagname) = @_;
! 1549: if ("@state" eq "CONTENT FILES FILEREF") {
! 1550: $filecount ++;
! 1551: }
! 1552: pop @state;
! 1553: }, "tagname"],
! 1554: );
! 1555: $p->unbroken_text(1);
! 1556: $p->parse_file($xmlfile);
! 1557: $p->eof;
! 1558: my $linktag = '';
! 1559: my $fontcol = '';
! 1560: if (@{$$settings{files}} > 0) {
! 1561: for (my $filecount=0; $filecount<@{$$settings{files}}; $filecount++) {
! 1562: if ($$settings{files}[$filecount]{'fileaction'} eq 'embed') {
! 1563: if ( $$settings{files}[$filecount]{reftext} =~ m#<\!\-\-\s_(\d+)\\_\s\-\-\>#) {
! 1564: my $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"/>|;
! 1565: $$settings{maindata}{text} =~ s#<\!\-\-\s_/($1)\\_\s\-\-\>#$newtag#;
! 1566: } elsif ( $$settings{files}[$filecount]{reftext} =~m#^_/(\d+)\\_$# ) {
! 1567: my $reftag = $1;
! 1568: my $newtag;
! 1569: if ($$settings{files}[$filecount]{mimetype} =~ m/^image/) {
! 1570: $newtag = qq|<img src="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
! 1571: if ( defined($$settings{files}[$filecount]{registry}{alttext}) ) {
! 1572: $newtag .= qq| alt="$$settings{files}[$filecount]{registry}{alttext}"|;
! 1573: }
! 1574: if ( defined($$settings{files}[$filecount]{registry}{alignment}) )
! 1575: {
! 1576: $newtag .= qq| align="$$settings{files}[$filecount]{registry}{alignment}"|;
! 1577: }
! 1578: if ( defined($$settings{files}[$filecount]{registry}{border}) ) {
! 1579: $newtag .= qq| border="$$settings{files}[$filecount]{registry}{border}"|;
! 1580: }
! 1581: $newtag .= " />";
! 1582: my $reftext = $$settings{files}[$filecount]{reftext};
! 1583: my $fname = $$settings{files}[$filecount]{'relfile'};
! 1584: $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
! 1585: # $$settings{maindata}{text} =~ s/DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n]+//;
! 1586: $$settings{maindata}{text} =~ s/Move\swhole\scomment\sto\schange\sfile\splacement\swithin\spage\.[\s\n]+//;
! 1587: $$settings{maindata}{text} =~ s/_\/$reftag\\_/$newtag/;
! 1588: $$settings{maindata}{text} =~ s/END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n]+//;
! 1589: $$settings{maindata}{text} =~ s/\-\->//;
! 1590: # $$settings{maindata}{text} =~ s/<!\-\-\sCOMMENT\sBLOCK\sFOR\sEMBEDDED\sFILE:\s$fname[\s\n]+DO\sNOT\sEDIT\sTHIS\sCOMMENT\sBLOCK[\s\n\]+_\/$reftag\\_[\s\n]+END\sOF\sBLOCK\sON\sNEXT\sLINE[\s\n\]+\-\->/$newtag/;
! 1591: # print STDERR $$settings{maindata}{text};
! 1592: }
! 1593: } else {
! 1594: my $filename=$$settings{files}[$filecount]{'relfile'};
! 1595: # print "File is $filename\n";
! 1596: my $newfilename="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}";
! 1597: # print "New filename is $newfilename\n";
! 1598: $$settings{maindata}{text} =~ s#(src|SRC|value)="$filename"#$1="$newfilename"#g;
! 1599: }
! 1600: } elsif ($$settings{files}[$filecount]{fileaction} eq 'link') {
! 1601: $linktag = qq|<a href="$destresdir/resfiles/$res/$$settings{files}[$filecount]{relfile}"|;
! 1602: if ($$settings{newwindow} eq "true") {
! 1603: $linktag .= qq| target="$res$filecount"|;
! 1604: }
! 1605: foreach my $entry (keys %{$$settings{files}[$filecount]{registry}}) {
! 1606: $linktag .= qq| $entry="$$settings{files}[$filecount]{registry}{$entry}"|;
! 1607: }
! 1608: $linktag .= qq|>$$settings{files}[$filecount]{linkname}</a>|;
! 1609: } elsif ($$settings{files}[$filecount]{fileaction} eq 'package') {
! 1610: # print "Found a package\n";
! 1611: }
! 1612: }
! 1613: }
! 1614: if (defined($$settings{maindata}{textcolor})) {
! 1615: $fontcol = qq|<font color="$$settings{maindata}{textcolor}">|;
! 1616: }
! 1617: if (defined($$settings{maindata}{text})) {
! 1618: if ($$settings{maindata}{ishtml} eq "false") {
! 1619: if ($$settings{maindata}{isnewline} eq "true") {
! 1620: $$settings{maindata}{text} =~ s#\n#<br/>#g;
! 1621: }
! 1622: } else {
! 1623: $$settings{maindata}{text} = &HTML::Entities::decode($$settings{maindata}{text});
! 1624: }
! 1625: }
! 1626:
! 1627: open(FILE,">$destdir/resfiles/$res.html");
! 1628: print FILE qq|<html>
! 1629: <head>
! 1630: <title>$$settings{title}</title>
! 1631: </head>
! 1632: <body bgcolor='#ffffff'>
! 1633: $fontcol
! 1634: |;
! 1635: unless ($$settings{title} eq '') {
! 1636: print FILE qq|$$settings{title}<br/><br/>\n|;
! 1637: }
! 1638: print FILE qq|
! 1639: $$settings{maindata}{text}
! 1640: $linktag|;
! 1641: if (defined($$settings{maindata}{textcolor})) {
! 1642: print FILE qq|</font>|;
! 1643: }
! 1644: print FILE qq|
! 1645: </body>
! 1646: </html>|;
! 1647: close(FILE);
! 1648: }
! 1649:
! 1650:
! 1651:
! 1652: # ---------------------------------------------------------------- Main Handler
! 1653: sub handler {
! 1654: my $r=shift;
! 1655: my $uname;
! 1656: my $udom;
! 1657: my $javascript = '';
! 1658: my $page_name = '';
! 1659: my $current_page = '';
! 1660: my $loadentries = '';
! 1661: my $qcount = '';
! 1662: #
! 1663: # phase two: re-attach user
! 1664: #
! 1665: if ($ENV{'form.uploaduname'}) {
! 1666: $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
! 1667: $ENV{'form.filename'};
! 1668: }
! 1669: ($uname,$udom)=
! 1670: &Apache::loncacc::constructaccess($ENV{'form.filename'},
! 1671: $r->dir_config('lonDefDomain'));
! 1672: unless (($uname) && ($udom)) {
! 1673: $r->log_reason($uname.' at '.$udom.
! 1674: ' trying to publish file '.$ENV{'form.filename'}.
! 1675: ' - not authorized',
! 1676: $r->filename);
! 1677: return HTTP_NOT_ACCEPTABLE;
! 1678: }
! 1679:
! 1680: my $fn;
! 1681: if ($ENV{'form.filename'}) {
! 1682: $fn=$ENV{'form.filename'};
! 1683: $fn=~s/^http\:\/\/[^\/]+\///;
! 1684: $fn=~s/^\///;
! 1685: $fn=~s/(\~|priv\/)(\w+)//;
! 1686: $fn=~s/\/+/\//g;
! 1687: } else {
! 1688: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
! 1689: ' unspecified filename for upload', $r->filename);
! 1690: return HTTP_NOT_FOUND;
! 1691: }
! 1692: my $pathname = &File::Basename::dirname($fn);
! 1693: my $fullpath = '/priv/'.$uname.$pathname;
! 1694: unless ($pathname eq '/') {
! 1695: $fullpath .= '/';
! 1696: }
! 1697: my $loadentries = '';
! 1698: # ----------------------------------------------------------- Start page output
! 1699: &Apache::loncommon::content_type($r,'text/html');
! 1700: $r->send_http_header;
! 1701:
! 1702: if ($ENV{'form.phase'} eq 'three') {
! 1703: $current_page = &display_control();
! 1704: my @PAGES = ('ChooseDir','Blackboard5','ANGEL','WebCT');
! 1705: $page_name = $PAGES[$current_page];
! 1706:
! 1707: if ($page_name eq 'ChooseDir') {
! 1708: &jscript_zero($fullpath,\$javascript);
! 1709: } elsif ($page_name eq 'Confirmation') {
! 1710: &jscript_two(\$javascript,$uname);
! 1711: }
! 1712: } elsif ($ENV{'form.phase'} eq 'two') {
! 1713: &jscript_zero($fullpath,\$javascript);
! 1714: }
! 1715: $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");
! 1716:
! 1717: $r->print(&Apache::loncommon::bodytag('Upload IMS package to Construction Space',undef,$loadentries));
! 1718:
! 1719: if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
! 1720: $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
! 1721: &mt(' at ').$udom.'</font></h3>');
! 1722: }
! 1723:
! 1724: if ($ENV{'form.phase'} eq 'three') {
! 1725: &display_zero ($r,$uname,$fn,$current_page) if $page_name eq 'ChooseDir';
! 1726: &expand_bb5 ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'Blackboard5';
! 1727: &expand_angel ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'ANGEL';
! 1728: &expand_webct ($r,$uname,$udom,$fn,$fullpath,$current_page) if $page_name eq 'WebCT';
! 1729:
! 1730: } elsif ($ENV{'form.phase'} eq 'two') {
! 1731: my $flag = &Apache::lonupload::phasetwo($r,$fn,$uname,$udom,'imsimport');
! 1732: if ($flag eq 'ok') {
! 1733: my $current_page = 0;
! 1734: &display_zero($r,$uname,$fn,$current_page);
! 1735: }
! 1736: } else {
! 1737: &Apache::lonupload::phaseone($r,$fn,$uname,$udom,'imsimport');
! 1738: }
! 1739: $r->print('</body></html>');
! 1740: return OK;
! 1741: }
! 1742: 1;
! 1743: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imsimport.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / imspackages