Пример разработки на perl (обмен с MySQL)

#!/usr/bin/perl

# Демон отвечающий за общение с базой.
#
# Запуск осуществляется:
#
# crdsrvz.pl [-d] [-h <host>] [<ttyS>], где:
#
# -d стартовать как демон
# -t <host> имя хоста для формирования имени таблиц исключений
# -l выводить сообщения через syslogd
# <ttyS> устройство unix socket для коннекта к crdsrvz.pl.
#          по умолчанию ttyS1

require 'getopts.pl';

Getopts ('dlh:');

# Стартуем как демон, если указан ключик -d
if ($opt_d) {
    $pid = fork();
    die "can't fork: $!" unless defined $pid;
    exit 0 if ($pid);
}

# use strict;
use Socket;
use Time::HiRes qw( sleep usleep );
use POSIX qw(strftime);
use Mysql;

my $port = 'ttyS1';
my $maxlen = 40;
my $dbhost="mysql";
my $dbbase="security";
my $dbuser="user";
my $dbpass="pass";

# Programs vars
$port = $ARGV[0] unless ($#ARGV < 0);
my $cardsock = "/tmp/card.$port";

# Part 0: Redefine interupt
$SIG{INT} = \&correct_quit;
$SIG{HUP} = \&correct_quit;

# Part: Connect to database
$|=1;
my $shortport = substr ($port, 3);
if (defined $opt_h) {
    $id_host = $opt_h . $shortport . "\.";
} else {
    $id_host = "hq" . $shortport . "\.";
}

# Part I: Start UNIX connection
socket (SERVER, PF_UNIX, SOCK_STREAM, 0);
connect (SERVER, sockaddr_un ($cardsock))
or correct_quit ("Can't connect to $cardsock: $!");

# Part III: Starting dialog
ctimestr ("Connection established...\n");
for (;;) {
    sysread (SERVER, $answer, $maxlen) or correct_quit ("Can't received: $!\n");
    chomp $answer;
    (my $id, my $card) = split (" ", $answer);
    my $id_name='';
    my $id_room= $id_host . $id;
    # Получаем запрос от cardserver и пытаемся подконнектиться к базе
    local $dbh = Mysql->connect($dbhost, $dbbase, $dbuser, $dbpass) || correct_quit ("Can't connect: $DBI::errstr\n");
    local $sth = $dbh->query("SELECT room, crosstable, level FROM rooms where id_room=\'$id_room\'\;");
    ($room, $crosstable, $roomlevel) = $sth->fetchrow;
    my $action = "alarm"; my $name = "Грабитель";
    # Засекаем время
    $regtime = strftime "%Y%m%d%H%M%S", localtime();
    # Обновляем запись для комнаты, где сигнализируем о последнем доступе
    $sth = $dbh->query("UPDATE rooms SET touch=NOW() WHERE id_room=\"$id_room\"\;");
    # Извлекаем id_name и level из базы карточек
    $sth = $dbh->query("SELECT id_name, level FROM cards WHERE card=\"$card\"\;");
    #sleep (15);
    # Проверяем, есть ли такая карточка
    if ($sth->affectedrows > 0) {
        ($id_name, $level) = $sth->fetchrow;
        # Пытаемся отследить эту карточку, если она есть в базе
        # $action="spy" unless (defined ($level) or (id_name eq 2));
        $sth = $dbh->query("SELECT name FROM UBTC.persons WHERE id_name=\"$id_name\"\;");
        # Если никого не нашли по этому id_name, пропускаем этот блок
        if ($sth->affectedrows > 0) {
            ($name) = $sth->fetchrow;
            $action="spy";
            if (defined $roomlevel) {
                $action = ($level <= $roomlevel) ? "open" : "close";
            }
            $sth = $dbh->query("UPDATE UBTC.persons SET id_name=$id_name,alast=$regtime WHERE id_name=$id_name\;");
            # Проверяем таблицу исключений
            $sth = $dbh->query("SELECT permit FROM $crosstable WHERE id_name=$id_name\;");
            if ($sth->affectedrows > 0) { # Если есть записи - то предпринимаем соответствующие действия
                ($permit) = $sth->fetchrow;
                $action = ($permit eq "yes") ? "open" : "close";
            }
        }
    } else {
        # Если нет, автоматически заносим в базу.
        $sth = $dbh->query("INSERT INTO cards SET id_card=$regtime, card=\"$card\"\;");
    }
    # Протоколируем событие
    $sth = $dbh->query("INSERT INTO journal SET regtime=$regtime, card=\"$card\", id_room=\"$id_room\", action=\"$action\", id_name=\'$id_name\'\;");
    SWITCH: {
        if ($action eq "open") {
            $command = 1;
            last SWITCH;
        }
        if ($action eq "close") {
            $command = 2;
            last SWITCH;
        }
        if ($action eq "spy") {
            $command = 3;
            last SWITCH;
        }
        if ($action eq "alarm") {
            $command = 4;
            $action .= " ($card)";
            last SWITCH;
        }
    }
    ctimestr ("ROOM: $room NAME: $name ACTION: $action\n");                                            
    defined syswrite (SERVER, "$id $command\n", 4) or correct_quit ("Can't send data: $!\n");
    undef $sth;
    undef $dbh;
}

sub ctimestr {
    my @str = @_;
    $timestr = strftime "%Y.%m.%d %H:%M:%S", localtime();
    print "$timestr @str" unless ($opt_d);
}

sub correct_quit {
    $warnmessage = shift;
    # Part ...: Close UNIX socket
    syswrite (SERVER, "quit", 4);
    close (SERVER);
    ctimestr ($warnmessage) if (defined $warnmessage);
    if ($opt_l) {
      
    }
    exit;
}