1

Edit: (See Revised Code Near bottom) I have the code working to pull from the 2 databases (I know some cleaning is still needed), but where I am stuck is, I was prviously able to use:

next unless $currentuser ~~ @las;

but once I linked the mySQL database, it isn't filtering out undefined/unqualified (blank) results. I am not sure how to restructure this function to re-enable the functionality. (I think the way I am approaching the logic may be off). But this is where I am currently confused and need guidance.

I currently use this code to view logged in users to check for employees in our department:

 #! /usr/bin/perl
use strict;
use warnings;

$ENV{'ORACLE_HOME'} ="/usr/lib/oracle/11.2/client64";
use DBI;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

#current emplyees go here:
my @las = qw( 

user12
user13
user14
user15
user16
user17
user18
user19
user20
user21
user22
user23
user24
user25
user26
user27
user28
user29
user30
user31
user32
user33
user34
user35
user36
user37
user38
user39
user40
user41
user42
user43
user44
user45
user46
user47
user48
user49
user50
user51
user52
user53
user54
user55
user56
user57
user58
user59
user60
user61
user62
user63
user64
user65
user66
user67
user68
user69
user70
user71
user72
user73
user74
user75
user76
user77
user78
user79
user80
user81
user82
user83
user84
user85
user86
user87
user88
user89
user90
user91
user92
user93
user94
user95
user96
user97
user98
user99
user100
user101
user102
user103
user104
user105
user106
user107
user108
user109
user110
user111
user112
user113
user114
user115
user116
user117
user118
user119
user120
user121
user122
user123
user124
user125
user126
user127
user128
user129
user130
user131
user132
user133
user134
user135
user136
user137
user138
user139
user140
user141
user142
user143
user144
user145
user146
user147
user148
user149
user150
user151
user152
user153
user154
user155
user156
user157
user158
user159
user160
user161
user162
user163
user164
user165
user166
user167
user168
user169
user170
user171
user172
user173
user174
user175
user176
user177
user178
user179
user180
user181
user182
user183
user184
user185
user186
user187
user188
user189
user190
user191
user192
user193
user194
user195
user196
user197
user198
user199
user200
user201
user202
user203
user204
user205
user206
user207
user208
user209
user210
user211
user212
user213
user214
user215
user216
user217
user218
user219
user220
user221
user222
user223
user224
user225
user226
user227
user228
user229
user230
user231
user232
user233
user234
user235
user236
user237
user238
user239
user240
user241
user242
user243
user244
user245
user246
user247
user248
user249
user250
user251
user252
user253
user254
user255
user256
user257
user258
user259
user260
user261
user262
user263
user264
user265
user266
user267
user268
user269
user270
user271
user272
user273
user274
user275
user276
user277

systemdefault
admin1
admin2
admin3


);

#Find Current Users
$login="logg";
$password="pass32";
my $dbh = DBI->connect("DBI:Oracle:icsprod",$login,$password);
die "Unable to connect: $DBI::errstr\n" unless (defined $dbh);

# Search Zone 2

my $sql = qq{ 
SELECT  hosts.currentuser, TO_CHAR(hosts.lastlogin, 'HH:MM:SS MM/DD/YYYY'),
        hosts.host_name
FROM    infadmin.inv_hosts hosts
WHERE  (hosts.host_name = '1408bcc204ap1')
OR      (hosts.host_name = '1408mathg135p1')
OR      (hosts.host_name = '1408mathg135p2')
OR      (hosts.host_name = '1408mathg135p3')
OR      (hosts.host_name = '1408mathg135p4')
OR      (hosts.host_name = '1408mathg135m1')
OR      (hosts.host_name = '1408mathb10p1')
OR      (hosts.host_name = '1408mathb10p2')
OR      (hosts.host_name = '1408mathb10p3')
OR      (hosts.host_name = '1408mathb10p4')
OR      (hosts.host_name = '1408mathb10p5')
OR      (hosts.host_name = '1408mathb10p6')
OR      (hosts.host_name = '1408mathb10p7')
OR      (hosts.host_name = '1408mathb10p8')
OR      (hosts.host_name = '1408mathb10p9')
OR      (hosts.host_name = '1408mathb10p10')
OR      (hosts.host_name = '1408mathb10p10')
OR      (hosts.host_name = '1408mathb10p10')
OR      (hosts.host_name = '1408mathb10p10')



ORDER BY hosts.host_name
};
my $sth = $dbh->prepare($sql);
$sth->execute();
my($currentuser, $lastlogin, $host_name);
$sth->bind_columns(undef, \$currentuser, \$lastlogin, \$host_name);
print "Content-type: text/html\n\n";
print "<html>\n";
print "<meta http-equiv=refresh content=300>\n";
print "<meta http-equiv='pragma' content='no-cache'>\n";
print "<style type=\"text/css\">\n";
print "body { font-family: \"Arial\", sans-serif; font-size: small; color: black }\n";
print "</style>\n";
print "<head>\n";
print "<title>\n";
print "Staff Stations\n";
print "</title>\n";
print "</head>\n";
print "<body>\n";
print "<table>\n";
printf("%02d:%02d:%02d", $hour, $min, $sec);
print "<tr><td><u>Zone 2</u></td><td><u>Login</u></td></tr>\n";
while($sth->fetch()) {
        next unless $currentuser~~@las  ;
        $lastlogin=~s/ .*$//;
        $host_name=~s/1408//;
        foreach(@las)   {
                if ($currentuser eq "$_") {
                       $lacolor = "orange";
                        last;
                } else {
                        $lacolor = "black";
                }
        }
        print "<tr>";
        print "<td>$host_name</td>";
        print "<td><font color=\"$lacolor\">$currentuser</font></td><td>&nbsp;</td>";
}
$sth->finish();

print "</table>";
print "</body>\n";
print "</html>\n";

$sth->finish();$sth->finish();

#end code

$
b
->disconnect();

The usernames are already stored in a mysql database, I am trying to add lines to connect to it as follows, but I am stuck as to how to continue:

#Read Employee database


my $dbh = DBI->connect("DBI:mysql:myadmpr01", "user", "pass64");
die "Unable to connect: $DBI::errstr\n" unless (defined $dbh);

my $sql = qq{ 
SELECT  user_id, 
FROM    lsoemployee_info

};
my $sth = $dbh->prepare($sql);
$sth->execute();

I am trying to compare the icsprodagainst the myadmpr01 for usernames so that out hr department can maintain this easily as they update the myadmpr01 database for current/non-current employees. icsprod is updated continuously and simply defines the current user. We would also like to return the user's fullname, rather than continuously look up usernames. Any help is greatly appreciated.

Revised code: 

  #! /usr/bin/perl
$ENV{'ORACLE_HOME'} ="/usr/lib/oracle/11.2/client64";
use DBI;

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

my $dbh = DBI->connect("DBI:mysql:lsopskeys:myadmpr01.itap.purdue.edu", "lsops", "Fl4sh_l1ght")
  or die "Unable to connect: $DBI::errstr\n";

my $sql = qq{ 
  SELECT  user_id, 
  FROM    lsoemployee_data
};

my $sth = $dbh->prepare($sql);
$sth->execute();

my @las = map { $_->[0] } $sth->fetchall_arrayref;

$login="user";
$password="pass";
my $dbh = DBI->connect("DBI:Oracle:icsprod",$login,$password);
die "Unable to connect: $DBI::errstr\n" unless (defined $dbh);

# Zone 2 ROWS CODE
my $sql = qq{ 
SELECT  hosts.currentuser, TO_CHAR(hosts.lastlogin, 'HH:MM:SS MM/DD/YYYY'),
        hosts.host_name
FROM    infadmin.inv_hosts hosts
WHERE   (hosts.host_name = '1408stew102p1')
OR      (hosts.host_name = '1408stew102p2')
OR      (hosts.host_name = '1408stew102p3')

OR      (hosts.host_name = '1408stew111p1')
OR      (hosts.host_name = '1408stew111p2')
OR      (hosts.host_name = '1408stew111p3')
OR      (hosts.host_name = '1408stew111p4')
OR      (hosts.host_name = '1408stew111p5')
OR      (hosts.host_name = '1408stew111p6')
OR      (hosts.host_name = '1408stew111p7')
OR      (hosts.host_name = '1408stew111p8')
OR      (hosts.host_name = '1408stew111p9')
OR      (hosts.host_name = '1408stew111p10')
OR      (hosts.host_name = '1408stew111p11')
OR      (hosts.host_name = '1408mathg135p1')
OR      (hosts.host_name = '1408mathb18p5')
OR      (hosts.host_name = '1408mathg135p2')
OR      (hosts.host_name = '1408mathg135p3')
OR      (hosts.host_name = '1408mathg135p4')

OR      (hosts.host_name = '1408heav227m1')
OR      (hosts.host_name = '1408heav227m2')
OR      (hosts.host_name = '1408heav227m3')
OR      (hosts.host_name = '1408mthw116p1')
OR      (hosts.host_name = '1408hamp3144p21')

ORDER BY hosts.host_name
};

my $sth = $dbh->prepare($sql);
$sth->execute();
my($currentuser, $lastlogin, $host_name);
$sth->bind_columns(undef, \$currentuser, \$lastlogin, \$host_name);
print "Content-type: text/html\n\n";
print "<html>\n";
print "<meta http-equiv=refresh content=300>\n";
print "<meta http-equiv='pragma' content='no-cache'>\n";
print "<style type=\"text/css\">\n";
print "body { font-family: \"Arial\", sans-serif; font-size: small; color: black }\n";
print "</style>\n";
print "<head>\n";
print "<title>\n";
print "LA station usage.\n";
print "</title>\n";
print "</head>\n";
print "<body>\n";
print "<table>\n";
printf("%02d:%02d:%02d", $hour, $min, $sec);
print "<tr><td><font color=\"DodgerBlue \"><u>Zone 2 Station</u></td><td><font color=\"DodgerBlue \"><u>Login</u></td></tr>\n";
while($sth->fetch()) {
      #next unless $currentuser ~~ @las;
       $lastlogin=~s/ .*$//;
        $host_name=~s/1408//;
        foreach(@las)   {
                if ($currentuser eq "$_") {
                       $lacolor = "orange";
                        last;
                } else {
                        $lacolor = "black";
                }
        }
        print "<tr>";
        print "<td>$host_name</td>";
        print "<td><font color=\"$lacolor\">$currentuser</font></td><td>&nbsp;</td>";
}
$sth->finish();
print "</table>";
print "</body>\n";
print "</html>\n";
$sth->finish();$sth->finish();

#end code
$
b
->disconnect();
Improve this question
4
  • 1
    Please always use use strict; as well as use warnings;. Commented Apr 2, 2017 at 21:53
  • What is the best way to validate perl code? Commented Apr 2, 2017 at 22:18
  • perl -c script.pl will verify that it can be compiled. Having the pragmas I mentioned in the previous comment is the best way to ensure things are legit while coding. Commented Apr 2, 2017 at 22:34
  • I see you've corrected $las to @las in the map line, but you missed the use of $las in the print() on the following line. And why is $b->disconnect() spread over three lines? Commented Apr 8, 2017 at 6:31

2 Answers 2

Reset to default
2

Your SQL query is a union of two subqueries, but one subquery has one column in its result and the other has two columns. This is not allowed in a UNION. All subqueries must have the same number of columns, and compatible data types in all columns. This has nothing to do with Perl, it's just a requirement of the SQL language.

In Perl, you should have called the query in a way that allowed you to see the SQL error it caused.

$sth->execute();
if ($sth->err)
{
  die "ERROR! return code: . $sth->err . " error msg: " . $sth->errstr . "\n";
}

DBI also has connection options to make any SQL error cause the calling script to die, or print the error. See http://www.perlhowto.com/dbi_handling_database_errors

my $dbh = DBI->connect($dsn, $user, $pw, { RaiseError => 1, PrintError => 0 });
Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

ok, sorry. I fixed it to just focus on getting the username for right now.
1

If you're trying to populate @las from the database, then you want something like this:

my $dbh = DBI->connect('DBI:mysql:myadmpr01', 'user', 'pass64')
  or die "Unable to connect: $DBI::errstr\n";

my $sql = qq{ 
  SELECT  user_id, 
  FROM    lsoemployee_info
};

my $sth = $dbh->prepare($sql);
$sth->execute();

my @las = map { $_->[0] } $sth->fetchall_arrayref;

Update: I wrote that last line of code as I would write it for a client. I always assume that my code will be read and maintained by people who know Perl. If you have doubts about the abilities of your programmers, you might be better advised to write something like that:

my @las;

foreach ($sth->fetchall_arrayref) {
  push @las, $_->[0];
}
Improve this answer

16 Comments

I'm having trouble understanding how to implement this with the existing code. Also wouldn't it be ("DBI:mysql:myadmpr01", "user", "pass64")?
I just took your code and added a single line after it. I'm not sure what part is confusing you. Also, I changed the double quotes to single quotes as you only need double quotes for variable interpolation and escape sequences like \n or \t.
gotcha, i'm giving it a go, looks like I was combining 2 different sections. I may have to ask the people maintaining the database if the names for SELECT are right
Here is the documentation for map. map is a mechanism for transforming lists. You pass it a block of code (in this case { $_->[0] }) and a list (in this case the return value from $sth->fetchall_arrayref). Each element of the list, in turn, is assigned to $_ and the block of code is executed. Whatever the the block of code returns is added to the transformed list. The $_->[0] is looking up the first element in an array reference that's held in $_. Nothing about that code indicates that we are dealing with numbers.
You ended up needing to do... nothing? It's not your database that is returning references. Your database knows nothing at all about references. It was DBI or DBD::mysql that was creating references (because that's the only way to create complex data structures in Perl).
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.