РЕШЕНО: Perl скрипт (Какие необходимы пакеты ???)

leksstav · Сообщение **leksstav** » 07.08.2015 08:59

Есть некий Perl скрипт который лезет в базу mysql и выводит статистику в веб морду.
Как узнать какие пакеты необходимы для его корректной работы ???

Код:

#!/usr/bin/perl
## # CollapsedSubs: btn_OK

use DBI;
use CGI;

#use CGI::Carp qw(fatalsToBrowser);
print "Content-type: text/html;charset=WINDOWS-1251\n\n";
print qq'
<HTML>
<HEAD>
<TITLE> ТРАФИК </TITLE>
</HEAD>
<BODY>
<center> ТРАФИК</center><BR>';

#print $CGI->header();
$CGI = new CGI();
$q = new CGI();
($sec,$min,$hour,$mday,$mon,$year,$wady,$yday,$isdst) = localtime(time);
$mon += 1;
$year += 1900;
my $even_string_color = "FFFFE1";
my $odd_string_color = "FFFFFF";

@FIELDS_NAME = ("ip", "input","output");
@FIELDS_DESCRIPTIONS = ("Адрес","Входящий, Мб","Исходящий, Мб");
$TABLE="traffic";
print "<CENTER>" . getDate("all") . "</CENTER>" . "<BR>";
print "<HR>";

my ($name, @command);
foreach $name ($CGI->param){
@value = split /:/,$name;
print "После: @value[0]";
}


if (@value[0] eq "submit_do_maintenance"){
    displayMaintenanceChoises();
    }
elsif (@value[0] eq "submit_query_form"){
    displayQueryForm($CGI);
    }
elsif (@value[0] eq "submit_query"){
    displayQueryResults($CGI,"query_day");
    }
elsif (@value[0] eq "submit_login_form"){
    displayLoginForm($CGI);
    }
elsif (@value[0] eq "submit_admin_form"){
    displayAdminForm($CGI);
    }
elsif (@value[0] eq "submit_newuser_form"){
    displayUserForm($CGI);
    }
elsif (@value[0] eq "submit_adduser_query"){
    AddUser($CGI);
    }
elsif (@value[0] eq "delete"){
     DoUser(@value[0],@value[1]);
    }
elsif (@value[0] eq "edit"){
     DoUser(@value[0],@value[1]);
     }
else {
    displayMain($CGI);
    }

#************************************************
sub displayMain {
my $cgi = shift;

#my $db = ConnectBase();
displayQueryResults($CGI,"current_day");
print "<TD colspan='3'>";
print "<hr>";
print "</TD>";

sumMonth();

hr();
print qq'
<FORM METHOD=POST>
<P>
<INPUT TYPE="submit" name="submit_query_form:" value="Поиск">
<INPUT TYPE="submit" name="submit_login_form:" value="Пользователи">
</FORM>
</BODY></HTML>
';
#CloseConnect($db);
}
#**************************** sub displayMain
sub displayLoginForm{
print qq'
<FORM METHOD=POST>
    <TABLE WIDTH="120" border="0" height="77" ALIGN="center"
        <TR>
           <TD WIDTH="78" height="29"><FONT face="Verdana, Arial" size="2">Логин:</FONT></TD>
            <TD WIDTH="114" height="29"><FONT face="Verdana, Arial" size="2"><input type="text" name="loginfield" value=""size="20"></FONT></TD>
        </TR>
        <TR>
            <TD WIDTH="78" height="29"><FONT face="Verdana, Arial" size="2">Пароль:</FONT></TD>
            <TD WIDTH="114" height="29"><FONT face="Verdana, Arial" size="2"><input type="password" name="pswfield" value=""size="20"></FONT></TD>
        </TR>
        <TR>
            <TD colspan="2" height="40">
                <DIV align="center">
                <INPUT TYPE="submit" name="submit_admin_form:" value="OK">
                </DIV>
            </TD>
        </TR>
    </TABLE>
</FORM>
<BR>
';
hr();
#print "<A align='center' href=\'java script:history.back(1);\'>Вернуться >></A>";
print qq'</BODY></HTML>';
}

sub GetIPUser{
my $IP_USER = $ENV{REMOTE_ADDR};
return IP_USER;

}
sub displayAdminForm{
#my $db = ConnectBase("loginform");
my $db = ConnectBase();
if ($db){
DisplayMessage("Добро пожаловать в базу пользователей");
displayQueryResults($CGI,"user");
print qq'
<BR>
<FORM METHOD=POST>
    <INPUT TYPE="submit" name="submit_newuser_form:" value="Добавить">
    <INPUT TYPE="submit" name="submit_main:" value="Главная страница">
</FORM>
';

hr();
print "</BODY></HTML>";
CloseConnect($db);
}
}

sub ConnectBase{
my $login = shift;
my $db_connection;
    if ($login eq "loginform"){
         $db_connection = DBI->connect('DBI:mysql:netacct:localhost',$CGI->param('loginfield'),$CGI->param('pswfield'))
         or die  displayErrorForm("Невозможно соединиться с базой, проверьте имя или пароль!", $DBI::errstr,"submit_admin_form");
         }
    else{
         $db_connection = DBI->connect('DBI:mysql:netacct:localhost','acct','acct_password')
         or die  displayErrorForm("Невозможно соединиться с базой, проверьте имя или пароль!", $DBI::errstr,"submit_admin_form");
         }
return $db_connection;
}
sub CloseConnect{
my $db_connection = shift;
$db_connection->disconnect;
}

sub displayUserForm{
my $action = shift;

my ($username, $ip_value, $tarif, $status_checkbox);
if ($action eq "edit"){
   my $id = shift;
   my $db = ConnectBase();

   CloseConnect($db);
}
else{
$username          = "Неизвестный";
$ip_value          = "192.168.0.0";
$tarif             = "0";
$status_checkbox   = "checkbox";
}
print qq'
<form name="form" method="post" >
  <table  border="0" align="center">
    <tr>
      <td width="128" valign="middle" align="left"><font face="Verdana, Arial, Helvetica, sans-serif">Пользователь:</font></td>
      <td width="182" valign="middle" align="left">
        <div align="left">
          <input type="text" name="username" value=$username>
        </div>
      </td>
    </tr>
    <tr>
      <td width="128" valign="middle" align="left"><font face="Verdana, Arial, Helvetica, sans-serif">IP
        адрес:</font></td>
      <td width="182" valign="middle">
        <input type="text" name="ip_value" value=$ip_value>
      </td>
    </tr>
    <tr>
      <td width="128" valign="middle" align="left"><font face="Verdana, Arial, Helvetica, sans-serif">Тариф:</font></td>
      <td width="182" valign="middle" align="left">
        <div align="left">
          <input type="text" name="tarif" value=$tarif>
        </div>
      </td>
    </tr>
    <tr>
      <td width="128" valign="middle" align="left"><font face="Verdana, Arial, Helvetica, sans-serif">Состояние:</font></td>
      <td width="182" valign="middle">
        <div align="left">
          <input type="checkbox" name="status_checkbox" value=$status_checkbox>
          Отключен </div>
      </td>
    </tr>
    <tr align="center">
      <td colspan="2" valign="middle"> <br>
        <div align="center">
<input type="submit" name="submit_adduser_query" value="Записать">
        </div>
      </td>
    </tr>
  </table>
</form>
</BODY></HTML>
';
}


sub AddUser{

my $db = ConnectBase();
my $status;
if ($CGI->param('status_checkbox') eq "checkbox"){
    $status = "N";
}
else{
    $status = "Y";
}
#('name_user', 'ip', 'tarif', 'status')
$username = "'" . $CGI->param('username') . "'";
$ip_value = "'" . $CGI->param('ip_value') . "'";
$tarif = $CGI->param('tarif');
$status = "'" . $status . "'";
my $sql = qq'INSERT INTO users  VALUES (NULL, $username, $ip_value, $tarif, $status)';
#print "SQL: ".$sql;
my $sth = $db->prepare($sql)
or die displayErrorForm("Cannot prepare! ", $DBI::errstr);
$sth->execute() or die displayErrorForm("Error execute! ", $DBI::errstr);
$sth->finish();
CloseConnect($db);
DisplayMessage("Запись добавлена!");
btn_OK("submit_admin_form:");

}

sub DoUser{
my $do_user = shift;
my $id_user = shift;
my $sql;
    if ($do_user eq "delete"){
        my $db = ConnectBase();
        $sql = qq'DELETE from users where id=$id_user';
        my $sth = $db->prepare($sql)
        or die displayErrorForm("Cannot prepare! ", $DBI::errstr);
        $sth->execute() or die displayErrorForm("Error execute! ", $DBI::errstr);
        $sth->finish();
        CloseConnect($db);
        DisplayMessage("Запись удалена!");
        btn_OK("submit_admin_form:");
    }
    elsif ($do_user eq "edit"){

    }
#my ($command, $id) = split()
}

sub displayErrorForm{

my $er_message = shift;
my $er_db = shift;
my $btn_name = shift;
DisplayMessage($er_message,"error");
DisplayMessage($er_db,"error");
print "<Meta http-equiv=\"refresh\" content=\"2\"; href=\'java script:history.back();\'>";

}

sub displayQueryForm {
my $cgi = shift;

print qq'
<FORM METHOD=POST>
    <TABLE>
        <TR>
            <TD width="10">С</TD>
            <TD width="40"><INPUT TYPE="text" NAME="StartDate" VALUE="';
print $year. "-" . getDate("month") . "-" . "01";
print qq' "></TD>';
print qq'
            <TD width="10">По</TD>
            <TD width="40"><INPUT TYPE="text" NAME="EndDate" VALUE="';
print $year . "-" . getDate("month") . "-" . getDate("day");
print qq'  "></TD>';
print qq'
        </TR>
    </TABLE>
<BR>
<TD colspan="3">
<hr>
</TD>
<P>
<INPUT TYPE="submit" name="submit_query:" value="Выполнить">
<INPUT TYPE="submit" name="submit_main:" value="Главная страница">
</FORM>
';
#<INPUT TYPE="radio" NAME="IP" VALUE="all_ip" CHECKED>Все адреса<BR>
#print "<INPUT TYPE="radio" NAME="IP" VALUE="ip">Выбрать адрес<BR>

}

sub getQueryResults{

my $cgi = shift;
my $modeQuery = shift;

my @query_results;
my $db = ConnectBase();
my $sql;

if ($modeQuery eq "user"){
     my $id = shift;
     if ($id){
          $sql = qq'SELECT name_user, trafic FROM  users where id=$id';
     }
     else{
          $sql = qq'SELECT id, name_user, ip FROM users order by name_user';
     }
}
else{
     $sql = qq'SELECT ip, sum(input)/1024/1024 as INPUT, sum(output)/1024/1024 as OUTPUT FROM $TABLE';
my $where_clause;
$where_clause = " INPUT>0 AND";
$where_clause = $where_clause . " DATE_FORMAT(time, '%Y-%m-%d') BETWEEN '";

       if ($modeQuery eq "current_day"){
            $where_clause = $where_clause . $year . "-" . getDate("month")
            . "-" . getDate("day")
            . "' AND '" . $year . "-" . getDate("month")
            . "-" . getDate("day") . "'";
       }
       elsif($modeQuery eq "query_day"){
              $where_clause = $where_clause . $cgi->param('StartDate')
              . "' AND '" . $cgi->param('EndDate') . "'";
       }
       $sql = $sql . " where " . $where_clause;
       #$sql = $sql . " group by ip order by INPUT,ip IS NOT NULL";
	$sql = $sql . " group by ip order by INPUT,ip";
}

my $sth = $db->prepare($sql)
    or die "Cannnot prepare: " . $db->errstr();

$sth->execute() or die "Cannot execute: " . $sth->errstr();
my @row;

while (@row = $sth->fetchrow_array())
        {
        my @record = @row;
        push(@query_results, \@record);
        }
$sth->finish();
CloseConnect($db);
return \@query_results;
}

sub displayQueryResults{
my $cgi = shift;
my $mode = shift;
my $ra_query_results;
my $message;
my $i = 1;
$ra_query_results = getQueryResults($cgi,$mode);

if (@$ra_query_results){
      my $row;
      if ($mode eq "user"){
           $message = "";
      }
      else{
      $message = "Результаты запроса ";
           if ($mode eq "current_day"){
                $message = $message . "текущего дня";
           }
           elsif ($mode eq "query_day"){
                $message = $message . "с " .$cgi->param('StartDate')
                . " по " . $cgi->param('EndDate') ;
           }
      }


DisplayMessage($message);
if ($mode ne "user"){
     print qq'
     <br>
     <TABLE align="center" bordercolor="FFFFFF">
            <TR bgcolor="FFFFA4" bordercolor="000000">
                <TD width="160">
                    <div align="center"><font size="2"><B><font face="Verdana">Имя/Адрес</font></B></div>
                </TD>
                <TD width="100">
                    <div align="center"><font size="2"><B><font face="Verdana">Входящий, Мб</font></B></div>
                </TD>
                <TD width="100">
                    <div align="center"><font size="2"><B><font face="Verdana">Исходящий, Мб</font></B></div>
                </TD>
            </TR>';

     my $sumIN = 0;
     my $sumOUT = 0;;
     my $name_user;

     foreach $row (@$ra_query_results){
              print "<TR>";
    #print join("\n", map("<TD width='120' align='right'>" . $_ . "</TD>", @$row));
           if (@$row[0] eq "192.168.0.1"){
                $name_user = "Богданов Виктор";
           }
           elsif (@$row[0] eq "192.168.0.2"){
                $name_user = "Павлов Виктор";
           }
           elsif (@$row[0] eq "192.168.0.6"){
                $name_user = "Сабельников Евгений";
           }
           elsif (@$row[0] eq "192.168.0.10"){
                $name_user = "Потапов Анатолий";
           }
           elsif (@$row[0] eq "192.168.0.11"){
                $name_user = "Козак Ольга";
           }
           elsif (@$row[0] eq "192.168.0.12"){
                $name_user = "Дудченко Михаил";
           }
           else{
                $name_user = @$row[0];
           }
           $bg_color = StringColor($i);

    print "<TD width='160' align='left' bgcolor=$bg_color>".$name_user."</TD>\n";
    print "<TD width='100' align='right' bgcolor=$bg_color>".@$row[1]."</TD>\n";
    print "<TD width='100' align='right' bgcolor=$bg_color>".@$row[2]."</TD>";
    $sumIN += @$row[1];
    $sumOUT += @$row[2];
    #print join("\n", map("<TD>" . $_ . "</TD>", @$row));
    print "</TR>\n";
    $i++;
    }

    hr();
    print qq '
    <TR>
        <TD width="160">
            <div align="right"><font size="2"><B><font face="Verdana">Всего:</font></B></div>
        </TD>
        <TD width="100">
            <div align="right"><font size="2"><B><font face="Verdana">$sumIN</font></B></div>
        </TD>
        <TD width="100">
            <div align="right"><font size="2"><B><font face="Verdana">$sumOUT</font></B></div>
        </TD>
        </TR>
    </TABLE>';
}
else{
# $mode="user"
        print qq '
              <br><FORM METHOD="POST">
              <TABLE align="center" bordercolor="FFFFFF" border="0">';
              foreach $row (@$ra_query_results){
                       print "<TR>";
                       $bg_color = StringColor($i-1);
                       print "<TD width='300' align='left' bgcolor=$bg_color><font size='2'><font face='Verdana'>".
                       @$row[1]." (".@$row[2].")</font></TD>\n";
                       print "<TD width='210' align='right' bgcolor=$bg_color>";
                       print "<INPUT TYPE='submit' NAME='edit:".@$row[0]. "' VALUE='Редактировать'>";
                       print "<INPUT TYPE='submit' NAME='delete:".@$row[0]."' VALUE= 'Удалить'>";
                       print "</TD>";
                       print "</TR>\n";
                       $i++;

              }
              print qq '</FORM></TABLE>';

    }
if ($mode ne "user"){
    hr();
    btn_OK("submit_query_form:");
    }
}
else{
     if ($mode eq "user"){
          $message= "Пользователей не найдено";
     }
     elsif ($mode eq "current_day"){
          $message = "Трафик текущего дня отсутствует";
     }
     elsif ($mode eq "query_day"){
           $message= "По данному запросу ничего не найдено";

     }DisplayMessage($message);
     hr();
     btn_OK("submit_query_form:");
}

}

sub StringColor{
my $strcolor;
my $countstr = shift;

if ($countstr%2==0){ #четная строка
     $strcolor = $even_string_color;
}
else{ #нечетная строка
      $strcolor = $odd_string_color;
}
return $strcolor;
}

sub sumMonth()
{
my $db = ConnectBase();
my $sql = "select sum(input)/1024/1024 as INPUT, sum(output)/1024/1024 as OUTPUT from traffic";
$sql = $sql . "\n";
$sql = $sql . "where DATE_FORMAT(time, '%Y-%m')='". $year ."-" . getDate("month")."'";
print "<font size='2'><font face='Verdana'>Трафик текущего месяца: входящий: </font>";
#print $sql;
my $sth = $db->prepare($sql)
    or die "Cannot excecute prepare: " . $db->errstr();
$sth->execute() or die "Error: " . $sth->errstr();

while (@row = $sth->fetchrow_array())
    {
    print join("<font size='2'><font face='Verdana'><B> Mb</B>, исходящий: </font> ", map("<font size='2'><B><font face='Verdana'>" . $_ . "</font></B>", @row))
     . "<font size='2'><B><font face='Verdana'> Mb</B></font>";
    }

$sth->finish();
CloseConnect($db);
}

sub getDate()
{
my $what = shift;
my $strdate;
#print "\nPeredali: " . $what . "\n";

if ($what eq "day"){
    $strdate = getDayORmonth($mday);
    #print "strdate: ".$strdate;
    }
if($what eq "month")
    {
    $strdate = getDayORmonth($mon);
    #print "not DAy";
    }
if($what eq "all")
    {
    $strdate = localtime;
    }

return $strdate;
}


sub getDayORmonth()
{
my $dayORmonth = shift;
my $strday;
if ($dayORmonth<10){
    $strday = "0".$dayORmonth;
    }
else
    {
    $strday = "".$dayORmonth;
    }
return $strday;
}


sub hr()
{
print qq'
<TR>
 <TD colspan="3">
 <hr>
</TD>';
}

sub DisplayMessage()
{
my $message = shift;
my $status_message = shift;
my $color_message;
if ($status_message eq "error")
    {
    $color_message = "red";
    }
else
    {
    $color_message = "blue";
    }

print "<div align='center'><font face='Verdana' color=".$color_message.">";
print $message;
print "</font></div>";
}
sub btn_OK{
my $_sub_ = shift;
        print qq'
        <FORM METHOD=POST>
        <div align="center">
        <INPUT TYPE="submit" name=$_sub_ value="OK">
        </div>
        </FORM>

        </BODY></HTML>';
}

Вот что в логах

[Fri Aug 07 09:51:29.358423 2015] [cgi:error] [pid 1327] [client 192.168.80.25:49660] AH01215: install_driver(mysql) failed: Can't locate DBD/mysql.pm in @INC (you may need to install the DBD::mysql module) (@INC contains: /usr/lib/perl5/site_perl/5.20.1/i586-linux-thread-multi /usr/lib/perl5/site_perl/5.20.1 /usr/lib/perl5/vendor_perl/5.20.1/i586-linux-thread-multi /usr/lib/perl5/vendor_perl/5.20.1 /usr/lib/perl5/5.20.1/i586-linux-thread-multi /usr/lib/perl5/5.20.1 /usr/lib/perl5/site_perl .) at (eval 7) line 3.
[Fri Aug 07 09:51:29.358530 2015] [cgi:error] [pid 1327] [client 192.168.80.25:49660] AH01215: Perhaps the DBD::mysql perl module hasn't been fully installed,
[Fri Aug 07 09:51:29.358568 2015] [cgi:error] [pid 1327] [client 192.168.80.25:49660] AH01215: or perhaps the capitalisation of 'mysql' isn't right.
[Fri Aug 07 09:51:29.358630 2015] [cgi:error] [pid 1327] [client 192.168.80.25:49660] AH01215: Available drivers: CSV, DBM, ExampleP, File, Gofer, ODBC, Pg, Proxy, SQLite, Sponge, XBase.
[Fri Aug 07 09:51:29.358658 2015] [cgi:error] [pid 1327] [client 192.168.80.25:49660] AH01215: at /srv/www/cgi-bin/trafic line 155.

s.xbatob · Сообщение **s.xbatob** » 07.08.2015 09:54

Написано же:

Код: Выделить всё

use DBI;
use CGI;

А в каких системных пакетах находятся эти пакеты perl - ищите сами, раз вы не указали дистрибутив!

leksstav · Сообщение **leksstav** » 07.08.2015 10:15

s.xbatob писал(а): ↑
07.08.2015 09:54
Написано же:
Код: Выделить всё
use DBI;
use CGI;
А в каких системных пакетах находятся эти пакеты perl - ищите сами, раз вы не указали дистрибутив!

Да нет, это все стоит...
Щас вот знакомый подсказал perl-dbd-mysql он и в логах виден.
Щас буду ставить.

leksstav · Сообщение **leksstav** » 07.08.2015 16:18

s.xbatob писал(а): ↑
07.08.2015 09:54
Написано же:
Код: Выделить всё
use DBI;
use CGI;
А в каких системных пакетах находятся эти пакеты perl - ищите сами, раз вы не указали дистрибутив!

В общем не хватало perl-dbd-mysql

Качнул от сюда
http://www.cpan.org/modules/by-module/DBD/...ql-4.022.tar.gz

Ну и как говориться классика

perl Makefile.PL
make
make install

unixforum.org

РЕШЕНО: Perl скрипт (Какие необходимы пакеты ???)

РЕШЕНО: Perl скрипт

Re: РЕШЕНО: Perl скрипт

Re: РЕШЕНО: Perl скрипт

Re: РЕШЕНО: Perl скрипт