Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-4-patches'.
1 #!/usr/bin/env perl 2 ################################################################################ 3 # WeBWorK Online Homework Delivery System 4 # Copyright � 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 5 # $CVSHeader: webwork2/bin/addcourse,v 1.20 2006/12/09 03:29:56 sh002i Exp $ 6 # 7 # This program is free software; you can redistribute it and/or modify it under 8 # the terms of either: (a) the GNU General Public License as published by the 9 # Free Software Foundation; either version 2, or (at your option) any later 10 # version, or (b) the "Artistic License" which comes with this package. 11 # 12 # This program is distributed in the hope that it will be useful, but WITHOUT 13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 15 # Artistic License for more details. 16 ################################################################################ 17 18 ## readURClassList 19 ## 20 ## This is a specific routine for reading class lists which come from the registrar's 21 ## office at the Univ of Rochester and producing a classlist file usable by WeBWorK 22 23 ## It can be used as a sample script for creating similar scripts for othert schools. 24 25 ## IT IS ASSUMED THAT THE REGISTRAR'S LIST IS DELIMITED WITH SEMICOLONS (;) 26 27 ## Takes three parameters. 28 29 ## First, the full file name of the Registrar's class list file with the header 30 ## material stripped off. The format for this file is 31 ## 46246;26661017; ;EASTON, KEVIN LAWRENCE ;01;09;OPT;BS ;400 ; ;keaston@mail.rochester.edu 32 ## 46246;26611026; ;ECKEL, GRETCHEN ANNA ;01;09;BIO;BA ;400 ; ;geckel@mail.rochester.edu 33 ## 46246;26672985; ;FLYER, JOHANNA GABRIELLE ;01;09;UNC;BA ;400 ; ;jflyer@mail.rochester.edu 34 ## 46246;23932114; ;GALVAN, NESTOR YAMIL ;01;08;ECE;BS ;400 ; ;ngalvan@mail.rochester.edu 35 ## 46246;26603063; ;GARCIA, HENRY ALEXANDER ;01;09;BBC;BS ;400 ; ;hgarcia@mail.rochester.edu 36 37 ## Second, the full file name of the output WeBWorK classlist file 38 39 ## Third, the name of the section, e.g. Pizer or "Pizer MWF" or "" (blank). 40 ## For example classlist files from multiple sections can be concatonated into 41 ## one large classlist file for a whole multisection course 42 ## 43 ## NOTE: Be very careful. The registrar's file may get corrupted by e-mail. 44 45 46 require 5.000; 47 48 49 $0 =~ s|.*/||; 50 if (@ARGV != 3) { 51 print "\n usage: $0 registrar's-list outputfile sectionName\n 52 e.g. readURClassList.pl ClassRoster.txt mth140A.lst 'Pizer MWF9'\n\n" ; 53 exit(0); 54 } 55 56 my ($infile, $outfile, $section) = @ARGV; 57 58 open(REGLIST, "$infile") || die "can't open $infile: $!\n"; 59 open(OURLIST, ">$outfile") 60 || die "can't write $outfile: $!\n"; 61 62 while (<REGLIST>) { 63 chomp; 64 next unless($_=~/\w/); ## skip blank lines 65 s/;$/; /; ## make last field non empty 66 my @regArray=split(/;/); ## get fields from registrar's file 67 68 foreach (@regArray) { ## clean 'em up! 69 ($_) = m/^\s*(.*?)\s*$/; ## (remove leading and trailing spaces) 70 } 71 72 ## extract the relevant fields 73 74 my($crn, $id, $grade, $name, $school, $gradyear, 75 $major, $degree, $hours, $status, $login ) 76 = @regArray; 77 78 ## Hack. The login comes as a complete email address. Remove the @ and following sysbols. 79 80 $login =~ s/@.*//; 81 82 83 ## massage the data a bit 84 85 my($lname, $fname) = ($name =~ /^(.*),\s*(.*)$/); 86 if ($login =~/\w/) {$email = "$login".'@mail.rochester.edu';} 87 else 88 { 89 $email= " "; 90 $login = $id; 91 } 92 $status = 'C' unless (defined $status and $status =~/\w/); 93 ## dump it in our classArray format 94 ## our format is: $id, $lname, $fname, $status, 'comment ', $dept, $course, $section, 95 ## $hours, $crn, $year, $semester, $school, $gradyear, $major, $degree, $email, $login 96 97 ## At the U of R 'comment' is blank 98 ## At present only $id, $lname, $fname, $status, $email, $section, $recitation and $login are used by WeBWorK 99 100 my @classArray=($id, $lname, $fname, $status, ' ', $section, ' ',$email, $login); 101 102 ## and print that sucker! 103 104 print OURLIST join(',', @classArray) , "\n"; 105 } 106 close(OURLIST); 107 108 ## arrange the columns nicely 109 110 &columnPrint("$outfile","$outfile"); 111 112 113 114 sub columnPrint { 115 116 # Takes two parameters. The first is the filename of the 117 # delimited input file. The second is the name of the 118 # output file (these names may be the same). The permissions 119 # and group of the output file will be the same as the 120 # input file 121 122 # Takes any delimited (with \$DELIM delimiters) file and adds 123 # extra space if necessary to the fields so that all columns line up. 124 # The widest field in any column will contain exactly 2 spaces at the 125 # end of the (non space characters 0f the) field. For example 126 # ",a very long field entry ," at one extreme and ", ," at the other 127 # 128 my($inFileName,$outFileName)=@_; 129 my($line); 130 131 my ($permission, $gid) = (stat($inFileName))[2,5]; 132 $permission = ($permission & 0777); ##get rid of file type stuff 133 134 open(INFILE,"$inFileName") or wwerror("$0","can't open $inFileName for reading"); 135 my @inFile=<INFILE>; 136 close(INFILE); 137 138 &createFile($outFileName, $permission, $gid); 139 140 my @outFile = &columnArrayArrange(@inFile); 141 142 open(OUTFILE,">$outFileName") or wwerror("$0","can't open $outFileName for writing"); 143 foreach $line (@outFile) {print OUTFILE $line;} 144 close(OUTFILE); 145 } 146 147 sub columnArrayArrange { 148 149 ## takes as a parameter a delimited array 150 ## (such as you would get by reading in a delimited file) 151 ## where each element is a line from a delimited file. 152 153 # Outputs an array which adds 154 # extra space if necessary to the fields so that all columns line up. 155 # The widest field in any column will contain exactly 1 spaces at the 156 # end of the (non space characters of the) field. For example 157 # ",a very long field entry ," at one extreme and ", ," at the other 158 159 my @inFile=@_; 160 my($i,$tempFileName,$datString,$line); 161 my @outFile =(); 162 my(@fieldLength,@datArray); 163 $i=1; 164 165 @fieldLength=&getFieldLengths(\@inFile); 166 foreach $line (@inFile) { ## read through file array and get field lengths 167 unless ($line =~ /\S/) {next;} ## skip blank lines 168 chomp $line; 169 @datArray=&getRecord($line); 170 for ($i=0; $i <=$#datArray; $i++) { 171 $datArray[$i].=(" " x ($fieldLength[$i]+1-length("$datArray[$i]"))); 172 } 173 $datString=join(',',@datArray); 174 push @outFile , "$datString\n"; 175 } 176 @outFile; 177 } 178 179 sub createFile { 180 my ($fileName, $permission, $numgid) = @_; 181 182 open(TEMPCREATEFILE, ">$fileName") || 183 warn " Can't open $fileName"; 184 my @stat = stat TEMPCREATEFILE; 185 close(TEMPCREATEFILE); 186 187 ## if the owner of the file is running this script (e.g. when the file is first created) 188 ## set the permissions and group correctly 189 if ($< == $stat[4]) { 190 my $tmp = chmod($permission,$fileName) or 191 warn "Can't do chmod($permission, $fileName)"; 192 chown(-1,$numgid,$fileName) or 193 warn "Can't do chown($numgid, $fileName)"; 194 } 195 } 196 197 sub getFieldLengths { 198 199 ## takes as a parameter the reference to a delimited array 200 ## (such as you would get by reading in a delimited file) 201 ## where each element is a line from a delimited file. 202 ## returns an array which holds 203 ## the maximum field lengths in the file. 204 205 my ($datFileArray_ref)=@_; 206 my($i); 207 my(@datArray,@fieldLength,@datFileArray, $line); 208 @fieldLength=(); 209 @datFileArray=@$datFileArray_ref; 210 211 foreach $line (@datFileArray) { ## read through file and get field lengths 212 unless ($line =~ /\S/) {next;} ## skip blank lines 213 chomp $line; 214 @datArray=&getRecord($line); 215 for ($i=0; $i <=$#datArray; $i++) { 216 $fieldLength[$i] = 0 unless defined $fieldLength[$i]; 217 $fieldLength[$i]=&max(length("$datArray[$i]"),$fieldLength[$i]); 218 } 219 } 220 return (@fieldLength); 221 } 222 223 224 225 sub getRecord 226 227 # Takes a delimited line as a parameter and returns an 228 # array. Note that all white space is removed. If the 229 # last field is empty, the last element of the returned 230 # array is also empty (unlike what the perl split command 231 # would return). E.G. @lineArray=&getRecord(\$delimitedLine). 232 { 233 my $DELIM = ','; 234 my($line) = $_[0]; 235 my(@lineArray); 236 $line.='A'; # add 'A' to end of line so that 237 # last field is never empty 238 @lineArray = split(/\s*${DELIM}\s*/,$line); 239 $lineArray[$#lineArray] =~s/\s*A$//; # remove spaces and the 'A' from last element 240 $lineArray[0] =~s/^\s*//; # remove white space from first element 241 @lineArray; 242 } 243 sub max { ## find the max element of array 244 my $out = $_[0]; 245 my $num; 246 foreach $num (@_) { 247 if ((defined $num) and ($num > $out)) {$out = $num;} 248 } 249 $out; 250 }
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |