[BACK]Return to batchcreatecourse.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / automation

Diff for /loncom/automation/batchcreatecourse.pm between versions 1.1 and 1.16

version 1.1, 2005/01/30 15:37:03 version 1.16, 2006/07/08 17:29:24
Line 1 Line 1
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   
 package LONCAPA::batchcreatecourse;  package LONCAPA::batchcreatecourse;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::Enrollment;  use LONCAPA::Enrollment;
Line 5  use HTML::Parser; Line 31  use HTML::Parser;
 use Time::Local;  use Time::Local;
 use Apache::Constants;   use Apache::Constants; 
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon;
 use Apache::loncreatecourse;  use Apache::loncreatecourse;
   use Apache::loncreateuser;
 use Apache::lonlocal;  use Apache::lonlocal;
   
   use strict;
   
 # Collection of routines used for batch creation of courses and users.  # Collection of routines used for batch creation of courses and users.
 # &create_courses() should be called by an Autocreate.pl  # &create_courses() should be called by an Autocreate.pl
 # script via a cron entry, or alternatively from a web page, after upload   # script via a cron entry, or alternatively from a web page, after upload 
 # of a file containing an XML description of a course request (lonbatchccrs.pm).  # of a file containing an XML description of a course request (lonbatchccrs.pm).
 #   # 
 # XML file(s) describing courses that are to be created in domain $dom are stored in  # XML file(s) describing courses that are to be created in domain $dom are stored in
 # /home/httpd/perl/tmp/addcourse/$dom. Each XML file is deleted after it has been  # /home/httpd/perl/tmp/addcourse/$dom
 # parsed.  
 #  #
 # &create_courses() will create an account for the course owner   # &create_courses() will create an account for the course owner 
 # (if one does not currently exist), will create the course (cloning if necessary),  # (if one does not currently exist), will create the course (cloning if necessary),
Line 27  use Apache::lonlocal; Line 56  use Apache::lonlocal;
 #<!DOCTYPE text>  #<!DOCTYPE text>
 #<class id="ss05ubw101">  #<class id="ss05ubw101">
 # <title>Underwater Basket Weaving</title>  # <title>Underwater Basket Weaving</title>
   # <crstype>Course</crstype>
 # <coursecode>ss05ubw101</coursecode>  # <coursecode>ss05ubw101</coursecode>
 # <coursehome>msul1</coursehome>  # <coursehome>msul1</coursehome>
 # <coursedomain>msu</coursedomain>  # <coursedomain>msu</coursedomain>
Line 45  use Apache::lonlocal; Line 75  use Apache::lonlocal;
 # <nonstandard></nonstandard>  # <nonstandard></nonstandard>
 # <topmap></topmap>  # <topmap></topmap>
 # <firstres>nav</firstres>  # <firstres>nav</firstres>
   # <crsquota>20</crsquota>
 # <clonecrs>466011437c34194msul1</clonecrs>  # <clonecrs>466011437c34194msul1</clonecrs>
 # <clonedom>msu</clonedom>  # <clonedom>msu</clonedom>
 # <showphotos></showphotos>  # <showphotos></showphotos>
Line 125  use Apache::lonlocal; Line 156  use Apache::lonlocal;
 # A value of 0 or blank is equivalent to an unchecked box or 'No'  # A value of 0 or blank is equivalent to an unchecked box or 'No'
 # response. Dates are in format YYYY:MM:DD:HH:MM:SS (:separators required)  # response. Dates are in format YYYY:MM:DD:HH:MM:SS (:separators required)
 #  #
 # firstres can be nav, syl , or blank for "Navigate Contents", Syllabus, or  # firstres can be nav, syl, or blank for "Navigate Contents", Syllabus, or
 # no entry respectively.  # no entry respectively.
   # 
   # crstype can be Course or Group
   #
   # crsquota is the total disk space permitted for course group portfolio files
   # in all course groups.
   # 
 # For format of other parameters, refer to the interactive CCRS page  # For format of other parameters, refer to the interactive CCRS page
 # and view how the equivalent parameter is displayed in the web form.    # and view how the equivalent parameter is displayed in the web form.  
 #    #  
Line 135  use Apache::lonlocal; Line 172  use Apache::lonlocal;
 #                    files listed in @$requests are deleted  #                    files listed in @$requests are deleted
 #                    after the files have been parsed.  #                    after the files have been parsed.
 #  #
 #                    Directory searched for files listed in @$requests  #                    Directory for retrieval of files listed in @$requests is: 
 #                    is /home/httpd/perl/tmp/addcourse/$dom/auto if $context is auto  #                    /home/httpd/perl/tmp/addcourse/$dom/auto/pending if $context = auto
 #                    and /home/httpd/perl/tmp/addcourse/$dom/web/$uname if $context is web  #                    /home/httpd/perl/tmp/addcourse/$dom/web/$uname_$udom/pending if $context = web
 #                      #                    
 # inputs (five)  -  requests - ref to array of filename(s) containing course requests   # inputs (five)  -  requests - ref to array of filename(s) containing course requests 
 #                   courseids - ref to hash to store LON-CAPA course ids of new courses   #                   courseids - ref to hash to store LON-CAPA course ids of new courses 
 #                   context - auto if called from command line, web if called from browser  #                   context - auto if called from command line, web if called from browser
 #                   dom - domain for which the course is being created  #                   dom - domain for which the course is being created
 #                   uname - username of DC who is requesting course creation from browser  #                   uname - username of DC who is requesting course creation
   #                   udom - domain of DC who is requesting course creation
 #    #  
 # outputs (three)  -  output - text recording user roles added etc.  # outputs (three)  -  output - text recording user roles added etc.
 #                     logmsg - text to be logged  #                     logmsg - text to be logged
Line 151  use Apache::lonlocal; Line 189  use Apache::lonlocal;
 #############################################################  #############################################################
   
 sub create_courses {  sub create_courses {
     my ($requests,$courseids,$context,$dom,$uname) = @_;      my ($requests,$courseids,$context,$dom,$uname,$udom) = @_;
     my $output;      my $output;
     my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');      my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
 # Get role names  # Get role names
     my %longroles = ();      my %longroles = ();
     open(FILE,"<$perlvarref{'lonTabDir'}.'/rolesplain.tab");      open(FILE,"<$$perlvarref{'lonTabDir'}.'/rolesplain.tab");
     my @rolesplain = <FILE>;      my @rolesplain = <FILE>;
     close(FILE);      close(FILE);
     foreach (@rolesplain) {      foreach (@rolesplain) {
Line 167  sub create_courses { Line 205  sub create_courses {
     my ($logmsg,$keysmsg,$newusermsg,$addresult);      my ($logmsg,$keysmsg,$newusermsg,$addresult);
     my %enrollcount = ();      my %enrollcount = ();
     my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context;      my $newcoursedir = $$perlvarref{'lonDaemons'}.'/tmp/addcourse/'.$dom.'/'.$context;
     if ($uname) {      if ($context eq 'auto') {
         unless ($context eq 'auto') {          $newcoursedir .= '/pending';
             $newcoursedir .= '/'.$uname;      } else {
           if ($uname && $udom) {
               $newcoursedir .= '/'.$uname.'_'.$udom.'/pending';
           } else {
               $logmsg = "batchcreatecourse::create_courses() called without username and/or domain of requesting Domain Coordinator";
         }          }
     }      }
     if (@{$requests} > 0) {      if (@{$requests} > 0) {
Line 179  sub create_courses { Line 221  sub create_courses {
                 &parse_coursereqs($newcoursedir.'/'.$request, \%details);                  &parse_coursereqs($newcoursedir.'/'.$request, \%details);
                 foreach my $num (sort keys %details) {                  foreach my $num (sort keys %details) {
                     my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);                      my $courseid = &build_course($dom,$num,$context,\%details,\%longroles,\$logmsg,\$newusermsg,\$addresult,\%enrollcount,\$output,\$keysmsg);
                     $$courseids{$courseid} = $enrollcount;                      $$courseids{$courseid} = $details{$num}{'class'};
                 }                  }
             }              }
         }          }
Line 207  sub parse_coursereqs { Line 249  sub parse_coursereqs {
     my $xlist = 0;      my $xlist = 0;
     my $userkey = '';      my $userkey = '';
     my $role = '';      my $role = '';
     my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','showphotos','setpolicy','setcontent','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc');      my @items = ('title','optional_id','coursecode','coursehome','reshome','nonstandard','adds','drops','topmap','firstres','clonecrs','clonedom','showphotos','setpolicy','setcontent','setkeys','keyauth','disresdis','disablechat','openall','notify_owner','notify_dc','crstype','crsquota');
     my @dateitems = ('enrollstart','enrollend','accessstart','accessend');      my @dateitems = ('enrollstart','enrollend','accessstart','accessend');
     my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');      my @useritems = ('autharg','authtype','firstname','generation','lastname','middlename','studentID');
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
Line 260  sub parse_coursereqs { Line 302  sub parse_coursereqs {
                  } elsif ("@state" eq "class owner authtype") {                   } elsif ("@state" eq "class owner authtype") {
                     $$details{$num}{'ownerauthtype'} = $text;                      $$details{$num}{'ownerauthtype'} = $text;
                  } elsif ("@state" eq "class owner autharg") {                   } elsif ("@state" eq "class owner autharg") {
                     $$details{$num}{'ownerautharg'} = $text;                      $$details{$num}{'ownerauthparam'} = $text;
                  } elsif ("@state" eq "class authentication method") {                   } elsif ("@state" eq "class authentication method") {
                     $$details{$num}{'authtype'} = $text;                      $$details{$num}{'authtype'} = $text;
                  } elsif ("@state" eq "class authentication param") {                   } elsif ("@state" eq "class authentication param") {
Line 318  sub parse_coursereqs { Line 360  sub parse_coursereqs {
   
     $p->parse_file($coursefile);      $p->parse_file($coursefile);
     $p->eof;      $p->eof;
     if (-e "$coursefile") {  
 #        unlink $coursefile;  
     }  
     return;      return;
 }  }
   
Line 347  sub parse_coursereqs { Line 386  sub parse_coursereqs {
 #########################################################  #########################################################
   
 sub build_course {  sub build_course {
     my ($cdom,$num,$context,$details,$longoles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg) = @_;      my ($cdom,$num,$context,$details,$longroles,$logmsg,$newusermsg,$addresult,$enrollcount,$output,$keysmsg,$udom,$uname) = @_;
     my $owner_uname = $$details{$num}{'owner'};      my $owner_uname = $$details{$num}{'owner'};
     my $owner_domain = $$details{$num}{'domain'};      my $owner_domain = $$details{$num}{'domain'};
     my $owner = $owner_uname.':'.$owner_domain;      my $owner = $owner_uname.':'.$owner_domain;
Line 374  sub build_course { Line 413  sub build_course {
         $firstres = 'syl';          $firstres = 'syl';
     }      }
     foreach my $secid (sort keys %{$$details{$num}{'sections'}}) {      foreach my $secid (sort keys %{$$details{$num}{'sections'}}) {
         $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'};          $sectionstr .= $$details{$num}{'sections'}{$secid}{'inst'}.':'.$$details{$num}{'sections'}{$secid}{'loncapa'}.',';
     }      }
       $sectionstr =~ s/,$//;
   
     foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) {      foreach my $xlist (sort keys %{$$details{$num}{'crosslists'}}) {
         $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'};          $xliststr .= $$details{$num}{'crosslists'}{$xlist}{'inst'}.':'.$$details{$num}{'crosslists'}{$xlist}{'loncapa'}.',';
     }      }
       $xliststr =~ s/,$//;
   
     my %courseinfo = (      my %courseinfo = (
                       inst_code => $$details{$num}{'coursecode'},                        inst_code => $$details{$num}{'coursecode'},
                       description => $$details{$num}{'title'}                        description => $$details{$num}{'title'}
                      );                        ); 
     if (&Apache::lonnet::homeserver($$details{$num}{'owner'},$$details{$num}{'domain'}) eq 'no_host') { # Add user if no account      if (&Apache::lonnet::homeserver($$details{$num}{'owner'},$$details{$num}{'domain'}) eq 'no_host') { # Add user if no account
         my $ownerargs = ('auth' => $$details{$num}{'ownerauthtype'},          my $ownerargs = {'auth' => $$details{$num}{'ownerauthtype'},
                     'authparam' => $$details{$num}{'ownerauthparam'},                      'authparam' => $$details{$num}{'ownerauthparam'},
                     'emailenc' => $$details{$num}{'emailenc'},                      'emailenc' => $$details{$num}{'emailenc'},
                     'dom' => $$details{$num}{'domain'},                      'udom' => $$details{$num}{'domain'},
                     'uname' => $$details{$num}{'owner'},                      'uname' => $$details{$num}{'owner'},
                     'pid' => '',                      'pid' => $$details{$num}{'users'}{$owner}{'studentID'},
                     'first' => $$details{$num}{'users'}{$owner}{'first'},                      'first' => $$details{$num}{'users'}{$owner}{'firstname'},
                     'middle' => $$details{$num}{'users'}{$owner}{'middle'},                      'middle' => $$details{$num}{'users'}{$owner}{'middlename'},
                     'last' => $$details{$num}{'users'}{$owner}{'last'},                      'last' => $$details{$num}{'users'}{$owner}{'lastname'},
                     'gene' => $$details{$num}{'users'}{$owner}{'gene'},                      'gene' => $$details{$num}{'users'}{$owner}{'generation'},
                     'usec' => '',                      'usec' => '',
                     'end' => '',                      'end' => '',
                     'start' => '',                      'start' => '',
Line 403  sub build_course { Line 444  sub build_course {
                     'cid' => '',                      'cid' => '',
                     'context' => 'createowner',                      'context' => 'createowner',
                     'linefeed' => $linefeed,                      'linefeed' => $linefeed,
                     'role' => 'cc'                      'role' => 'cc',
                    );                     };
         $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo);          $outcome = &LONCAPA::Enrollment::create_newuser($ownerargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo);
     } else {      } else {
         $outcome = 'ok';          $outcome = 'ok';
     }      }
   
     my $courseargs = {      if ($outcome eq 'ok') {
           my $courseargs = {
                ccuname => $$details{$num}{'owner'},                 ccuname => $$details{$num}{'owner'},
                ccdomain => $$details{$num}{'domain'},                 ccdomain => $$details{$num}{'domain'},
                cdescr => $$details{$num}{'title'},                 cdescr => $$details{$num}{'title'},
                  crstype => $$details{$num}{'crstype'},
                curl => $$details{$num}{'topmap'},                 curl => $$details{$num}{'topmap'},
                course_domain => $cdom,                 course_domain => $cdom,
                course_home =>  $$details{$num}{'coursehome'},                 course_home =>  $$details{$num}{'coursehome'},
                nonstandard => $$details{$num}{'nonstandard'},                 nonstandard => $$details{$num}{'nonstandard'},
                crscode => $$details{$num}{'coursecode'},                 crscode => $$details{$num}{'coursecode'},
                  crsquota => $$details{$num}{'crsquota'},
                clonecourse => $$details{$num}{'clonecrs'},                 clonecourse => $$details{$num}{'clonecrs'},
                clonedomain => $$details{$num}{'clonedom'},                 clonedomain => $$details{$num}{'clonedom'},
                crsid => $$details{$num}{'optional_id'},                 crsid => $$details{$num}{'optional_id'},
Line 437  sub build_course { Line 481  sub build_course {
                enrollend => $$details{$num}{'enrollend'},                 enrollend => $$details{$num}{'enrollend'},
                startaccess => $$details{$num}{'accessstart'},                 startaccess => $$details{$num}{'accessstart'},
                endaccess => $$details{$num}{'accessend'},                 endaccess => $$details{$num}{'accessend'},
                setpolicy => $Sdetails{$num}{'setpolicy'},                 setpolicy => $$details{$num}{'setpolicy'},
                setcontent => $$details{$num}{'setcontent'},                 setcontent => $$details{$num}{'setcontent'},
                reshome => $reshome,                 reshome => $reshome,
                setkeys => $$details{$num}{'setkeys'},                 setkeys => $$details{$num}{'setkeys'},
Line 448  sub build_course { Line 492  sub build_course {
                firstres => $firstres                 firstres => $firstres
                };                 };
   
     if ($outcome eq 'ok') {  
         my %host_servers = &Apache::loncommon::get_library_servers($cdom);          my %host_servers = &Apache::loncommon::get_library_servers($cdom);
         if (! exists($host_servers{$$details{$num}{'coursehome'}})) {          if (! exists($host_servers{$$details{$num}{'coursehome'}})) {
             $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};              $$logmsg .= &mt('Invalid home server for course').': '.$$details{$num}{'coursehome'};
             return;              return;
         }          }
   
         &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum);          &Apache::loncreatecourse::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname);
     } else {      } else {
         return;          return;
     }      }
Line 477  sub build_course { Line 520  sub build_course {
             my ($username,$userdom) = split/:/,$userkey;              my ($username,$userdom) = split/:/,$userkey;
             if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account              if (&Apache::lonnet::homeserver($username,$userdom) eq 'no_host') { # Add user if no account
                 my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0];                  my $firstrole = $$details{$num}{'users'}{$userkey}{'roles'}[0];
                 my $firssec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0];                  my $firstsec = $$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}[0];
                 my $userargs = ('auth' => $$details{$num}{'users'}{$userkey}{'authtype'},                  my $userargs = {
                     'authparam' => $$details{$num}{'users'}{$userkey}{'authparam'},                      'auth' => $$details{$num}{'users'}{$userkey}{'authtype'},
                       'authparam' => $$details{$num}{'users'}{$userkey}{'autharg'},
                     'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'},                      'emailenc' => $$details{$num}{'users'}{$userkey}{'emailenc'},
                     'dom' => $userdom,                      'udom' => $userdom,
                     'uname' => $username,                      'uname' => $username,
                     'pid' => $$details{$num}{'users'}{$userkey}{'studentID'},                      'pid' => $$details{$num}{'users'}{$userkey}{'studentID'},
                     'first' => $$details{$num}{'users'}{$userkey}{'first'},                      'first' => $$details{$num}{'users'}{$userkey}{'firstname'},
                     'middle' => $$details{$num}{'users'}{$userkey}{'middle'},                      'middle' => $$details{$num}{'users'}{$userkey}{'middlename'},
                     'last' => $$details{$num}{'users'}{$userkey}{'last'},                      'last' => $$details{$num}{'users'}{$userkey}{'lastname'},
                     'gene' => $$details{$num}{'users'}{$userkey}{'gene'},                      'gene' => $$details{$num}{'users'}{$userkey}{'generation'},
                     'usec' => $firstsec,                      'usec' => $firstsec,
                     'end' => $$details{$num}{'users'}{$userkey}{'end'},                      'end' => $$details{$num}{'users'}{$userkey}{'end'},
                     'start' => $$details{$num}{'users'}{$userkey}{'start'},                      'start' => $$details{$num}{'users'}{$userkey}{'start'},
                     'emailaddr' => $$details{$num}{'users'}{$userkey}{'email'},                      'emailaddr' => $$details{$num}{'users'}{$userkey}{'emailaddr'},
                     'cid' => $courseid,                      'cid' => $courseid,
                       'crs' => $crsunum,
                       'cdom' => $crsudom,
                     'context' => 'createcourse',                      'context' => 'createcourse',
                     'linefeed' => $linefeed,                      'linefeed' => $linefeed,
                     'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0],                       'role' => $$details{$num}{'users'}{$userkey}{'roles'}[0], 
                    );                     };
                 $outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo);                  $outcome = &LONCAPA::Enrollment::create_newuser($userargs,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,\%courseinfo);
 # now add other roles and other sections.  # now add other roles and other sections.
                 if ($outcome eq 'ok') {                  if ($outcome eq 'ok') {
                     if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {                      if (($firstrole ne 'st') && (@{$$details{$num}{'users'}{$userkey}{$firstrole}{'usec'}} > 1)) {
Line 555  sub build_course { Line 601  sub build_course {
                                 if ($usec ne '') {                                  if ($usec ne '') {
                                     $url .= '/'.$usec;                                      $url .= '/'.$usec;
                                 }                                  }
                                 $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);                                  my $stdresult = &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,$usec);
                                 $url = '/'.$crsudom.'/'.$crsunum;                                  $$output .= $stdresult;
                                 if ($usec ne '') {  
                                     $url .= '/'.$usec;  
                                 }  
                             }                              }
                         } else {                          } else {
                               $url = '/'.$crsudom.'/'.$crsunum;
                             $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'');                              $$output .= &Apache::loncreateuser::commit_standardrole($userdom,$username,$url,$curr_role,$start,$end,$crsudom,$crsunum,'');
                         }                          }
                     }                      }
Line 592  sub build_course { Line 636  sub build_course {
 sub process_date {  sub process_date {
     my $timestr = shift;      my $timestr = shift;
     my $timestamp = '';      my $timestamp = '';
     if ($timestr eq "No end date") {      if ($timestr !~ /:/) {
         $timestamp = '';          $timestamp = '';
     } else {      } else {
         my @entries = split/:/,$timestr;          my @entries = split(/:/,$timestr);
         for (my $j=0; $j<@entries; $j++) {          for (my $j=0; $j<@entries; $j++) {
             if ( length($entries[$j]) > 1 ) {              if ( length($entries[$j]) > 1 ) {
                 $entries[$j] =~ s/^0//;                  $entries[$j] =~ s/^0//;
             }              }
               $entries[$j] =~ s/\D//g;
               if ($entries[$j] < 0) {
                   $entries[$j] = 0;
               }
           }
           if ($entries[1] > 0) {  
               $entries[1] = $entries[1] - 1;
           }
           if ($entries[5] > 60) {
               $entries[5] = 60;
         }          }
         $entries[1] = $entries[1] - 1;          if ($entries[4] > 59) {
               $entries[4] = 59;
           }
           if ($entries[3] > 23) {
               $entries[3] = 23;
           }
           if ($entries[2] > 31) {
               $entries[2] = 31;
           }
           if ($entries[1] > 11) {
               $entries[1] = 11;
           }
           if ($entries[2] == 31) {
               if (($entries[1] == 3) || ($entries[1] == 5) ||
                   ($entries[1] == 8) || ($entries[1] == 10)) {
                   $entries[2] = 30;
               }
           }
           if ($entries[1] == 1) {
               if ($entries[2] > 29) {
                   $entries[2] = 29;
               }
               if ($entries[2] == 29) {
                   if ($entries[0]%4 != 0) {
                       $entries[2] = 28;
                   } elsif ( $entries[0]%100 == 0
     && $entries[0]%400 != 0) {
       $entries[2] = 28;
    }
               }
           }     
         $timestamp =  timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);          $timestamp =  timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
     }      }
     return $timestamp;      return $timestamp;
Removed from v.1.1  
changed lines
  Added in v.1.16

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