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