Префиксы в ISPManager 5 Lite

Код:

cat /usr/local/mgr5/etc/xml/ispmgr_mod_add.prefix.xml 
<?xml version="1.0" encoding="UTF-8"?>
<mgrdata>
        <handler name="add.prefix.pl" type="xml">
                <event name="check.username" after="yes" />
                <event name="check.dbname" after="yes" />
        </handler>
</mgrdata>

Код:

cat /usr/local/mgr5/addon/add.prefix.pl 
#!/usr/bin/perl -w
#

# надо отловить db.restore, before

use Data::Dumper;
use XML::LibXML;
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
$owner = $ENV{'AUTH_USER'};
$value = $ENV{'PARAM_value'};
#-------------------------------------------------------------------------------
open (LOGFILE, ">>/tmp/add.prefix.pl.txt");
#-------------------------------------------------------------------------------
my $d = XML::LibXML->new->parse_string(join "", <STDIN>);
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
if($owner eq "root" || $ENV{'AUTH_LEVEL'} eq "30"){
        #-------------------------------------------------------------------------------
        print $d->toString;
        #-------------------------------------------------------------------------------
        exit;
        #-------------------------------------------------------------------------------
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
#print LOGFILE "\n";
#print LOGFILE " ====> started at " . print_date(time()) . " in " . print_hour(time()) . ":" . print_min(time()) . ":" . print_sec(time()) . "\n";
#print LOGFILE $d->toString . "\n";
#print LOGFILE "========================================\n";
#-------------------------------------------------------------------------------
# проверяем шаблон
$pattern = '^' . $owner . '_[A-Za-z0-9\-\w]+$';
#-------------------------------------------------------------------------------
#print LOGFILE "value = $value; pattern = $pattern\n";
#-------------------------------------------------------------------------------
#if($value =~ /$pattern/ || ($ENV{'AUTH_IP'} eq 'usermove' && substr($value,0,index($value,'_')) eq 'tmp')){
if($value =~ /$pattern/ || substr($value,0,index($value,'_')) eq 'tmp'){
        # всё хорошо, префикс уже есть
}else{
        #-------------------------------------------------------------------------------
        # проверяем, если используется AUTH_IP=usermove, то надо проверить наличие
        # подчёркивания, и отсечь часть после первого - это и будет 'value'
        if($ENV{'AUTH_IP'} eq 'usermove'){
                #-------------------------------------------------------------------------------
                if(index($value,'_') > 0){
                        $value = substr($value, index($value,'_') + 1, 16);
                }
        }
        #-------------------------------------------------------------------------------
        $value = $owner . "_" . $value;
        #-------------------------------------------------------------------------------
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# обгрызаем полученное на 16 символах
#$value = substr($value, 0, 16);
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# находим ноду doc
for my $doc ($d->findnodes('//doc')){
        #-------------------------------------------------------------------------------
        # удаляем ноду со значением
        for my $dead ($doc->findnodes('//value')){
                #-------------------------------------------------------------------------------
                $dead->unbindNode;
                #-------------------------------------------------------------------------------
        }
        #-------------------------------------------------------------------------------
        #-------------------------------------------------------------------------------
        $new = XML::LibXML::Element->new($ENV{'PARAM_name'});
        $new->appendTextNode($value);
        $doc->addChild($new);
        #-------------------------------------------------------------------------------
        $new = XML::LibXML::Element->new('value');
        $new->appendTextNode($value);
        $doc->addChild($new);
        #-------------------------------------------------------------------------------
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
#print LOGFILE $d->toString . "\n";
#print LOGFILE "========================================\n";
#print LOGFILE "========================================\n\n\n";
#-------------------------------------------------------------------------------
print $d->toString ;
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------



# functions
sub trim {
        my($string)=@_;
        return $string unless $string;
        for ($string) {
                s/^\s+//;
                s/\s+$//;
        }
        return $string;
}

sub print_date {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return (1900 + $year) . "-" . sprintf("%02u", ++$mon) . "-" . sprintf("%02u", $mday);
}

sub print_year {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return (1900 + $year);
}

sub print_month {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", ++$mon);
}

sub print_day {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", $mday);
}

sub print_hour {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", $hour);
}

sub print_min {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", $min);
}

sub print_sec {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", $sec);
}


exit;