#!/usr/bin/perl
#
# Blackboard Archive: Archives all the current courses
#
# While there are certainly better ways to backup courses on blackboard there
# aren't many good solutions if you don't have access to the box (i.e. ASP
# hosting).  This script logs into blackboard, finds all active courses, and
# downloads them via the Archive Course link.
#
#
# +----------------------------------------------------------------------+
# | Copyright (c) 2005 Jason Rust <jrust@brooks.edu>                     |
# +----------------------------------------------------------------------+
# | This source file is subject to the GNU Lesser Public License (LGPL), |
# | that is bundled with this package in the file LICENSE, and is        |
# | available at through the world-wide-web at                           |
# | http://www.fsf.org/copyleft/lesser.html                              |
# | If you did not receive a copy of the LGPL and are unable to          |
# | obtain it through the world-wide-web, you can get it by writing the  |
# | Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, |
# | MA 02111-1307, USA.                                                  |
# +----------------------------------------------------------------------+
# {{{ Config

### Blackboard config ###
# The url to the login page of your BB installation
my $bb_login_url = 'http://school.blackboard.com/webapps/login';
# The url of "List All Courses"
my $bb_list_courses_url = 'http://school.blackboard.com/bin/admin/search.pl?action=RESULTS&context=COURSE&type=LISTALL&operation=MODIFY';
# The url of the "Archive Course"
my $bb_archive_url = 'http://school.blackboard.com/webapps/blackboard/execute/contentExchange?navItem=archive_course';
# The username of a BB admin
my $bb_user = 'username';
# The password of the user
my $bb_passwd = 'password';

### Backup config ###
# The base directory in which to store archived courses
my $backup_dir = '/tmp/bb';

# }}}
# {{{ run

use strict;
use WWW::Mechanize;
use MIME::Base64;
use POSIX qw(strftime);
use File::Basename;
archive_courses();

# }}}
# {{{ archive_courses()

# Logs on to blackboard and downloads the archive of each course
sub archive_courses()
{
    my $browser = WWW::Mechanize->new(autocheck => 1, quiet => 0);
    $browser->get($bb_login_url);
    $browser->form_number(1);
    $browser->field('user_id', $bb_user);
    $browser->field('encoded_pw', encode_base64($bb_passwd));
    $browser->click();
    die "Could not log in to Blackboard" if ($browser->{'content'} !~ /<b>You are being redirected to another page<\/b>/);

    my @course_list = get_course_list($browser);
    $backup_dir .= '/' . strftime("%m-%d-%Y", localtime) . '/';
    unless (-d $backup_dir) {
        mkdir $backup_dir or die "Could not make backup directory $backup_dir";
    }

    print "Beginning Archive for " . strftime("%m-%d-%Y", localtime) . "\n";
    print "-" x 40 . "\n";
    foreach my $course (@course_list) {
        $browser->get($bb_archive_url);
        $browser->form_number(1);
        $browser->field('courseId', $course);
        $browser->click();
        my $link = $browser->find_link( n => 3 );
        my $response = $browser->mirror($link->url_abs(), $backup_dir . basename($link->url_abs()));
        if ($response->is_success) {
            print "Archived Successfully: $course\n";
        }
        else {
            print STDERR "Error Archiving $course\: " . $response->status_line . "\n";
        }
    }
}

# }}}
# {{{ get_course_list()

# Gets the id of all courses.
sub get_course_list()
{
    my $browser = shift;
    $browser->get($bb_list_courses_url);
    my $num_courses = 0;
    if ($browser->{'content'} =~ /<font size="3" class="fnt0">(\d+)/) {
        $num_courses = $1;
    }
    
    if ($num_courses == 0) {
        die "Could not find any courses to archive.";
    }

    my @courses = ();

    for (my $i = 0; $i < $num_courses; $i += 25) {
        # No need to refetch first page
        if ($i != 0) {
            $browser->get($bb_list_courses_url . "&cursor=$i");
        }

        my @tmp_courses = $browser->{'content'} =~ /<A.*?tab=courses.*?>(.*?)<\/A>/g;
        push @courses, @tmp_courses;
    }

    # Sanity check
    if ($#courses != --$num_courses) {
        print STDERR "Uh Oh!  Found $#courses courses but we were supposed to find $num_courses\n";
    }

    return @courses;
}

# }}}