Изменить: (См. Пересмотренный код в нижней части) У меня есть код, работающий для извлечения из 2 баз данных (я знаю, что некоторая очистка все еще необходима), но где я застрял, я был в состоянии использовать:

next unless $currentuser ~~ @las;

Но как только я связал базу данных mySQL, она не отфильтровывает неопределенные / неквалифицированные (пустые) результаты. Я не уверен, как реструктурировать эту функцию, чтобы снова включить функциональность. (Я думаю, что подход к логике может быть отключен). Но это то, где я сейчас растерялся и нуждаюсь в руководстве.


В настоящее время я использую этот код для просмотра зарегистрированных пользователей и проверки сотрудников нашего отдела:

 #! /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();

Имена пользователей уже хранятся в базе данных mysql, я пытаюсь добавить строки для подключения к нему следующим образом, но я застрял в том, как продолжить:

#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();

Я пытаюсь сравнить icsprod с myadmpr01 для имен пользователей, чтобы наш отдел мог легко это поддерживать, когда они обновляют базу данных myadmpr01 для текущих / не текущих сотрудников. icsprod постоянно обновляется и просто определяет текущего пользователя. Мы также хотели бы вернуть полное имя пользователя, а не постоянно искать имена пользователей. Любая помощь очень ценится.

Пересмотренный код:

  #! /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();
1
Jozef Pietrzak 3 Апр 2017 в 00:48

2 ответа

Лучший ответ

Если вы пытаетесь заполнить @las из базы данных, то вы хотите что-то вроде этого:

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;

Обновление . Я написал эту последнюю строку кода так, как написал бы для клиента. Я всегда предполагаю, что мой код будет читаться и поддерживаться людьми, которые знают Perl. Если у вас есть сомнения относительно способностей ваших программистов, вам лучше написать что-то вроде этого:

my @las;

foreach ($sth->fetchall_arrayref) {
  push @las, $_->[0];
}
1
Dave Cross 11 Апр 2017 в 07:31

Ваш SQL-запрос представляет собой объединение двух подзапросов, но один подзапрос имеет один столбец в своем результате, а другой - два столбца. Это не разрешено в СОЮЗЕ. Все подзапросы должны иметь одинаковое количество столбцов и совместимые типы данных во всех столбцах. Это не имеет ничего общего с Perl, это просто требование языка SQL.

В Perl вы должны были вызвать запрос так, чтобы вы могли увидеть ошибку SQL, которую он вызвал.

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

DBI также имеет параметры подключения, чтобы любая ошибка SQL приводила к смерти вызывающего скрипта или выводу ошибки. См. http://www.perlhowto.com/dbi_handling_database_errors

my $dbh = DBI->connect($dsn, $user, $pw, { RaiseError => 1, PrintError => 0 });
2
Bill Karwin 2 Апр 2017 в 22:26