kdmurphy001 has asked for the wisdom of the Perl Monks concerning the following question:

I'm getting this error and I've tried for hours to get past it but having no luck. It refer's to line 250. Depending on if the sub-routine is at the beginning or end it switches to line 228. It looks like any where you have the following code is where it errors out. 

for my $i(0..$#databases) {
my $host = $databases[$i][0];
my $database = $databases[$i][1];

[download]


Below is the full script. 

#!/usr/bin/perl

use strict;
use warnings;
use DBD::mysql;

######################
#### CONFIG VARS #####
######################

#Specify start and end dates to filter data
my $start_date = '2009-01-01';
my $end_date = '2009-05-01';

#Specify blocked institutions
my $blocked_institutions = "'xxx'";

my $domain_filter = "'xxx'";

my $output_file = 'xxxx';

######################
#### PRIVATE VARS ####
######################

my %hosts = (
    'xxxx' => 'yyyy',
);

my $db_user = 'xxxxxx';
my $db_pass = 'xxxxxx';


my @products = ('oooooo');
my $min_users=1;

###################################

#Subroutines

sub get_databases {
    my @database_urls;
    my ($host, $default_db, $db_user, $db_pass) = @_;
    my $dbh = DBI->connect("DBI:mysql:database=$default_db:host=$host"
+,$db_user,$db_pass,{RaiseError=>1})|| die "$DBI::errstr\n";
    my $sql = "SELECT DISTINCT IF(DatabaseURL = '.', '$default_db', SU
+BSTRING_INDEX(SUBSTRING_INDEX(DatabaseURL, '/', -1), '?', 1)) AS Data
+baseURL FROM Institutions WHERE WebSiteURL = '.' AND ID NOT IN ($bloc
+ked_institutions);";
    my $sth = $dbh->prepare ( $sql );
    $sth->execute();
    while (my @row = $sth->fetchrow_array()) {
        my $url = $row[0];
        push (@database_urls, $url);
    }
    $sth->finish();
    $dbh->disconnect();
    return @database_urls;
}

###################################

######################
#### MAIN BODY #######
######################

open OUTPUT, ">$output_file";
        
while (my ($host, $default_db) = each(%hosts)) {
    
    #get database urls for host
    my @databases = get_databases($host, $default_db, $db_user, $db_pa
+ss);
    @databases = sort(@databases);

#################################

#Iterate over the product array
my $product;

    my $abbr = '';
    my $name = '';
    my $product_class = '';
    my $isbn = '';
    my $discipline = '';

foreach $product (@products) {

    #Task: Get book data
    print "Getting book data for $product...\n";
    my ($abbr, $name, $product_class, $isbn, $discipline);
    my $dbh = DBI->connect("DBI:mysql:database=$default_db:host=$host"
+,"$db_user","$db_pass",{RaiseError=>1}) || die "$DBI::errstr\n";
    my $sql = "SELECT Abbr, Name, Product, ISBN, Discipline FROM BookL
+ist WHERE Abbr = '$product';";
    my $sth = $dbh->prepare ( $sql );
    $sth->execute();
    my $rows = $sth->rows;
    if ($rows == 1) {
        while (my @row = $sth->fetchrow_array()) {
            $abbr = $row[0];
            $name = $row[1];
            $product_class = $row[2];
            $isbn = $row[3];
            $discipline = $row[4];
        }
    } else {
        print "There was an error looking up product code $product! Pl
+ease check product code\n";
        die;
    }
    #Task: Get usage
    
    my $total_assignments = 0;
    my $active_assignments = 0;
    my $instructor_count = 0;
    my $student_count = 0;
    my $take_count = 0;
    my $st_assignment_count = 0;
    my $st_student_count = 0;
    my $st_take_count = 0;
    my $prof_name='';
    my $inst_name='';
    my $last_login='';
    my $email='';
    
#    print "\nTest: ", $product_class;
    
    #Processes for test/homework banks
    if (lc($product_class) eq "testbank"
     || lc($product_class) eq "homework"
     || lc($product_class) eq "bctest") {
         
         for my $i(0..$#databases) {
            my $host = $databases[$i][0];
            my $database = $databases[$i][1];
            print "Processing $product on $host/$database...\n";
            my $dbh = DBI->connect("DBI:mysql:database=$database:host=
+$host","remote","lunar",{RaiseError=>1}) || die "$DBI::errstr\n";
            
            #Subtask: Get total assignment count and assignment ids
            my @all_assignment_ids;
            {
                my $sql = "
                SELECT
                    DISTINCT a.ID AS AssignmentID
                FROM
                    Assignments AS a
                    JOIN Tests AS t ON a.AssignmentTestID = t.ID
                    JOIN Users AS u ON t.UserID = u.ID
                WHERE
                    t.IData REGEXP '=\"$abbr/.*'
                    AND u.InstitutionID NOT IN '$blocked_institutions'
                    AND u.Name NOT REGEXP '$domain_filter'
                    AND u.Email NOT REGEXP '$domain_filter';";
                my $sth = $dbh->prepare ( $sql );
                $sth->execute();
                my $rows = $sth->rows;
                if ($rows > 0 ){                
                    $total_assignments = $total_assignments + $rows;
                    while ( my @row = $sth->fetchrow_array ()) {
                        my $id = "'$row[0]'";
                        push (@all_assignment_ids, $id);
                    }
                } else {
                    push (@all_assignment_ids, 0); #This is a hack
                }
                $sth->finish();
            }
            my $IN_assignment_ids = join (",", @all_assignment_ids);
            
            #Subtask: Get active assignments, the number of distinct u
+sers who have accessed the assignments, and the number of takes
            my @active_assignment_ids;
            {
                my $sql = "
                SELECT
                    AssignmentID,
                    COUNT(DISTINCT(UserID)) AS UserCount,
                    IF(SUM(TimesTaken) IS NULL,0,SUM(TimesTaken)) AS T
+akes
                FROM
                    AssignmentResults
                WHERE
                    DATE(StartedAt) >= '$start_date'
                    AND DATE(StartedAt) <= '$end_date'
                    AND AssignmentID IN ($IN_assignment_ids)
                GROUP BY AssignmentID
                HAVING UserCount >= $min_users;";
                my $sth = $dbh->prepare ( $sql );
                $sth->execute();
                my $rows = $sth->rows;
                if ($rows > 0 ) {
                    $active_assignments = $active_assignments + $rows;
                    while (my @row = $sth->fetchrow_array()) {
                        my $id = "'$row[0]'";
                        push (@active_assignment_ids, $id);

                        $student_count = $student_count + $row[1];
                        $take_count = $take_count + $row[2];
                    }
                } else {
                    push (@active_assignment_ids, 0); #This is a hack
                }
                $sth->finish();
            }
            my $IN_active_assignment_ids = join (",", @active_assignme
+nt_ids);
                
                #Get Assignment User Name and Institution Name
                my @Assignment_Owner_Info;
                {
                    my $sql = "
                    SELECT
                        CONCAT(u.FirstName,' ',u.LastName) AS Name, u.
+EMail AS EMail, i.Name AS Institution, u.LastLoginAt AS LastLogin
                    FROM
                        Users AS u JOIN
                        Institutions AS I ON u.InstitutionID=i.ID
                        JOIN Assignments AS a ON u.ID=a.OwnerID
                    WHERE
                        a.ID IN ($IN_assignment_ids)";
                        my $sth = $dbh->prepare ( $sql );
                        $sth->execute();
                        my $rows = $sth->rows;
                        if ($rows == 1) {
                            while (my @row = $sth->fetchrow_array()) {
                                $prof_name = $row[0];
                                $email = $row[1];  
                                $inst_name = $row[2];
                                $last_login = $row[3];
                                 }
                        }
                }

        
                        
            
            $dbh->disconnect();
     } #End institutions iteration
         
         print OUTPUT $name . "\t" .
                       $abbr . "\t" .
                       $product_class . "\t" .
                       $isbn . "\t" .
                       $discipline . "\t" .
                       $instructor_count . "\t" .
                       $active_assignments . "\t" .
                       $student_count . "\t" .
                       $take_count . "\n";
             
         
     } #End test/homework bank proccessing
          
     #Processes for courseware and forms products
     elsif (lc($product_class) eq "courseware" || lc($product_class) e
+q "forms") {

         for my $i(0..$#databases) {
            my $host = $databases[$i][0];
            my $database = $databases[$i][1];
            print "Processing $product on $host/$database...\n";
            my $dbh = DBI->connect("DBI:mysql:database=$database:host=
+$host","remote","lunar",{RaiseError=>1}) || die "$DBI::errstr\n";
            
            #Subtask: Get total assignment count and assignment ids
            my @all_assignment_ids;
            {
                my $sql = "
                SELECT
                    DISTINCT a.ID AS AssignmentID
                FROM
                    Assignments AS a
                    JOIN Sections AS s ON a.SectionID = s.ID
                    JOIN Users AS u ON s.OwnerID = u.ID
                WHERE
                    SUBSTRING_INDEX(SUBSTRING_INDEX(a.AssignmentData,'
+?book=',-1),'&',1) = '$abbr'
                    AND u.InstitutionID NOT IN ($blocked_institutions)
                    AND u.Name NOT REGEXP '$domain_filter'
                    AND u.Email NOT REGEXP '$domain_filter';";
                my $sth = $dbh->prepare ( $sql );
                $sth->execute();
                my $rows = $sth->rows;
                if ($rows > 0 ){
                    
                    $total_assignments = $total_assignments + $rows;
                    while ( my @row = $sth->fetchrow_array ()) {
                        my $id = "'$row[0]'";
                        push (@all_assignment_ids, $id);
                    }
                } else {
                    push (@all_assignment_ids, 0); #This is a hack
                }
                $sth->finish();
            }
            my $IN_assignment_ids = join (",", @all_assignment_ids);
            
            #Subtask: Get active assignments, the number of distinct u
+sers who have accessed the assignments, and the number of takes
            my @active_assignment_ids;
            {
                my $sql = "
                SELECT
                    AssignmentID,
                    COUNT(DISTINCT(UserID)) AS UserCount,
                    IF(SUM(TimesTaken) IS NULL,0,SUM(TimesTaken)) AS T
+akes
                FROM
                    AssignmentResults
                WHERE
                    DATE(StartedAt) >= '$start_date'
                    AND DATE(StartedAt) <= '$end_date'
                    AND AssignmentID IN ($IN_assignment_ids)
                GROUP BY AssignmentID
                HAVING UserCount >= $min_users;";
                my $sth = $dbh->prepare ( $sql );
                $sth->execute();
                my $rows = $sth->rows;
                if ($rows > 0 ) {
                    $active_assignments = $active_assignments + $rows;
                    while (my @row = $sth->fetchrow_array()) {
                        my $id = "'$row[0]'";
                        push (@active_assignment_ids, $id);

                        $student_count = $student_count + $row[1];
                        $take_count = $take_count + $row[2];
                    }
                } else {
                    push (@active_assignment_ids, 0); #This is a hack
                }
                $sth->finish();
            }
            my $IN_active_assignment_ids = join (",", @active_assignme
+nt_ids);
            
            #Subtask: Get self study assignment usage
            {
                my $sql = "
                SELECT
                    COUNT(DISTINCT(ar.ID)) AS SelfStudyAssignmentCount
+,
                    COUNT(DISTINCT(ar.UserID)) AS SelfStudyUserCount,
                    IF(SUM(TimesTaken) IS NULL,0,SUM(TimesTaken)) AS S
+elfStudyTakesCount
                FROM
                    Assignments AS a
                    JOIN Sections AS s ON a.SectionID = s.ID
                    JOIN AssignmentResults AS ar ON a.ID = ar.Assignme
+ntID
                WHERE
                    SUBSTRING_INDEX(SUBSTRING_INDEX(a.AssignmentData,'
+?book=',-1),'&',1) = '$abbr'
                    AND s.OwnerID = 0
                    AND s.InstitutionID NOT IN ($blocked_institutions)
                    AND DATE(ar.StartedAt) >= '$start_date'
                    AND DATE(ar.StartedAt) <= '$end_date';";
                my $sth = $dbh->prepare ( $sql );
                $sth->execute();
                my $rows = $sth->rows;
                if ($rows > 0 ) {
                    while (my @row = $sth->fetchrow_array()) {
                        $st_assignment_count = $st_assignment_count + 
+$row[0];
                        $st_student_count = $st_student_count + $row[1
+];
                        $st_take_count = $st_take_count + $row[2];
                    }
                } 
                $sth->finish();    
            }
            
            $dbh->disconnect();
         } #End institutions iteration
         
         print OUTPUT $name . "\t" .
                       $abbr . "\t" .
                       $product_class . "\t" .
                       $isbn . "\t" .
                       $discipline . "\t" .
                       $instructor_count . "\t" .
                       $active_assignments . "\t" .
                       $student_count . "\t" .
                       $take_count . "\t" .
                       $st_assignment_count . "\t" .
                       $st_student_count . "\t" .
                       $st_take_count . "\n";

     } #End courseware processing
     
     else {
         print "The product class $product_class is not supported by t
+his utility\n";
         die;
     }
} #End proudct iteration

}

close OUTPUT;
print "Completed!\n";

[download]

Any help would be greatly appreciated as I'm stumped atm.

Replies are listed 'Best First'.
Re: Can't use string ("blah") as an ARRAY ref while "strict refs" in use at..
by chromatic (Archbishop) on Mar 27, 2009 at 05:58 UTC

    Given that @database_urls gets populated with:

    my $url = $row[0];
push (@database_urls, $url);

    [download]

    That is, it's an array of strings, Perl is telling you that:

    my $host = $databases[$i][0];

    ... $databases[$i] contains a string, not an array reference. You're going to have to get the host and database some other way.

[reply]
[d/l]
[select]
      Ended up using a foreach loop and modified the subroutine a bit and the script as a whole. Looks to be working. Thank you so much for your help and that link looks very interesting. Looking forward to reading that. Thank you again! I might try that data dumper idea as well, not familiar with that but always looking for new ways to do a task.
[reply]
        I'm getting this error and I've tried for hours to get past it but having no luck
        When your program is small it is easy to debug with print, if your program becomes big you have to look for debuggers, see perldebtut and Devel::SDB, it is the time to debug your code yourself.
        see here http://s9.video.blip.tv/1340001748348/Kraman-DevelsdbSmartDebugger804.swf for a webcast
        Vivek
        -- In accordance with the prarabdha of each, the One whose function it is to ordain makes each to act. What will not happen will never happen, whatever effort one may put forth. And what will happen will not fail to happen, however much one may seek to prevent it. This is certain. The part of wisdom therefore is to stay quiet.
[reply]
Re: Can't use string ("blah") as an ARRAY ref while "strict refs" in use at..
by Anonymous Monk on Mar 27, 2009 at 05:17 UTC
[reply]
[d/l]
[select]
      Or even this ;) 
      use Data::Dumper;
die Data::Dumper->new([\@databases])->Indent(1)->Dump();

      [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom