[LON-CAPA-cvs] cvs: modules /raeburn autocreation.pl

[raeburn]

raeburn		Wed Apr 27 19:52:21 2005 EDT

  Added files:                 
    /modules/raeburn	autocreation.pl 
  Log:
  CGI script to run on zaphod to respond to requests from s12 for XML files for courses in pending queue awaiting course creation for which the course owner is authorized - based on CLIFMS. 
  
  

Index: modules/raeburn/autocreation.pl
+++ modules/raeburn/autocreation.pl
#!/usr/local/bin/perl

use strict;
use lib qw(/home/helpdesk/lib/);
use CGI;
use ROInfo;
my $q = new CGI;
print $q->header( "text/plain" );
my $topdir = "/home/helpdesk/admindata/creator/formdata";
my $pending_dir = $topdir."/pending";
my $processed_dir = $topdir."/processed";
my $xml_dir = $topdir."/req_xml";
opendir(DIR,$pending_dir);
my @dirs = grep(!/^\./,readdir(DIR));
my %pending = ();
my $numwait = 0;
my $dbhro;
my @authclasses = ();
if ($ENV{'REMOTE_ADDR'} eq '35.9.119.112') {
    foreach my $wait (@dirs) {
        if (-e "$pending_dir/$wait") {
            $numwait ++;
            my ($user,$num) = split/-/,$wait;
            if (exists($pending{$user})) {
                push @{$pending{$user}},$num;
            } else {
                @{$pending{$user}} = ($num);
            }
        }
    }

    if ($numwait) {
        if (&clifms_connect(\$dbhro) eq 'ok') {
            foreach my $user (sort keys %pending) {
                my @authclasses = ();
                my $getclifmsresult = &getclifms($user,\@authclasses,\$dbhro);
                if ($getclifmsresult eq 'ok') {
                    foreach my $num (@{$pending{$user}}) {
                        my $wait = $user.'-'.$_;
                        my $longuser = substr($user,0,1).'/'.$user;
                        opendir(SUBDIR,"$xml_dir/$longuser/$num");
                        my @files = grep(!/^\./,readdir(SUBDIR));
                        foreach my $file (@files) {
                            if (grep/^$file$/,@authclasses) {
                                open(FILE,"<$xml_dir/$longuser/$num/$file");
                                my @buffer = <FILE>;
                                print @buffer;
                                unless ($pending_dir eq '' || $wait eq '') {
                                    unlink("$pending_dir/$wait");
                                }
                            }
                        }
                        print "\n";
                    }
                } else {
                    print STDERR "Problem retrieving data from RO_CLIFMS\n";
                }
            }
            &clifms_disconnect(\$dbhro);
        } else {
            print STDERR "Problem connecting to RO_CLIFMS\n";
        }
    }
}

sub clifms_connect {
    my $dbhro = shift;
    eval {$$dbhro = &ROInfo::DBM_CONNECT();};
    if ($@) {
        return 'fail';
    } else {
        return 'ok';
    }
}

sub clifms_disconnect {
    my $dbhro = shift;
    $$dbhro->disconnect;
    return 'ok';
}


sub getclifms {
    my ($user,$authclassref,$dbhro) = @_;
    eval{
        my $user_quoted = $$dbhro->quote( $user );
        my $sth = $$dbhro->prepare("SELECT Subj_Code,Crse_Code FROM RO_CLIFMS_VIEW WHERE MSUNetId = '$user'");
        $sth->execute;
        while (my ($subj,$crse) = $sth->fetchrow_array) {
            $subj =~ tr/A-Z/a-z/;
            $crse =~ tr/A-Z/a-z/;
            if (!grep/^$subj$crse$/,@{$authclassref}) {
                push @{$authclassref}, "$subj$crse";
            }
        }
        $sth->finish;
    };
    if ($@) {
       return 'fail';
    } else {
       return 'ok';
    }
}