PerlForms Code

#
# Copyright 2008 Samuel Borsutzky
#
# This file is part of PerlForms.
#
# PerlForms is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# PerlForms is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with PerlForms.  If not, see <http://www.gnu.org/licenses/>.
#
#
#

package PerlForms::Query;

#
# Guidelines:
#  - Jedes Query-sub für einen einzelnen Datensatz (also ohne Endung "_list")
#    muss den Parameter "id" berücksichtigen. Das ist ein Standard-Parameter,
#    der von z.B. Form->new angegeben wird.
#  - Jede Query muss mindestens die Felder 
#        id,
#        $obj->idattrib,
#        name,
#        $obj->what
#    ausgeben.
#
#

use strict;
use base qw(PerlForms);
use Time::Local;
use vars qw($debug); ## hierdurch wird $debug global accessible, 
                     ## aber immer noch im namespace 'PerlForms::Query' 
$debug=0 unless defined $debug;
use constant DEBUGGING => q(
    $debug_sub=sprintf('%d',($debug%($debug_bitval*2))/$debug_bitval);
    if($debug_sub) {
        print(STDERR __PACKAGE__."->".$subname." (".ref($self)."->".$subname.") got called by ".caller()."\n");
        print(STDERR __PACKAGE__."->".$subname.": (Pls ignore the immidially following 'Use of uninitialized value in join or string' lines)\n");
        print(STDERR __PACKAGE__."->".$subname." got called with ".join(",",%arg)."\n");
        print(STDERR __PACKAGE__."->".$subname." ".$subname."ing a ".$self->{obj}->what."\n");
    }
);


## i: wird nur noch von class und way genutzt. Alle anderen Query-subs sollten
##    nicht direkt aufgerufen werden.
sub guess {
    # expects: req obj|what list?
    my$self=shift;
    my(%arg)=@_;
    my$debug_bitval=1;
    my$debug_sub;
    my$subname="guess";
    eval DEBUGGING;
#    $debug && print(STDERR 
#        __PACKAGE__."->guess got called by ".caller()." with ".join(",",%arg)."\n"
#    );
#    $debug>=2 && print(STDERR __PACKAGE__."->guess debug level is ".$debug."\n");
    unless(defined($self->{req})) {
        warn(__PACKAGE__."->guess needs a req. Caller: ".caller()."\n");
        return undef;
    }
    
    if(
        defined($arg{obj}) 
        and $arg{obj}->what=~/(interface)([12])/
    ) {
        undef($arg{obj});
        $arg{what}=$1;
        $arg{what_index}=$2;
    } elsif(
        defined($arg{what}) 
        and $arg{what}=~/(interface)([12])/
    ) {
        $arg{what}=$1;
        $arg{what_index}=$2;
    }
    
    $arg{obj}=$self->{req}->newobj(what=>$arg{what})
    unless(defined($arg{obj}) or !defined($arg{what}));
    
    $self->{obj}=$arg{obj};
    
    if(defined $arg{what_index}) {
        $arg{obj}->{index}=$arg{what_index};
        if(defined $arg{$arg{obj}->idattrib.$arg{what_index}}) {
            $arg{$arg{obj}->idattrib}=$arg{$arg{obj}->idattrib.$arg{what_index}};
        }
    }
    
    $debug && print STDERR __PACKAGE__."->guess querrying a ".$arg{obj}->what;
    $debug && print STDERR " list" if $arg{list};
    $debug && print STDERR " for ".caller()."\n";
    
    unless(defined($arg{obj}) and ref($arg{obj}) eq "PerlForms::Dict::Object") {
        warn(__PACKAGE__."->guess Needs an obj. Caller: ".caller()."\n");
        warn(__PACKAGE__."->guess obj is ".(defined($arg{obj})?"":"not ")."defined".(defined($arg{obj})?", is a ".ref($arg{obj}).".":".\n"));
        warn(__PACKAGE__."->guess what is ".(defined($arg{obj})?"":"not ")."defined.\n");
        return undef;
    }
    
    my($evalcmd);
    if($arg{obj}->what eq "childway" and $arg{list}) {
        $self->way_list(%arg);
    } elsif($arg{list}) {
        if($self->can($arg{obj}->what."_list")) {
            $evalcmd='$self->'.$arg{obj}->what.'_list(%arg)';
        } elsif($arg{obj}->storage eq "edir") {
            $evalcmd='$self->defaultldap_list(%arg)';
        } else {
            $debug && warn(
                __PACKAGE__."->guess dont see a specific query-sub for ".
                $arg{obj}->what."_list, using default_list.\n"
            );
            $evalcmd='$self->default_list(%arg)';
        }
    } else {
        if($self->can($arg{obj}->what)) {
            $evalcmd='$self->'.$arg{obj}->what.'(%arg)';
        } elsif($arg{obj}->storage eq "edir") {
            $evalcmd='$self->defaultldap(%arg)';
        } else {
            $evalcmd='$self->default(%arg)';
        }
    }
    $debug>=2 && print(STDERR $self."->guess running '".$evalcmd."'\n");
    eval $evalcmd;
}

sub changelog_list {
    # expects: req whatabout? whatabout_id?
    my$self=shift;
    my(%arg)=@_;
    $self->faultt(msg=>__PACKAGE__."->changelog_list needs a req.") unless defined($self->{req});
    
    unless(defined($arg{whatabout})) {
        if(defined($arg{concerning})) {
            $arg{whatabout}=$arg{concerning};
        } elsif(defined($arg{filter})) {
            my($fobj)=new PerlForms::Dict::Object(req=>$self->{req},idattrib=>$arg{filter});
            $arg{whatabout}=$fobj->what;
        }
    }
    unless(defined($arg{whatabout_id})) {
        if(defined($arg{concerning_id})) {
            $arg{whatabout_id}=$arg{concerning_id};
        } elsif(defined($arg{filter}) and defined($arg{$arg{filter}})) {
            $arg{whatabout_id}=$arg{$arg{filter}};
        }
    }
    
    my($sql)="
        select
            cl.id,
            cl.id cl,
            cl.timestamp,
            b.name pfuser,
            cl.what,
            cl.what concerning,
            cl.what whatabout,
            cl.what_id,
            cl.what_id concerning_id,
            cl.what_id whatabout_id,
            cl.field,
            cl.oldvalue,
            cl.newvalue
        from
            changelog cl left outer join benutzer b on b.id=cl.benutzer_id
        where
    ";
    if(defined($arg{whatabout})) {
        $sql.="
            and cl.what='".$arg{whatabout}."'
        ";
    }
    if(defined($arg{whatabout_id})) {
        $sql.="
            and cl.what_id='".$arg{whatabout_id}."'
        ";
    }
    
    ## wenn keine anderen kriterien, dann nur die eintraege der letzten drei
    ## tage anzeigen.
    unless(defined($arg{whatabout}) or defined($arg{whatabout_id})) {
        $sql.="
            and cl.timestamp>=".(time()-259200)."
        ";
    }
    $sql.="
        order by
            cl.timestamp
    ";
    
    $debug && print(STDERR __PACKAGE__."->changelog_list: SQL-Query: ".$sql."\n");
    
#    return $self->{req}->{db}->hashref($sql);
    $self->{req}->things("changelog")->storage->{db}->hashref($sql)
}
#
#sub device_list { my$self=shift;
#    # expects: req o?
#    my(%arg)=@_;
#    $debug>=2 && print(STDERR __PACKAGE__."->device_list: got arguments: ".join(", ",keys(%arg))."\n");
#    $self->faultt(msg=>__PACKAGE__."->device_list needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            d.id,
#            d.id d,
#            d.name,
#            d.name device,
#            d.ipaddress,
#            d.os_id o,
#            b.name pfuser,
#            b.id b,
#            d.freshness
#        from
#            device d
#            left outer join benutzer b on b.id=d.benutzer_id,
#    ";
#
#    my(@from,@where);
#
#    if(defined($arg{i})) {
#        push(@from,"interface i");
#        push(@where,"i.device_id=d.id","i.id=".$arg{i});
#    }
#
#    if(defined($arg{vl})) {
#        push(@from,"interface i","macaddress mac");
#        push(@where,"i.device_id=d.id","i.address=mac.address","mac.vlan=".$arg{vl});
#    }
#
#    $sql.="        ".join(",\n            ",@from);
#
#    $sql.="
#        where
#    ";
#
#    if(defined($arg{o})) {
#        $sql.="
#            and d.os_id=".$arg{o}."
#        "; 
#    }
#    if(defined($arg{b})) {
#        $sql.="
#            and d.benutzer_id=".$arg{b}."
#        "; 
#    }
#    if(defined($arg{ma})) {
#        $sql.="
#            and d.monaccess_id=".$arg{ma}."
#        "; 
#    }
#    if(defined($arg{ipaddress})) {
#        if($arg{ipaddress}>0) {
#            $sql.="
#            and d.ipaddress=".$arg{ipaddress}."
#            "; 
#        } else {
#            $sql.="
#            and d.ipaddress is null
#            "; 
#        }
#    }
##    if(defined($arg{i})) {
##        $sql.="
##            and i.device_id=d.id
##            and i.id=".$arg{i}."
##        ";
##    }
#    $sql.="\n            and ".join("\n            and ",@where);
#    
#    $sql=~s/\n\s*\n/\n/g;
#    $sql=~s/where\s*and\s*/where\n            /g;
#    $sql=~s/\s*,\s*where/\n        where/g;
#    $sql=~s/\s*and\s*$//g;
#    $sql=~s/\s*where\s*$//g;
#    $sql=~s/\s*,\s*$//g;
#    
#    $debug>=2 && print(STDERR __PACKAGE__."->device_list: SQL-Query: ".$sql."\n");
#        
#    return $self->{req}->{db}->hashref($sql);
#}
#
#sub device2deviceatribute { my$self=shift;
#    # expects: req d? da? parameter?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->device2deviceatrbiute needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"device2deviceatribute");
#    my($abk)=$obj->idattrib;
#    unless(
#        (defined($arg{d}) and defined($arg{da}))
#        or defined($arg{dd})
#    ) {
#        warn(__PACKAGE__."->device2deviceatribute most likely will return more than one record.");
#    }
##    unless(
##        (defined($arg{d}) and defined($arg{da}) and defined($arg{parameter}))
##        or defined($arg{dd})
##    ) {
##        warn(__PACKAGE__."->device2deviceatribute might return more than one record: no parameter specified.");
##    }
#    my($sql)="
#        select
#            ".$abk.".id dd,
#            ".$abk.".id id,
#            d.id d,
#            d.name device,
#            da.name deviceatribut,
#            da.prefix prefix,
#            ".$abk.".parameter parameter,
#            da.id da,
#            ".$abk.".notes notes
#        from
#            ".$obj->tablename." ".$abk.",
#            device d,
#            deviceatribut da
#        where
#    ";
#    if(defined($arg{id}) and $arg{id}=~/\d/) {
#        $sql.="
#            and ".$abk.".id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{dd}) and $arg{dd}=~/\d/) {
#        $sql.="
#            and ".$abk.".id=".$arg{dd}."
#        ";
#    }
#    if(defined($arg{d}) and $arg{d}=~/\d/) {
#        $sql.="
#            and ".$abk.".device_id=".$arg{d}."
#        ";
#    }
#    if(defined($arg{da}) and $arg{da}=~/\d/) {
#        $sql.="
#            and ".$abk.".deviceatribut_id=".$arg{da}."
#        ";
#    }
#    if(defined($arg{parameter})) {
#        $arg{parameter}=~s/'/\\'/g;
#        $sql.="
#            and ".$abk.".parameter='".$arg{parameter}."'
#        ";
#    }
#    $sql.="
#            and ".$abk.".device_id=d.id 
#            and ".$abk.".deviceatribut_id=da.id
#    ";
#    $sql=~s/\n\s*\n\s*/\n            /g;
#    $sql=~s/where\s*and\s*/where\n            /g;
#    print(STDERR __PACKAGE__."->device2deviceatribut: SQL-Query:".$sql."\n");
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->devic2deviceatribute SQL-Query failed: ".$sql." ".$!);
#    
#    if(defined($data)) {
#        $data->{name}=$data->{device}.": " unless defined $arg{d};
#        $data->{name}.=$self->service_description(%$data);
#        $data->{$obj->what}=$data->{name};
#        return $data
#    } else {
#        return undef;
#    }
#}
#
#sub device2deviceatribute_list { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->device2deviceatribute_list needs a req.")
#    unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"device2deviceatribute");
#    my($abk)=$obj->idattrib;
#    my($sql)="
#        select
#            ".$abk.".id ".$abk.",
#            ".$abk.".id id,
#            d.id d,
#            d.name device,
#            da.name deviceatribut,
#            ".$abk.".parameter parameter,
#            da.id da,
#            ".$abk.".notes notes
#        from
#            ".$obj->tablename." ".$abk.",
#            device d,
#            deviceatribut da,
#    ";
#    if(defined($arg{r}) or defined($arg{rd})) {
#        $sql.="
#            requirement2devices rd
#        ";
#    }
#    $sql.="
#        where
#    ";
#    $sql.="and ".$abk.".device_id=".$arg{d} if(defined($arg{d}) and $arg{d}=~/\d/);
#    $sql.="and ".$abk.".deviceatribut_id=".$arg{da} if(defined($arg{da}) and $arg{da}=~/\d/);
#    if(defined($arg{parameter})) {
#        $arg{parameter}=~s/'/\\'/g;
#        $sql.="and ".$abk.".parameter=".$arg{parameter};
#    }
#    $sql.="
#            and ".$abk.".device_id=d.id 
#            and ".$abk.".deviceatribut_id=da.id
#    ";
#    if(defined($arg{r})) {
#        $sql.="
#            and rd.device2deviceatribute_id=".$abk.".id
#            and rd.requirement_id=".$arg{r}."
#        ";
#    }
#    if(defined($arg{rd})) {
#        $sql.="
#            and rd.device2deviceatribute_id=".$abk.".id
#            and rd.id=".$arg{rd}."
#        ";
#    }
#    $sql=~s/,\s*where/\n        where/;
#    $sql=~s/where\s*and/where /g;
#    my(%data,$rec);
#    my($sth)=$self->{req}->{db}->{dbh}->prepare($sql);
#    $sth->execute;
#    while($rec=$sth->fetchrow_hashref) {
#        $rec->{name}=$rec->{device}.": " unless defined $arg{d};
#        $rec->{name}.=$self->service_description(
#            prefix=>$rec->{deviceatribut},
#            parameter=>$rec->{parameter}
#        );
#        $rec->{$obj->what}=$rec->{name};
#        $data{$rec->{name}.$rec->{id}}=$rec;
#    }
#    \%data;
#}
##
##sub servicepoint { my$self=shift;
##    # expects: req sp
##    my(%arg)=@_;
##    $self->faultt(msg=>__PACKAGE__."->servicepoint needs a req.") unless defined($self->{req});
##    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"servicepoint");
##    $arg{id}=$arg{$obj->idattrib} unless defined($arg{id});
##    my($sql)="
##        select
##            id,
##            id sp,
##            service_id s,
##            kunde_id c,
##            monlevel_id ml
##        from
##            ".$obj->tablename."
##        where
##            id=".$arg{id}."
##    ";
##    return $self->{req}->{db}->{dbh}->selectrow_hashref($sql)
##        or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql." ".$!);
##}
#
#sub servicepoint_list { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->servicepoint_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"servicepoint");
#    my($sql)='
#        select
#            sp.id,
#            sp.id sp,
#            s.name service,
#            c.name kunde
#        from
#            servicepoint sp,
#            service s,
#            kunde c
#        where
#            sp.service_id=s.id
#            and sp.kunde_id=c.id
#    ';
#    if(defined($arg{c}) and $arg{c}=~/\d/) {
#        $sql.="
#            and c.id=".$arg{c}."
#        ";
#    }
#    my($result)=$self->{req}->{db}->{dbh}->selectall_hashref($sql,"sp") or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql." ".$!);
#    my($key,$data);
#    foreach $key (keys(%{$result})) {
#        my($rec)=$result->{$key};
#        $rec->{name}=$rec->{service}." ".$rec->{kunde};
#        $rec->{$obj->what}=$rec->{name};
#        $data->{$rec->{name}}=$rec;
#    }
#    return $data;
#}
#
#sub deviceatribut { my$self=shift;
#    # expects: req
#    # returns:
#    #     hashref(
#    #     )
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->deviceatribut needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"deviceatribut");
#    $arg{id}=$arg{$obj->idattrib} unless(defined($arg{id}) and $arg{id}=~/\d/);
#    my(%result);
#    my($sql)="
#        select
#            da.id,
#            da.id da,
#            da.name,
#            da.name deviceatribut,
#            da.prefix,
#            da.check_interval,
#            da.retry_check_interval,
#            da.max_check_attempts
#        from
#            deviceatribut da
#        where
#    ";
#    if(defined($arg{id}) and $arg{id}=~/\d/) {
#        $sql.="
#            da.id=".$arg{id}."
#        ";
#    } elsif(defined($arg{deviceatribut}) and $arg{deviceatribut}=~/\w/) {
#        $sql.="
#            da.name like '".$arg{deviceatribut}."'
#        ";
#    } elsif(defined($arg{name}) and $arg{name}=~/\w/) {
#        $sql.="
#            da.name like '".$arg{name}."'
#        ";
#    } else {
#        $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->deviceatribut No criteria specified.");
#    }
#
##    my($data)=$self->{req}->{db}->exec($sql) or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql);
##
##    $result{id}=$data->[0]->[0];
##    $result{name}=$data->[0]->[1];
##    $result{deviceatribut}=$data->[0]->[1];
##
##    return(\%result);
#    $self->{req}->{db}->{dbh}->selectrow_hashref($sql);
##        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->deviceatribut SQL-Query failed: ".$sql." ".$!."\n".$!);
#    ## selectrow gibt undef zurück wenn ein fehler aufgetr. ist _oder_ wenn
#    ## kein datensatz gefunden wurde.
#}
#
#sub deviceatribut_list { my$self=shift;
#    # expects: req m?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->deviceatribut_list needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            da.id,
#            da.id da,
#            da.name,
#            da.name deviceatribut,
#            da.prefix,
#            da.check_interval,
#            da.retry_check_interval,
#            da.max_check_attempts
#        from
#            deviceatribut da
#    ";
#    
#    if($arg{m}) {
#        $sql.=",monitor m where m.id=".$arg{m}." and m.deviceatribut_id=da.id";
#    }
#    
#    $debug && print STDERR __PACKAGE__."->deviceatribut_list SQL-Query: ".$sql."\n";
#
#    return $self->{req}->{db}->hashref($sql);
#}
#
#sub functionality_list { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->functionality_list needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            fu.id,
#            fu.id fu,
#            fu.name name,
#            fu.name functionality
#        from
#            functionality fu
#    ";
#    if($arg{s}) {
#        $sql.="
#            join service2functionalities sf on sf.functionality_id=fu.id
#        where
#            sf.service_id=".$arg{s}."
#        ";
#    }
#    elsif($arg{r}) {
#        $sql.="
#            join functionality2requirements fr on fr.functionality_id=fu.id
#        where
#            fr.requirement_id=".$arg{r}."
#        ";
#    }
#    elsif($arg{rd}) {
#        $sql.="
#            join functionality2requirements fr on fr.functionality_id=fu.id
#            join requirement2devices rd on rd.requirement_id=fr.requirement_id
#        where
#            rd.id=".$arg{rd}."
#        ";
#    }
#    return $self->{req}->{db}->hashref($sql);
#}
##
##sub functionality { my$self=shift;
##    # expects: req id
##    # returns: hashref
##    my(%arg)=@_;
##    
##    $self->faultt(msg=>__PACKAGE__."->functionality needs a req.")
##        unless defined($self->{req});
##    
##    #die unless(defined($arg{id}) or defined($arg{fu}));
##    $arg{id}=$arg{fu} unless(defined($arg{id}));
##    my($sql)="
##        select
##            id,
##            id fu,
##            name,
##            name functionality
##        from
##            functionality
##        where
##    ";
##    if($arg{id}) {
##        $sql.="
##            id=".$arg{id}."
##        ";
##    } elsif(defined($arg{name})) {
##        $arg{name}=~s/'/\\'/g;
##        $sql.="
##            name='".$arg{name}."'
##        ";
##    }
##    
###    print STDERR "SQL-Query: ".$sql."\n";
##    return $self->{req}->{db}->{dbh}->selectrow_hashref($sql)
##        or die("SQL-Query failed: ".$sql);
##}
##
##sub functionality2requirements { my$self=shift;
##    # expects: req obj id|[fu r]
##    # returns: hashref
##    my(%arg)=@_;
##    
##    $self->faultt(msg=>__PACKAGE__."->functionality2requirements needs a req.")
##        unless defined($self->{req});
##    
##    require PerlForms::Dict::Object;
##    $arg{obj}=new PerlForms::Dict::Object(req=>$self->{req},what=>"functionality2requirements")
##        unless defined $arg{obj} and ref($arg{obj}) eq "PerlForms::Dict::Object";
##    
##    $arg{id}=$arg{$arg{obj}->idattrib} unless(defined($arg{id}));
##    #$self->faultt(req=>$self->{req},msg=>__PACKAGE__."->functionality2requirements needs an id or a fr.") unless defined($arg{id});
##    
##    my($sql)="
##        select
##            fr.id,
##            fr.id fr,
##            fr.functionality_id fu,
##            fu.name functionality,
##            fr.requirement_id r,
##            r.name requirement
##        from
##            functionality2requirements fr
##            join functionality fu on fu.id=fr.functionality_id
##            join requirement r on r.id=fr.requirement_id
##        where
##    ";
##    if($arg{id}) {
##        $sql.="
##            and fr.id=".$arg{id}."
##        ";
##    }
##    if($arg{fu}) {
##        $sql.="
##            and fr.functionality_id=".$arg{fu}."
##        ";
##    }
##    if($arg{r}) {
##        $sql.="
##            and fr.requirement_id=".$arg{r}."
##        ";
##    }
##    $sql=~s/where\s+and/where\n            /g;
##
##    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql);
##    return {} unless(defined($data->{functionality}));
##    $data->{name}=$data->{functionality}.": ".$data->{requirement};
##    
##    return $data;
##}
#
#sub requirement_list { my$self=shift;
#    # expects: req fu?
#    # returns: hashref
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->requirement_list needs a req.") unless defined($self->{req});
#    my($sql);
#    if($arg{fu} or $arg{fr}) {
#        $sql="
#            select
#                r.id id,
#                r.id r,
#                r.name name,
#                r.name requirement,
#                fr.id fr,
#                fr.functionality_id fu,
#                fu.name functionality
#            from
#                functionality2requirements fr
#                join functionality fu on fu.id=fr.functionality_id
#                join requirement r on r.id=fr.requirement_id
#            where
#        ";
#        if($arg{fr}) {
#            $sql.="
#                    fr.id=".$arg{fr}." 
#            ";
#        }
#        if($arg{fu}) {
#            $sql.="
#                    fr.functionality_id=".$arg{fu}." 
#            ";
#        }
#        $sql=~s/where\s*$//g;
#        return $self->{req}->{db}->hashref($sql)
#        or warn(
#            __PACKAGE__."->requirement_list SQL-Query failed: ".$sql."\n".$!.
#            "\n"
#        );
#    } else {
#        $self->default_list(%arg);
#    }
#}
##
##sub functionality2requirements_list { my$self=shift;
##    # expects: req fu?
##    # returns: hashref
##    my(%arg)=@_;
##    $self->faultt(msg=>__PACKAGE__."->functionality2requirement_list needs a req.") unless defined($self->{req});
##    my($sql);
##    if($arg{rd} or $arg{r}) {
##        return $self->functionality_list(%arg);
##    } else {
##        $sql="
##            select
##                fr.id id,
##                fr.id fr,
##                fr.functionality_id fu,
##                fu.name functionality,
##                fr.requirement_id r,
##                r.name requirement
##            from
##                functionality2requirements fr
##                join functionality fu on fu.id=fr.functionality_id
##                join requirement r on r.id=fr.requirement_id
##            where
##        ";
##        if($arg{fr}) {
##            $sql.="
##                    fr.id=".$arg{fr}." 
##            ";
##        }
##        if($arg{fu}) {
##            $sql.="
##                    fr.functionality_id=".$arg{fu}." 
##            ";
##        }
##        if($arg{r}) {
##            $sql.="
##                    fr.requirement_id=".$arg{r}." 
##            ";
##        }
##    }
##    $sql=~s/where\s*$//g;
##    return $self->{req}->{db}->hashref($sql) or warn(__PACKAGE__."->functionality2requirements_list SQL-Query failed: ".$sql."\n".$!."\n");
##}
#
#sub interface { my$self=shift;
#    # expects: req id d?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->interface needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"interface");
#    $arg{id}=$arg{$obj->idattrib} unless defined($arg{id});
#    
#    my%dbfields=$obj->dbfields;
#    my(@select,%where);
#
#    while(my($field,$dbfield)=each(%dbfields)) {
#        next unless(defined($dbfield) and $dbfield ne "none");
#        if($field eq "interface") {
#            push(@select,"concat(d.name,': ',i.name) ".$field);
#        } else {
#            push(@select,"i.".$dbfield." ".$field);
#        }
#        if(defined($arg{$field}) and $field ne "freshness") {
##            print STDERR __PACKAGE__."->interface: this could be an ip: ".$arg{$field}."\n" if($arg{$field}=~/\d+\.\d+\.\d+\.\d+/);
#            if($field eq "address" and $arg{$field}=~/\d+\.\d+\.\d+\.\d+/) {
#                $where{"i.".$dbfield}=$self->ip2int($arg{$field});
#            } else {
#                $where{"i.".$dbfield}=$arg{$field};
#            }
#        }
#    }
#    push(@select,"d.name device");
#    my(@from)=("interface i left outer join device d on d.id=i.device_id");
#
#    $arg{id}=$arg{i} unless($arg{id});
#    if(defined($arg{id}) and $arg{id}=~/\w/) {
#        $where{"i.id"}=$arg{id};
#    }
#    if(defined($arg{d}) and $arg{d}=~/\d/) {
#        $where{"i.device_id"}=$arg{d};
#    }
#    if(defined($arg{address}) and $arg{address}=~/\w/) {
#        if(defined($arg{nt}) and $arg{nt}==4) {
#            $where{"i.address"}=$self->ip2int($arg{address});
#        } else {
#            $where{"i.address"}=$arg{address};
#        }
#    }
#    if(defined($arg{name}) and $arg{name}=~/\w/) {
#        $where{"i.name"}=$arg{name};
#    }
#    if(defined($arg{nt}) and $arg{nt}=~/\d/) {
#        $where{"i.networktype_id"}=$arg{nt};
#    }
#    if(defined($arg{pi}) and $arg{pi}=~/\d/) {
#        $where{"i.parent_interface_id"}=$arg{pi};
#    }
#    
#    my($sql)=$self->{req}->{db}->sql_builder(\@select,\@from,\%where,ornull=>$arg{"ornull"});
#
##    print STDERR __PACKAGE__."->interface SQL-Query: ".$sql."\n";
#    unless($sql=~/where/) {
#        warn(__PACKAGE__."->interface: No 'where', returning undef.\n");
#        return undef;
#    }
#    $sql=~s/\s+/ /g;
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql);
#    if(defined($data->{nt}) and $data->{nt}==4) {
#        $data->{address}=$self->int2ip($data->{address});
#    }
#    unless(defined($data->{name}) and $data->{name}=~/\w/) {
#        $data->{name}=$data->{justthename};
#    }
#    return $data;
#}
#
#sub interface_list { my$self=shift;
#    # expects: req pi? d?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->interface_list needs a req.")
#        unless defined($self->{req});
#    
#    my(@select)=(
#        "i.id",
#        "i.id i",
#        "i.address",
#        "i.parent_interface_id pi",
#        "i.device_id d",
#        "i.networktype_id nt",
#        "i.freshness",
#        "i.source"
#    );
#    my(@from)=("interface i");
#    my(@where);
#    my(@groupby)=(
#        "i.id",
#        "i.address",
#        "i.parent_interface_id",
#        "i.device_id",
#        "i.networktype_id"
#    );
#    my($sql);
#    if(defined($arg{pi}) and $arg{pi}=~/\d/) {
#        $sql="
#            select
#                id,
#                id i,
#                name,
#                name interface,
#                address,
#                device_id d,
#                networktype_id nt,
#                freshness,
#                source
#            from
#                interface
#            where
#                parent_interface_id=".$arg{pi}."
#        ";
#        if(defined($arg{nt})) {
#            if(ref($arg{nt}) eq "ARRAY") {
#                $sql.="
#                        and i.networktype_id in (".join( ", ", @{ $arg{nt} } ).")
#                ";
#            } elsif($arg{nt}=~/\d/) {
#                $sql.="
#                        and i.networktype_id=".$arg{nt}."
#                ";
#            }
#        }
#    } elsif(defined($arg{d}) and $arg{d}==0) {
#        push(@select,"i.name name","i.name interface");
#        push(@select,"count(mac.id) macaddresses");
#        push(@from,"left outer join macaddress mac on mac.address=i.address");
#        push(@where,"i.device_id is null");
#        push(@groupby,"i.name");
#        if(defined($arg{nt})) {
#            if(ref($arg{nt}) eq "ARRAY") {
#                push(@where,"i.networktype_id in (".join( ", ", @{ $arg{nt} } ).")");
#            } elsif($arg{nt}=~/\d/) {
#                push(@where,"i.networktype_id=".$arg{nt});
#            }
#        }
#        $sql="
#            select
#                ".join(",\n                ",@select)."
#            from
#                ".join(",\n                ",@from)."
#            where
#                ".join("\n                and ",@where)."
#            group by
#                ".join(",\n                ",@groupby)."
#        ";
#    } elsif(defined($arg{d}) and $arg{d}=~/\d/) {
#        $sql="
#            select
#                i.id,
#                i.id i,
#                i.name,
#                i.name interface,
#                i.address,
#                i.parent_interface_id pi,
#                i.networktype_id nt,
#                i.device_id d,
#                i.device_id,
#                i.freshness,
#                i.source
#            from
#                interface i
#            where
#                i.device_id=".$arg{d}."
#        ";
#        if(defined($arg{nt})) {
#            if(ref($arg{nt}) eq "ARRAY") {
#                $sql.="
#                        and i.networktype_id in (".join( ", ", @{ $arg{nt} } ).")
#                ";
#            } elsif($arg{nt}=~/\d/) {
#                $sql.="
#                        and i.networktype_id=".$arg{nt}."
#                ";
#            }
#        }
#    } else {
#        $sql="
#            select
#                i.id,
#                i.id i,
#                concat(d.name,': ',i.name) name,
#                concat(d.name,': ',i.name) interface,
#                i.address,
#                i.parent_interface_id pi,
#                i.device_id d,
#                d.name device,
#                i.networktype_id nt,
#                i.freshness,
#                i.source
#            from
#                interface i,
#                device d
#            where
#                i.device_id=d.id
#        ";
#        if(defined($arg{nt})) {
#            if(ref($arg{nt}) eq "ARRAY") {
#                $sql.="
#                        and i.networktype_id in (".join( ", ", @{ $arg{nt} } ).")
#                ";
#            } elsif($arg{nt}=~/\d/) {
#                $sql.="
#                        and i.networktype_id=".$arg{nt}."
#                ";
#            }
#        }
#    }
#    if(defined($arg{vl}) and $arg{vl}=~/\w/) {
#        push(@select,"concat(d.name,': ',i.name) name","concat(d.name,': ',i.name) interface");
#        push(@select,"d.name device");
#        push(@from,"device d","macaddress mac");
#        push(@where,"i.device_id=d.id","i.address=mac.address","mac.vlan=".$arg{vl});
#        $sql="
#            select
#                ".join(",\n                ",@select)."
#            from
#                ".join(",\n                ",@from)."
#            where
#                ".join("\n                and ",@where)."
#            group by
#                ".join(",\n                ",@groupby)."
#        ";
#    }
#    if(defined($arg{address}) and $arg{address}=~/\w/) {
##        push(@select,"concat(d.name,': ',i.name) name","concat(d.name,': ',i.name) interface");
#        push(@select,"i.name interface");
#        push(@select,"d.name device");
#        push(@from,"left outer join device d on d.id=i.device_id");
#        push(@where,"i.address='".$arg{address}."'");
#        $sql="
#            select
#                ".join(",\n                ",@select)."
#            from
#                ".join(",\n                ",@from)."
#            where
#                ".join("\n                and ",@where)."
#            group by
#                ".join(",\n                ",@groupby)."
#        ";
#    }
#    
##    $debug && print(STDERR __PACKAGE__."->interface_list: SQL-Query: ".$sql."\n");
#
#    my($data)=$self->{req}->{db}->hashref($sql);
#    unless(defined($data) and ref($data) eq "HASH") {
#        warn(__PACKAGE__."->interface_list: db->hashref failed.\n");
#        return undef;
#    }
#    my($networktypes)=$self->networktype_list(req=>$self->{req});
#    while(my($key,$int)=each(%$data)) {
#        if(
#            !defined($int->{"name"})
#            and !defined($arg{d})
#            and defined($int->{device})
#        ) {
#            $int->{"name"}=$int->{"device"}.": ".$int->{"interface"}
#        }
#        if(defined($int->{nt})) {
#            if(defined($networktypes->{$int->{nt}})) {
#                $data->{$key}->{networktype}=$networktypes->{$int->{nt}}->{name};
#                $data->{$key}->{name}.=" (".$data->{$key}->{networktype}.")";
#            } else {
#                warn(__PACKAGE__."->interface_list: no networktype record for ".$int->{nt}."\n");
#            }
#        } else {
#            warn(__PACKAGE__."->interface_list: no networktype defined for ".$int->{name}."\n");
#        }
#    }
#    $debug>=3 && print(STDERR 
#        __PACKAGE__."->interface_list returning a ",
#        ref($data)?ref($data):"string",
#        "\n"
#    );
#    $data;
#}
#
#sub parentinterface { my$self=shift;
#    my(%arg)=@_;
#    $arg{i}=$arg{pi} unless(defined($arg{i}) or !defined($arg{pi}));
#    return $self->interface(%arg);
#}
#
#sub parentinterface_list { my$self=shift;
#    return $self->interface_list(@_);
#}
#
#sub macaddress { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->macaddress needs a req.") unless defined($self->{req});
#    $arg{id}=$arg{mac} unless(defined($arg{id}) or !defined($arg{mac}));
#    my($sql)="
#        select
#            id,
#            id mac,
#            address,
#            address name,
#            address macaddress,
#            vlan,
#            interface_id i
#        from
#            macaddress
#        where
#    ";
#    if(defined($arg{address})) {
#        $sql.="
#            and address='".$arg{address}."'
#        ";
#    }
#    if(defined($arg{id})) {
#        $sql.="
#            and id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{i})) {
#        $sql.="
#            and interface_id=".$arg{i}."
#        ";
#    }
#    
#    $sql=~s/,\s*from/\n        from/;
#    $sql=~s/where\s*$//;
#    $sql=~s/where\W+and /where\n            /g;
#    $sql=~s/\n\s*\n/\n/g;
#    
#    return $self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->macaddress SQL-Query failed: ".$sql." ".$!);
#}
#
#sub macaddress_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    
#    $self->faultt(msg=>__PACKAGE__."->macaddress_list needs a req.")
#        unless defined($self->{req});
#    
#    my($sql)="
#        select
#            mac.id,
#            mac.id mac,
#            mac.address,
#            mac.address name,
#            mac.vlan vl,
#            mac.freshness,
#            vl.name vlan,
#            mac.interface_id i,
#            concat(d.name,': ',i.name) interface,
#            i.name justtheinterface,
#            d.name device,
#            i2.id i2,
#            concat(d2.name,': ',i2.name) interface2,
#            i2.name justtheinterface2
#        from
#            macaddress mac
#                left outer join interface i2 on i2.address=mac.address
#                left outer join device d2 on d2.id=i2.device_id
#                left outer join vlan vl on vl.id=mac.vlan,
#            interface i
#                left outer join device d on d.id=i.device_id
#        where
#            mac.interface_id=i.id
#    ";
##            and i.device_id=d.id
#    if(defined($arg{address})) {
#        $sql.="
#            and mac.address='".$arg{address}."'
#        ";
#    }
#    if(defined($arg{i})) {
#        $sql.="
#            and mac.interface_id=".$arg{i}."
#        ";
#    }
#    if(defined($arg{i2})) {
#        if($arg{i2}==0) {
#            $sql.="
#                and i2.id is null
#            ";
#        } else {
#            $sql.="
#                and i2.id=".$arg{i2}."
#            ";
#        }
#    }
#    if(defined($arg{d})) {
#        $sql.="
#            and i.device_id=".$arg{d}."
#        ";
#    }
#    if(defined($arg{d2}) and $arg{d2}==0) {
#        $sql.="
#            and i2.device_id is null
#        ";
#    }
#    if(defined($arg{vl})) {
#        $sql.="
#            and mac.vlan=".$arg{vl}."
#        ";
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->macaddress_list: SQL-Query: ".$sql."\n");
#
#    my($data)=$self->{req}->{db}->hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->macaddress_list: SQL-Query failed: ".$sql." ".$!);
#        
#    my($key,$rec,%result);
#    while(($key,$rec)=each(%$data)) {
#        $sql="select count(address) from macaddress where interface_id=".$rec->{i};
#        my($count)=$self->{req}->{db}->exec($sql);
#        ## folgende zeile verursacht "Use of uninitialized values..." in massen...
##        print(STDERR __PACKAGE__."->macaddress_list: is '".$arg{"otheraddresses"}."'!='".$count->[0]->[0]."'?\n");
#        next if(defined($arg{"otheraddresses"}) and $arg{"otheraddresses"}!=$count->[0]->[0]);
#        $rec->{"otheraddresses"}=$count->[0]->[0];
#        unless(defined($rec->{interface}) and $rec->{interface}=~/\w/) {
#            $rec->{interface}=$rec->{justtheinterface};
#        }
#        unless(defined($rec->{interface2}) and $rec->{interface2}=~/\w/) {
#            $rec->{justtheinterface2}=$rec->{address} unless(defined($rec->{justtheinterface2}));
#            $rec->{interface2}=$rec->{justtheinterface2};
#        }
#        unless(defined($rec->{vlan}) and $rec->{vlan}=~/\w/) {
#            $rec->{vlan}=$rec->{vl};
#        }
#        $result{$key}=$rec;
#    }
#    
#    \%result;
#}
#
#sub monaccess_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monaccess_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"monaccess");
#    my($sql)="
#        select
#            id,
#            id ma,
#            name,
#            name monaccess
#        from
#            ".$obj->tablename."
#    ";
#    return $self->{req}->{db}->hashref($sql) or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql." ".$!);
#}
#
#sub monlevel_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monlevel_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"monlevel");
#    my($sql)="
#        select
#            id,
#            id ml,
#            name,
#            name monlevel
#        from
#            ".$obj->tablename."
#    ";
#    #return $self->{req}->{db}->{dbh}->selectall_hashref($sql,"id") or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql." ".$!);
#    return $self->{req}->{db}->exec($sql) or $self->faultt(req=>$self->{req},msg=>"SQL-Query failed: ".$sql." ".$!);
#}
#
#sub networktype { my$self=shift;
#    # expects: req nt
#    # returns: hashref
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->networktype needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"network");
#    $arg{id}=$arg{$obj->idattrib} if( !defined($arg{id}) and defined($arg{$obj->idattrib}) );
#    my(%data)=(
#        1=>{
#            id=>1,
#            name=>"RJ45 Socket"
#        },
#        2=>{
#            id=>2,
#            name=>"VLAN Trunk"
#        },
#        3=>{
#            id=>3,
#            name=>"Ethernet"
#        },
#        4=>{
#            id=>4,
#            name=>"IP"
#        },
#        5=>{
#            id=>5,
#            name=>"TCP"
#        },
#        6=>{
#            id=>6,
#            name=>"Power Supply"
#        },
#        7=>{
#            id=>7,
#            name=>"SSH protocol"
#        },
#        8=>{
#            id=>8,
#            name=>"Loopback"
#        },
#        9=>{
#            id=>9,
#            name=>"Serial"
#        },
#        10=>{
#            id=>10,
#            name=>"Other"
#        }
#    );
#    if(defined($arg{id})) {
#        return $data{$arg{id}};
#    } elsif(defined($arg{name})) {
#        my($a,$b);
#        my($pat)=quotemeta($arg{name});
#        while(($a,$b)=each(%data)) {
#            return $b if($b->{name}=~/$pat/);
#        }
#    }
#}
#
#sub networktype_list { my$self=shift;
#    # expects: 
#    my(%arg)=@_;
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"network");
#    my(%data)=(
#        1=>{
#            id=>1,
#            name=>"RJ45 Socket"
#        },
#        2=>{
#            id=>2,
#            name=>"VLAN Trunk"
#        },
#        3=>{
#            id=>3,
#            name=>"Ethernet"
#        },
#        4=>{
#            id=>4,
#            name=>"IP"
#        },
#        5=>{
#            id=>5,
#            name=>"TCP"
#        },
#        6=>{
#            id=>6,
#            name=>"Power Supply"
#        },
#        7=>{
#            id=>7,
#            name=>"SSH protocol"
#        },
#        8=>{
#            id=>8,
#            name=>"Loopback"
#        },
#        9=>{
#            id=>9,
#            name=>"Serial"
#        },
#        10=>{
#            id=>10,
#            name=>"Other"
#        }
#    );
#    return \%data;
#}
##
##sub port { my$self=shift;
##    # expects: req obj id|pt
##    # returns: hashref
##    my(%arg)=@_;
##    $self->faultt(msg=>__PACKAGE__."->port needs a req.") unless defined($self->{req});
##    require PerlForms::Dict::Object;
##    $arg{obj}=new PerlForms::Dict::Object(what=>"port") unless defined $arg{obj} and ref($arg{obj}) eq "PerlForms::Dict::Object";
##    $arg{id}=$arg{$arg{obj}->idattrib} unless(defined($arg{id}));
##    $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->port needs an id or a ".$obj->idattrib.".") unless defined($arg{id});
##    
##    my($sql)="
##        select
##            pt.id,
##            pt.id ".$obj->idattrib.",
##            pt.logicaldesc name,
##            pt.logicaldesc ".$obj->what.",
##            pt.logicaldesc,
##            pt.physicaldesc,
##            pt.porttype_id
##        from
##            port pt
##        where
##            pt.id=".$arg{id}."
##    ";
##    return $self->{req}->{db}->{dbh}->selectrow_hashref($sql) or warn(__PACKAGE__."->port SQL-Query failed: ".$sql."\n".$!."\n");
##}
##
##sub port_list { my$self=shift;
##    # expects: req
##    # returns: hashref
##    my(%arg)=@_;
##    $self->faultt(msg=>__PACKAGE__."->port_list needs a req.") unless defined($self->{req});
##    my($sql)="
##        select
##            pt.id,
##            pt.id pt,
##            pt.logicaldesc,
##            pt.logicaldesc name,
##            pt.physicaldesc,
##            pt.porttype_id
##        from
##            port pt
##        where
##    ";
##    if(defined($arg{d}) and $arg{d}=~/\d/) {
##        $sql.="
##            pt.device_id=".$arg{d}."
##        ";
##    }
##    $sql=~s/where\s*$//;
##    return $self->{req}->{db}->{dbh}->selectall_hashref($sql,"id") or warn(__PACKAGE__."->port SQL-Query failed: ".$sql."\n".$!."\n");
##}
#
#sub moninstance_list { my$self=shift;
#    # expects: req what monsw? hash? name?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->moninstance_list needs a req.") unless defined($self->{req});
#    
#    $arg{hash}=1;
#    
#    my($result);
#    my($sql)="
#        select
#            mi.id,
#            mi.id mi,
#            mi.name,
#            mi.name moninstance,
#    ";
#    if($arg{monsw}) {
#        $sql.="
#                md.monsw_id
#        ";
#    }
#    $sql.="
#        from
#    ";
#    if($arg{monsw}) {
#        $sql.="
#            moninstance2devices md,
#        ";
#    }
#    $sql.="
#            moninstance mi
#        where
#    ";
#    if($arg{monsw}) {
#        $sql.="
#            mi.id=md.moninstance_id
#        ";
#    }
#    if(defined($arg{name}) and $arg{name}=~/\w/) {
#        $sql.=" and mi.name like '".$arg{name}."'";
#    }
#    #$sql.="
#    #    group by
#    #       mi.id,
#    #       mi.name
#    #";
#    $sql=~s/,\s*from/\n        from/;
#    $sql=~s/where\s*$//;
#    #my($data)=$db->exec($sql) or die("SQL-Query failed: ".$sql);
#    #foreach $row (@{$data}) {
#    #    # result
#    #    #  |- moninstance-x
#    #    #  |    |- ipaddress
#    #    #  |    '- basepath
#    #    #  '- moninstance-y
#    #    #       |- ipaddress
#    #    #       '- basepath
#    #    #print STDERR "\n".$row->[0]."\n    IP address: ".$self->int2ip($row->[1])."\n    base path: ".$row->[2]."\n";
#    #    #$result->{$row->[4]}->{ipaddress}=$self->int2ip($row->[1]);
#    #    #$result->{$row->[4]}->{basepath}=$row->[2];
#    #    $result->{$row->[1]}->{id}=$row->[0];
#    #    $result->{$row->[1]}->{monsw_id}->{$row->[2]}++;
#    #    #$result->{$row->[4]}->{name}=$row->[3];
#    #}
#    my($st)=$self->{req}->{db}->{dbh}->prepare($sql) or die("SQL-Query failed: ".$sql);
#    $st->execute or die("SQL-Query failed: ".$sql);
#    #
#    # result                     # hash refernce, enthaelt die moninstances beim namen
#    #  +--{moninstancenamex}     # hash refernce, enthaelt die parameter einer moninstance beim namen
#    #  |   `--{monsw_id}         # hash refernce, enthaelt enhaelt die vorkommenden werte dieses parameters
#    #  |       `--{1}            # scalar,        enthaelt die anzahl aller monitor-kisten mit dieser monsw_id
#    #  +--{moninstancenamey}     # hash refernce, enthaelt die parameter einer moninstance beim namen
#    #  +--{moninstancenamez}     # hash refernce, enthaelt die parameter einer moninstance beim namen
#    #  .
#    #  .
#    # 
#    if($arg{hash}) {
#        my($row);
#        while($row=$st->fetchrow_hashref) {
#            unless(defined $row->{name}) {
#                warn(__PACKAGE__."->moninstance_list: no name in row ".$row->{id}."\n");
#                next;
#            }
#            #$result->{$row->{name}}=$row;
#            if(defined $row->{monsw_id}) {
#                $result->{$row->{name}}->{id}=$row->{monsw_id};
#                $result->{$row->{name}}->{monsw_id}->{$row->{monsw_id}}++;
#            } else {
#                warn(__PACKAGE__."->moninstance_list: no monsw_id in row ".$row->{id}."\n");
#            }
#        }
#        return($result?$result:{});
#    } else {
#        my($row);
#        while($row=$st->fetchrow_hashref) {
#            push(@{$result},$row);
#        }
#        if($result) {
#            wantarray()?return(@{$result}):return($result);
#        } else {
#            return {};
#        }
#    }
#}
#
#sub monnode_list { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monnode_list needs a req.") unless defined($self->{req});
#    my($result);
#    my($sql)="
#        select
#            d.name,
#            md.basepath,
#            md.monsw_id
#        from
#            device d,
#            moninstance2devices md
#        where
#            d.id=md.device_id
#            and md.moninstance_id=".$arg{mi}."
#    ";
#    if(defined($arg{device}) and $arg{device}=~/\w/) {
#        $sql.="
#        ";
#    }
#    $sql.="
#        order by
#            d.name
#    ";
#    my($data)=$self->{req}->{db}->exec($sql) or die("SQL-Query failed: ".$sql);
#    my($row);
#    foreach $row (@{$data}) {
#        $result->{$row->[0]}->{basepath}=$row->[1];
#        $result->{$row->[0]}->{monsw_id}=$row->[2];
#    }
#    return $result;
#}
#
#sub monitor { my$self=shift;
#    # expects: req m|id
#    # returns: hashref
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monitor needs a req.") unless defined($self->{req});
#    $arg{id}=$arg{m} unless(defined($arg{id}) and $arg{id}=~/\d/);
#    my($sql)="
#        select
#            m.id,
#            m.id m,
#            m.deviceatribut_id da,
#            m.name,
#            m.name monitor,
#            m.command_line,
#            m.perfdata,
#            m.monaccess_id ma,
#            m.os_id o,
#            m.preference
#        from
#            monitor m
#        where
#    ";
#    if(defined($arg{id})) {
#        $sql.="
#            and m.id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{da})) {
#        $sql.="
#            and m.deviceatribut_id=".$arg{da}."
#        ";
#    }
#    if(defined($arg{ma})) {
#        $sql.="
#            and (m.monaccess_id=".$arg{ma}." or m.monaccess_id is null or m.monaccess_id=4)
#        ";
#    }
#    if(defined($arg{o})) {
#        $sql.="
#            and (m.os_id=".$arg{o}." or m.os_id is null or m.os_id=0)
#        ";
#    }
#    $sql.="
#        order by
#            m.preference
#    ";
#    $sql=~s/where\W+and /where\n            /g;
#    $sql=~s/\n\s*\n/\n/g;
#    
#    return $self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or warn(__PACKAGE__."->monitor SQL-Query failed: ".$sql."\n".$!."\n");
#}
#
#sub monitor_list { my$self=shift;
#    # expects: req da? os? ma?
#    # returns: arrayref of hashrefs
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monitor_list needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            m.id,
#            m.id m,
#            m.name,
#            m.name monitor,
#            m.command_line,
#            m.perfdata,
#            m.preference,
#            da.id da,
#            da.name deviceatribut,
#            o.name os,
#            ma.name monaccess
#        from
#            monitor m
#            left outer join os o on o.id=m.os_id
#            left outer join monaccess ma on ma.id=m.monaccess_id
#            left outer join deviceatribut da on da.id=m.deviceatribut_id
#        where
#    ";
#    if(defined($arg{da}) and $arg{da}=~/\d/) {
#        $sql.="
#            and deviceatribut_id=".$arg{da}."
#        ";
#    }
#    if(defined($arg{os}) and $arg{os}=~/\d/) {
#        $sql.="
#            and (m.os_id=".$arg{os}." or m.os_id is null)
#        ";
#    #} else {
#    #    $sql.="
#    #        and m.os_id is null
#    #    ";
#    }
#    if(defined($arg{ma})) {
#        $sql.="
#            and (
#                m.monaccess_id=".$arg{ma}." 
#                or m.monaccess_id is null
#                or m.monaccess_id=4
#            )
#        ";
##    } else {
##        $sql.="
##            and (
##                m.monaccess_id is null
##                or m.monaccess_id=4
##                or m.monaccess_id=1
##            )
##        ";
#    }
##    $sql.="
##        order by
##            m.preference
##    ";
#    $sql=~s/where\s*and/where\n            /;
#    $sql=~s/where\s*$//;
##    my($st)=$self->{req}->{db}->{dbh}->prepare($sql) or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->monitors dbh->prepare failed. ".$!);
##    $st->execute or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->monitors sth->execute failed. ".$!);
##    my($row,$res);
##    while($row=$st->fetchrow_hashref) {
##        push(@{$res},$row);
##    }
##    $res or return;
##    wantarray()?return(@{$res}):return($res);
##    $self->{req}->{db}->{dbh}->selectall_hashref($sql,"id") or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->monitors SQL-Query failed: ".$sql);
#
#    return $self->{req}->{db}->hashref($sql);
#}
#
#sub hostmonitor_list { my$self=shift;
#    # desc: Return a list of monitors to determine host stati
#    # expects: req d?
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monitor_list needs a req.") unless defined($self->{req});
#
#    my($sql)="
#        select
#            m.id,
#            m.name
#        from
#            monitor m,
#            deviceatribut da,
#    ";
#    if(defined($arg{d}) && $arg{d}=~/\d/) {
#        $sql.="
#            device d,
#            monaccess ma,
#        ";
#    }
#    $sql.="
#        where
#            m.deviceatribut_id=da.id
#            and da.name like 'up'
#    ";
#    if(defined($arg{d}) && $arg{d}=~/\d/) {
#        $sql.="
#            and ma.name like 'direct'
#            and d.id=".$arg{d}."
#            and (
#                d.monaccess_id=m.monaccess_id
#                or m.monaccess_id is null
#                or m.monaccess_id=ma.id
#            )
#        ";
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->hostmonitor_list SQL-Query: ".$sql."\n");
#
#    return $self->{req}->{db}->hashref($sql);
#}

sub uniq { my$self=shift;
    # expects: a list
    # returns: a list of uniq values
    my($val,%data);
    foreach $val (@_) {
        $data{$val}++;
    }
    keys(%data);
}

sub default { my$self=shift;
    # expects: req what id
    # returns: hashref
    my(%arg)=@_;
    $debug && print STDERR __PACKAGE__."->default got called with ".join(",",%arg).".\n";
    $self->faultt(msg=>__PACKAGE__."->default needs a req.") unless defined($self->{req});
    
    my($obj)=defined($arg{obj})?$arg{obj}:PerlForms::Dict::Object->new(%arg);
    my(%dbfields)=$obj->dbfields;
    $debug>4 && print(STDERR
        __PACKAGE__."->default got dbfields: ".join(",",%dbfields),
        " for ".$obj->what."\n"
    );
    
    my(@select)=(
        $obj->idattrib.".id",
        $obj->idattrib.".id ".$obj->idattrib
    );
    
    my(@from)=($obj->tablename." ".$obj->idattrib);
    
    $arg{id}=$arg{$obj->idattrib}
    unless(defined($arg{id}) or !defined($arg{$obj->idattrib}));
    my%where;
    %where=($obj->idattrib.".id"=>$arg{"id"}) if(defined($arg{id}));

    $debug>=2 && print STDERR __PACKAGE__."->default: \%where=(".join(",",%where).")\n"; 
    
    my%fk_obj;
    while(my($field,$dbfield)=each(%dbfields)) {
        next unless(defined($dbfield) and $dbfield ne "none");
        push(@select,$obj->idattrib.".".$dbfield." ".$field);
        next unless($field ne "freshness");
        if(defined($arg{$field})) {
            if($obj->attribtype($field) eq "ipaddress") {
                $where{$obj->idattrib.".".$dbfield}=$self->ip2int($arg{$field});
            } else {
                $where{$obj->idattrib.".".$dbfield}=$arg{$field};
            }
        }
        
        ## foreign-keys auflösen
        if($self->{req}->dict->is_idattrib($field) and $field ne $obj->idattrib) {
            $fk_obj{$field}=$self->{req}->newobj(idattrib=>$field);
            push(@from,"left outer join ".$fk_obj{$field}->tablename." ".$fk_obj{$field}->idattrib." on ".$fk_obj{$field}->idattrib.".id=".$obj->idattrib.".".$dbfield);
            if(defined($fk_obj{$field}->attribs->{"name"}) and defined($fk_obj{$field}->dbfield("name")) and $fk_obj{$field}->dbfield("name") ne "none") {
                push(@select,$fk_obj{$field}->idattrib.".name ".$fk_obj{$field}->what);
            } elsif(@{$fk_obj{$field}->nameattrib}) {
                foreach my$nameattrib (@{$fk_obj{$field}->nameattrib}) {
                    if($self->{req}->dict->is_what($nameattrib)) {
                        my$fkfkobj=$self->{req}->newobj(what=>$nameattrib);
                        push(@select,$fk_obj{$field}->idattrib.".".$fk_obj{$field}->dbfield($fkfkobj->idattrib)." ".$fkfkobj->idattrib);
                        push(@select,$fkfkobj->idattrib.".name ".$fkfkobj->what);
                        push(@from,"left outer join ".$fkfkobj->tablename." ".$fkfkobj->idattrib." on ".$fkfkobj->idattrib.".id=".$fk_obj{$field}->idattrib.".".$fk_obj{$field}->dbfield($fkfkobj->idattrib));
                    } else {
                        push(@select,$fk_obj{$field}->idattrib.".".$fk_obj{$field}->dbfield($nameattrib)." ".$nameattrib);
                    }
                }
            }
        }
    }
#    
#    $debug>=2 && print STDERR __PACKAGE__."->default: \%where=(".join(",",%where).")\n"; 
#    
#    my($sql)=$self->{req}->{db}->sql_builder(\@select,\@from,\%where);
    unless(defined $arg{thing}) {
        $arg{thing}=$self->{req}->things($obj->what);
    }
    my$sql=$arg{thing}->storage->{db}->sql_builder(\@select,\@from,\%where);
    
    $debug && print(STDERR __PACKAGE__."->default: SQL-Query: ".$sql."\n");
    
    unless($sql=~/\s*where\s*/) {
        warn(__PACKAGE__."->default: No criterias for ".$obj->what." in query. Need criteria (caller: ".caller()."). returning undef.\n");
        return undef;
    }

#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($self->{req}->{db}->tidy($sql))
#        or warn(__PACKAGE__."->default: SQL-Query failed: ".$sql."\n".$!."\n");
    my($data)=$self->{req}->things($obj->what)->storage->{db}->{dbh}->selectrow_hashref(
        $self->{req}->things($obj->what)->storage->{db}->tidy($sql)
    ) or warn(__PACKAGE__."->default: SQL-Query failed: ".$sql."\n".$!."\n");
#
    ## seit 26.09.2008: im perl-code werden ip-adr in int-format verar-
    ## beitet, erst bei der Anzeige werden sie in lesbare IP-Adr. umge-
    ## wandelt.
#    while(my($field,$dbfield)=each(%dbfields)) {
#        next unless(defined($dbfield) and $dbfield ne "none" and $field ne "freshness");
#        if(defined($data->{$field})) {
#            if($obj->attribtype($field) eq "ipaddress") {
#                $data->{$field}=$self->int2ip($data->{$field});
#            }
#        }
#    }

    if(!defined($dbfields{"name"}) and @{$obj->nameattrib}) {
        foreach my$nameattrib (@{$obj->nameattrib}) {
            $data->{"name"}.=": ".$data->{$nameattrib} if(defined($data->{$nameattrib}));
        }
        $data->{"name"}=~s/^:\s*//g;
        $data->{$obj->what}=$data->{"name"}
    }
        
    $debug>=3 && print STDERR __PACKAGE__."->default: result: ".join(", ",%$data)."\n";
        
    return ref($data)?$data:{};
}

sub default_list { my$self=shift;
    # expects: req what id
    # returns: hashref
    my(%arg)=@_;
    $debug && print STDERR __PACKAGE__."->default_list got called with ".join(",",%arg)."\n";
    $self->faultt(msg=>__PACKAGE__."->default_list needs a req.") unless defined($self->{req});
    
    my($obj)=defined($arg{obj})?$arg{obj}:new PerlForms::Dict::Object(%arg);
    my(%dbfields)=$obj->dbfields;
#    print STDERR __PACKAGE__."->default_list: dbfields: ".join(",",%dbfields)."\n";
    
    my(@select)=(
        $obj->idattrib.".id",
        $obj->idattrib.".id ".$obj->idattrib
    );

    my(@from)=($obj->tablename." ".$obj->idattrib);
    my%from=($obj->tablename=>$obj->tablename." ".$obj->idattrib);
    my(%where);
    my%fk_obj;
    while(my($field,$dbfield)=each(%dbfields)) {
        next unless(defined($dbfield));
        
        $debug && print STDERR __PACKAGE__."->default_list: building SQL query: attrib: ".$field.", dbattrib: ".$dbfield."\n";
        
        ## select
        push(@select,$obj->idattrib.".".$dbfield." ".$field);
        
        ## wenn field eine ID einer anderen Klasse ist (also ein foreign-key)
        if($self->{req}->dict->is_idattrib($field) and $field ne $obj->idattrib) {# and $dbfield=~/^([^_]+)_id$/) {
#            
#            print STDERR $field." is an idattrib.\n";
            
            ## fk auflösen
            my$fkobj=$self->{req}->newobj(what=>$self->{req}->dict->idattrib2what($field));
            
            my$nameattribs=$fkobj->nameattrib;
#            if(!@$nameattribs and defined($fkobj->attribs->{$fkobj->what})) {
#                $nameattribs=[$fkobj->what]
#            }
            ## wenn es so scheint als nameattribs hier ignoriert würden, dann ist
            ## mglw. eine dedizierte Query-sub für dieses what definiert.
#            print STDERR __PACKAGE__."->default_list: nameattribs: ".join(",",@$nameattribs)."\n";
            if(@$nameattribs) {
                foreach my$nameattrib (@{$fkobj->nameattrib}) {
                    if(defined($fkobj->attribs->{$nameattrib})) {
                        ## wenn die referenzierte klasse selbst das attribut hat...
                        push(@select,$fkobj->idattrib.".".$fkobj->dbfield($nameattrib)." ".$nameattrib);
                        unless(defined $from{$fkobj->tablename." ".$fkobj->idattrib}) {
                            push(@from,"left outer join ".$fkobj->tablename." ".$fkobj->idattrib." on ".$fkobj->idattrib.".id=".$obj->idattrib.".".$dbfield);
                            $from{$fkobj->tablename." ".$fkobj->idattrib}="left outer join ".$fkobj->tablename." ".$fkobj->idattrib." on ".$fkobj->idattrib.".id=".$obj->idattrib.".".$dbfield;
                        }
                    } elsif($self->{req}->dict->is_what($nameattrib)) {
                        ## wenn die referenzierte klasse das attribut nur indirekt über eine wiederum referenzierte klasse kennt
                        my$fkfkobj=$self->{req}->newobj(what=>$nameattrib);
                        push(@select,$fkfkobj->idattrib.".name ".$nameattrib);
                        unless(defined $from{$fkobj->tablename." ".$fkobj->idattrib}) {
                            push(@from,"left outer join ".$fkobj->tablename." ".$fkobj->idattrib." on ".$fkobj->idattrib.".id=".$obj->idattrib.".".$dbfield);
                            $from{$fkobj->tablename." ".$fkobj->idattrib}="left outer join ".$fkobj->tablename." ".$fkobj->idattrib." on ".$fkobj->idattrib.".id=".$obj->idattrib.".".$dbfield;
                        }
                        unless(defined $from{$fkfkobj->tablename." ".$fkfkobj->idattrib}) {
                            push(@from,"left outer join ".$fkfkobj->tablename." ".$fkfkobj->idattrib." on ".$fkfkobj->idattrib.".id=".$fkobj->idattrib.".".$fkobj->dbfield($fkfkobj->idattrib));
                            $from{$fkfkobj->tablename." ".$fkfkobj->idattrib}="left outer join ".$fkfkobj->tablename." ".$fkfkobj->idattrib." on ".$fkfkobj->idattrib.".id=".$fkobj->idattrib.".".$fkobj->dbfield($fkfkobj->idattrib);
                        }
                    }
                }
            } else {
                ## wenn es so scheint als nameattribs hier ignoriert würden, dann ist
                ## mglw. eine dedizierte Query-sub für dieses what definiert.
                warn(__PACKAGE__."->default_list: no nameattribs for ".$fkobj->what."; but: ".join(",",keys(%{$fkobj->dict}))."\n");
                push(@select,$fkobj->idattrib.".name ".$fkobj->what);
                push(@from,"left outer join ".$fkobj->tablename." ".$fkobj->idattrib." on ".$fkobj->idattrib.".id=".$obj->idattrib.".".$dbfield);
            }
            $fk_obj{$field}=$fkobj;
        }
        
        ## where
        if($field ne "freshness" and defined($arg{$field})) {
            if(
                $field=~/^tstamp/ 
                and $arg{$field}=~/(\d{1,2})\.(\d{1,2})\.(\d{1,4}) (\d{1,2}):(\d{1,2}):(\d{1,2})/
            ) {
#                $debug && print(STDERR __PACKAGE__."->default_list formatting tstamp ".$arg{$field}." ...\n");
                $arg{$field}=timelocal($6,$5,$4,$1,($2-1),($3-1900));
            }
            $where{$dbfield}=$arg{$field};
        }
#        $debug && print STDERR __PACKAGE__."->default_list: building SQL query: ".$field." is done.\n";
    }

#    print STDERR "here we go...\n";
    my$req=$self->{req};
    die("No req.") unless(defined($req));
#    print STDERR "req is good.\n";
    die("No obj.") unless(defined($obj));
#    print STDERR "obj is good.\n";
    my$thing=$self->{req}->things($obj->what);
    die("No thing.") unless(defined($thing));
#    print STDERR "thing is good: ".ref($thing)."\n";
    my$storage=$self->{req}->things($obj->what)->storage;
#    print STDERR "storage is back: ".ref($storage)." \n";
#    print(STDERR "storage is defined.\n") if(defined($storage));
    die("No storage.") unless(defined($storage));
#    print STDERR "storage is good.\n";
    my$db=$self->{req}->things($obj->what)->storage->{db};
    die("No db.") unless(defined($db));
#    print STDERR "db is good.\n";
#    
#    print STDERR "letz do some sql-putting-together...\n";
    
    my($sql)=$self->{req}->things($obj->what)->storage->{db}->sql_builder(\@select,\@from,\%where);
    
    die("No sql.") unless(defined($sql));
    
    $debug && print(STDERR __PACKAGE__."->default_list: SQL-Query: ".$sql."\n");

#    my($data)=$self->{req}->{db}->hashref($self->{req}->{db}->tidy($sql))
#        or warn(__PACKAGE__."->default_list: SQL-Query failed: ".$sql."\n".$!."\n");
    my($data)=$self->{req}->things($obj->what)->storage->{db}->hashref(
        $self->{req}->things($obj->what)->storage->{db}->tidy($sql)
    ) or warn(__PACKAGE__."->default_list: SQL-Query failed: ".$sql."\n".$!."\n");
        
    $debug && print STDERR __PACKAGE__."->default_list: found ".keys(%$data)." records.\n";
    
    my$jd=0; ## einträge ohne name erhalten eine nummer.
#    print(STDERR "--------------------------->>>>> ".@{$obj->nameattrib}.": (".join(",",@{$obj->nameattrib})."\n");
    if(@{$obj->nameattrib}) {
        while(my($key,$rec)=each(%$data)) {
            ## wenn der erste record einen name enhält, haben auch alle anderen einen, also diese schleife beenden.
            last if defined $rec->{"name"};
            
            my$name;
            foreach my$nameattrib (@{$obj->nameattrib}) {
                $name.=": ".$rec->{$nameattrib} if defined $rec->{$nameattrib};
            }
            $name="jd".$jd++ unless(defined $name);
            $name=~s/^:\s*//g;
            $name=$rec->{id} unless defined $name;
            $data->{$key}->{"name"}=$name;
            $data->{$key}->{$obj->what}=$name;
            
            ## für jeden im rec enthaltenen fk den namen bauen - nötigenfalls
            while(my($key,$fkobj)=each(%fk_obj)) {
#                my$nameattribs=$fkobj->nameattrib;
                if(@{$fkobj->nameattrib}) {
                    foreach my$nameattrib (@{$fkobj->nameattrib}) {
                        $rec->{$fkobj->what}.=": ".$rec->{$nameattrib} if(defined($rec->{$nameattrib}));
                    }
                    $rec->{"name"}=$rec->{$fkobj->what};
                    $rec->{$fkobj->what}=~s/^: //g;
                }
            }
        }
    }
#    
#    my@test=%$data;
#    print STDERR "*+*+*+* ".join(",",%{$test[1]})."\n";
        
    return ref($data)?$data:{};
}
#
#sub requirement2requirements_list { my$self=shift;
#    my(%arg)=@_;
#    
#    $arg{r1}=$arg{r} unless defined $arg{r1};
#    
#    my$sql;
#    $sql="
#        select
#            rr.id,
#            rr.id rr,
#            r1.id r1,
#            r1.name requirement1,
#            r2.id r2,
#            r2.name requirement2
#        from
#            requirement2requirements rr,
#            requirement r1,
#            requirement r2
#        where
#            rr.requirement2_id=r2.id
#            and rr.requirement1_id=r1.id
#    ";
#
#    if(defined($arg{r1})) {
#        $sql.="
#            and rr.requirement1_id=".$arg{r1}."
#        ";
#    }
#
#    return $self->{req}->{db}->hashref($sql);
#}
#
#sub requirement2devices { my$self=shift;
#    # expects: req id
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__." needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"requirement2devices");
#    $arg{id}=$arg{$obj->idattrib} unless defined($arg{id});
#    my($sql)="
#        select
#            ".$obj->idattrib.".id,
#            ".$obj->idattrib.".requirement_id r,
#            ".$obj->idattrib.".device2deviceatribute_id dd,
#            ".$obj->idattrib.".notes notes,
#            req.name
#        from
#            requirement2devices rd,
#            requirement req,
#    ";
#    if($arg{d}) {
#        $sql.="
#            device2deviceatribute dd,
#        ";
#    }
#    $sql.="
#        where
#            rd.requirement_id=req.id
#    ";
#    if(defined($arg{id})) {
#        $sql.="
#            and rd.id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{dd})) {
#        $sql.="
#            and rd.device2deviceatribute_id=".$arg{dd}."
#        ";
#    }
#    if(defined($arg{r})) {
#        $sql.="
#            and rd.requirement_id='".$arg{r}."'
#        ";
#    }
#    if(defined($arg{d})) {
#        $sql.="
#            and rd.device2deviceatribute_id=dd.id
#            and dd.device_id=".$arg{d}."
#        ";
#    }
#    $sql=~s/\n\s*\n\*/\n            /g;
#    $sql=~s/where\s+and/where/g;
#    $sql=~s/,\s*where/\n        where/g;
##    print STDERR "SQL_Query: ".$sql."\n";
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->requirement2devices SQL-Query failed: ".$sql."\n".$!);
#
#    return $data?$data:{};
#}
#
#sub requirement2ways { my$self=shift;
#    # expects: req rw
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->requirement2ways needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"requirement2ways");
#    $arg{id}=$arg{$obj->idattrib} unless defined($arg{id});
#    my($sql)="
#        select
#            rw.id,
#            rw.requirement_id r,
#            rw.way_id w,
#            rw.notes notes,
#            r.name
#        from
#            requirement2ways rw,
#            requirement r,
#    ";
#    $sql.="
#        where
#            rw.requirement_id=r.id
#    ";
#    if(defined($arg{id})) {
#        $sql.="
#            and rw.id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{w})) {
#        $sql.="
#            and rw.way_id=".$arg{w}."
#        ";
#    }
#    if(defined($arg{r})) {
#        $sql.="
#            and rw.requirement_id=".$arg{r}."
#        ";
#    }
#    $sql=~s/\n\s*\n\*/\n            /g;
#    $sql=~s/where\s+and/where/g;
#    $sql=~s/,\s*where/\n        where/g;
##    print STDERR "SQL_Query: ".$sql."\n";
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->requirement2ways SQL-Query failed: ".$sql."\n".$!);
#
#    return $data?$data:{};
#}
#
#sub requirement2devices_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->requirement2devices_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"requirement2devices");
#    my($abk)=$obj->idattrib;
#    
#    $debug && print STDERR __PACKAGE__."->r2d_list \$arg{r}: ".$arg{r}."\n" if $arg{r};
#    
##            concat(r.name,':',d.name,':',da.name,':',dd.parameter) requirement2devices,
##            concat(r.name,':',d.name,':',da.name,':',dd.parameter) name,
#    my($sql)="
#        select
#            ".$abk.".id ".$abk.",
#            ".$abk.".id id,
#            rd.requirement_id r,
#            rd.notes notes,
#            r.name requirement,
#            dd.id dd,
#            d.id d,
#            d.name device,
#            da.name deviceatribut,
#            da.prefix prefix,
#            dd.parameter parameter,
#            da.id da
#        from
#            ".$obj->tablename." ".$abk.",
#            device2deviceatribute dd,
#            device d,
#            deviceatribut da,
#            requirement r
#        where
#    ";
#    if(defined($arg{d}) and $arg{d}=~/\d/) {
#        $sql.="        and dd.device_id=".$arg{d};
#    }
#    if(defined($arg{da}) and $arg{da}=~/\d/) {
#        $sql.="        and dd.deviceatribut_id=".$arg{da};
#    }
#    if(defined($arg{dd}) and $arg{dd}=~/\d/) {
#        $sql.="        and dd.id=".$arg{dd};
#    }
#    $sql.="
#           and dd.device_id=d.id 
#           and dd.deviceatribut_id=da.id
#           and rd.device2deviceatribute_id=dd.id
#           and rd.requirement_id=r.id
#    ";
#    if(defined($arg{r})) {
#        $sql.="
#            and rd.requirement_id=".$arg{r}."
#        ";
#    }
#    $sql=~s/,\s*where/\n        where/;
#    $sql=~s/where\s*and/where\n    /g;
#
#    $debug && print STDERR __PACKAGE__."->r2d_list SQL-Query: ".$sql."\n";
#    $debug && print STDERR __PACKAGE__."->r2d_list getting data from db...\n";
#
#    my(%data,$rec);
#    my($sth)=$self->{req}->{db}->{dbh}->prepare($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->requirement2devices_list dbh->prepare failed. ".$!);
#
#    $sth->execute
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->requirement2devices_list sth->execute failed. ".$!);
#    
#    $debug && print STDERR __PACKAGE__."->r2d_list SQL returned ".$sth->rows." records.\n";
#
#    while($rec=$sth->fetchrow_hashref) {
#        my($key)=$self->service_description(%$rec);
#        $rec->{device2deviceatribute}=$rec->{device}.": ".$key;
#        $rec->{$obj->what}=$rec->{requirement}.": ".$rec->{device2deviceatribute};
#        $rec->{name}=$key;
#        $key=$rec->{requirement}.$rec->{device}.$key.$rec->{id};
#        $data{$key}=$rec;
#    }
#
#    $debug && print STDERR __PACKAGE__."->r2d_list first line of date to be returned: ".join("=>'",each(%data))."'\n";
#    $debug && print STDERR __PACKAGE__."->r2d_list done.\n";
#
#    return %data?\%data:{};
#}
#
#sub requirement2ways_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->requirement2ways_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"requirement2ways");
#    
#    $debug && print STDERR "Query::requirement2ways_list \$arg{r}: ".$arg{r}."\n" if $arg{r};
#    
#    my($sql)="
#        select
#            rw.id rw,
#            rw.id id,
#            rw.requirement_id r,
#            rw.notes notes,
#            r.name requirement,
#            w.id w
#        from
#            requirement2ways rw,
#            way w,
#            requirement r
#        where
#    ";
#    if(defined($arg{w}) and $arg{w}=~/\d/) {
#        $sql.="and rw.way_id=".$arg{w};
#    }
#    if(defined($arg{r}) and $arg{r}=~/\d/) {
#        $sql.="and rw.requirement_id=".$arg{r};
#    }
#    $sql.="
#           and rw.way_id=w.id
#           and rw.requirement_id=r.id
#    ";
#    $sql=~s/,\s*where/\n        where/;
#    $sql=~s/where\s*and/where /g;
#
#    $debug && print STDERR __PACKAGE__."->requirement2ways_list getting data from db...\n";
#
#    my($data)=$self->{req}->{dbh}->hashref($sql);
#
#    return $data?\$data:{};
#}
#
#sub monitoreddeviceatribute_list { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->monitoreddeviceatribute_list needs a req.") unless defined($self->{req});
##        select
##            d.name device,
##            d.monaccess_id ma,
##            d.os_id o,
##            dd.notes notes,
##            b.name pfuser,
##            b.emailaddr emailaddr,
##            tspt.id tspt,
##        from
##            left outer join benutzer b on b.id=d.benutzer_id
##            left outer join port tspt on tspt.id=d.terminalserverport_id,
##            service s
##        where
##            s.id=sf.service_id
##        group by
##            d.name,
##            rd.id,
##            d.monaccess_id,
##            d.os_id
#    my($sql)="
#        select
#            dd.id dd,
#            da.prefix prefix,
#            dd.parameter parameter,
#            da.id da,
#            da.check_interval,
#            da.retry_check_interval,
#            da.max_check_attempts
#        from
#            device d,
#            deviceatribut da,
#            device2deviceatribute dd,
#            requirement2devices rd,
#            functionality2requirements fr,
#            service2functionalities sf
#        where
#            sf.functionality_id=fr.functionality_id
#            and fr.requirement_id=rd.requirement_id
#            and rd.device2deviceatribute_id=dd.id
#            and dd.device_id=d.id
#            and dd.deviceatribut_id=da.id
#            and (d.monaccess_id<>6 or d.monaccess_id is null)
#     ";
#     if(defined($arg{d}) and $arg{d}=~/\d/) {
#         $sql.="
#            and dd.device_id=".$arg{d}."
#         ";
#     }
#     $sql.="
#        group by
#            da.prefix,
#            dd.parameter,
#            da.id
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'dd') or die($!);
#}
#
#sub monitoredrequirements { my$self=shift;
#    my(%arg)=@_;
#    
#    $self->faultt(msg=>__PACKAGE__."->monitoreddevices needs a req.")
#    unless defined($self->{req}) or defined($arg{ui});
#    
#    my($sql)="
#        select
#            r.id,
#            r.id r,
#            r.name name,
#            r.name requirement
#        from
#            service s,
#            service2functionalities sf,
#            functionality2requirements fr,
#            requirement r
#        where
#            s.id=sf.service_id
#            and sf.id=fr.service2functionalities_id
#            and fr.requirement_id=r.id
#        group by
#            r.id,
#            r.name
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'r')
#    or $self->faultt(%arg,msg=>__PACKAGE__."->monitoreddevices: SQL-Query failed. ".$!);
#}
#
#sub dependingrequirements { my$self=shift;
#    # expects: req data
#    # returns: nothing, but writes into the result hashref given as an argument
#    my(%arg)=@_;
#    
#    $self->faultt(msg=>__PACKAGE__."->dependingrequirements needs a req.")
#    unless defined($self->{req}) or defined($arg{ui});
#    
#    ## depth legt fest, wieviele ebenen tief Abhängigkeiten verfolgt werden
#    $arg{depth}=10 unless defined $arg{depth};
#    
#    my($sql)="
#        select
#            rr.requirement2_id r
#        from
#            requirement2requirements rr
#        where
#            rr.requirement1_id=".$arg{r}."
#        group by
#            rr.requirement2_id
#    ";
#    my$data=$self->{req}->{db}->{dbh}->selectall_hashref($sql,"r")
#    or $self->faultt(%arg,msg=>__PACKAGE__."->dependingrequirements: SQL-Query failed. ".$!);
#    
#    $debug && print STDERR __PACKAGE__."->dependingrequirements found ".keys(%$data)." records.\n";
#    
#    ## todo w color wird unsauber gestzt (z.B. bei f2r->form)
#    
#    ## schreibe jeden gefundenen record in $arg{data}, und rufe für jeden ge-
#    ## fundenen record dependingrequirements nochmal auf, welches wiederum je-
#    ## den gefundenen record in $arg{data} schreibt.
#    while(my($key,$rec)=each(%$data)) {
#        ## $arg{data}: key is the requirement-id, alias 'r2', value is the rec
#        next if defined $arg{data}->{$rec->{r}};
#        $arg{data}->{$rec->{r}}=$rec;
##        my$requirement_rec=$self->guess(req=>$self->{req},what=>"requirement",r=>$rec->{r});
##        $arg{data}->{$rec->{r}}=$requirement_rec;
#        next unless $arg{depth}>0;
#        $self->dependingrequirements(
#            req=>$self->{req},
#            depth=>--$arg{depth},
#            r=>$rec->{r},
#            data=>$arg{data}
#        );
#    }
#    
##    return $arg{data} if(defined(wantarray));
#}
#
#sub monitoreddependingrequirements { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    
#    ## 1. suche alle relevanten requirements
#    my$requirements=$self->monitoredrequirements(%arg);
#    $debug && print STDERR __PACKAGE__."->monitoreddependingrequirements: got ".keys(%$requirements)." monitored requirements.\n";
#    
#    ## 2. dann deren abhängikeiten
#    while(my($key,$rec)=each(%$requirements)) {
##        next if defined $requirements->{$rec->{r}}; ## ist doch blödzing!=
#        $requirements->{$rec->{r}}=$rec;
#        ## depth folgend nicht angegeben, somit wird im ersten durchlauf der default 10 verwendet.
#        $self->dependingrequirements(
#            req=>$self->{req},
#            r=>$rec->{r},
#            data=>$requirements
#        );
#    }
#    
#    $requirements
#}
#
#sub monitoreddevices { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    
#    $self->faultt(msg=>__PACKAGE__."->monitoreddevices needs a req.")
#    unless defined($self->{req}) or defined($arg{ui});
#    
#    ## 1. suche alle relevanten requirements
##    my$requirements=$self->monitoredrequirements(%arg);
#    my$requirements=$self->monitoreddependingrequirements(%arg);
#    $debug && print STDERR __PACKAGE__."->monitoreddevices: got ".keys(%$requirements)." monitored requirements.\n";
##    
##    ## 2. dann deren abhängikeiten
##    while(my($key,$rec)=each(%$requirements)) {
##        next if defined $requirements->{$rec->{r}};
##        $requirements->{$rec->{r}}=$rec;
##        ## depth folgend nicht angegeben, somit wird im ersten durchlauf der default 10 verwendet.
##        $self->dependingrequirements(
##            req=>$self->{req},
##            r=>$rec->{r},
##            data=>$requirements
##        );
##    }
#    
#    ## 3. jetzt suche die devices zu allen gefundenen requirements.
#    my($sql)="
#        select
#            d.id d,
#            d.name name,
#            d.ipaddress,
#            d.os_id o,
#            d.monaccess_id ma,
#            m2.name monitor,
#            os.name os
#        from
#            device d
#            left outer join monitor m2 on m2.id=d.monitor_id
#            left outer join os on os.id=d.os_id,
#            requirement2devices rd,
#            device2deviceatribute dd
#        where
#            rd.requirement_id=?
#            and rd.device2deviceatribute_id=dd.id
#            and dd.device_id=d.id
#            and (d.monaccess_id<>6 or d.monaccess_id is null)
#        group by
#            d.name,
#            d.ipaddress,
#            m2.name
#    ";
#    my$sth=$self->{req}->{db}->{dbh}->prepare($sql)
#    or warn(__PACKAGE__."->monitoreddevices: dbh->prepare failed. (".$!.")\nSQL-Query: ".$sql."\n");
#    
#    my$result={};
#    while(my($key,$rec)=each(%$requirements)) {
#        unless($sth->execute($rec->{r})) {
#            warn(__PACKAGE__."->monitoreddevices: sth->execute failed: ".$!.". (r=".$rec->{r}.")\n");
#            next;
#        }
#        while(my$device=$sth->fetchrow_hashref) {
#            $result->{$device->{name}}=$device unless defined $result->{$device->{name}};
#            $result->{$device->{name}}->{requirements}.=$rec->{r}.", ";
#        }
#    }
#    
#    ## 4. deviceclasses
#    my$deviceclass_list=$self->monitoreddeviceclasses(req=>$self->{req},requirement_list=>$requirements);
#    print STDERR "Got ".keys(%$deviceclass_list)." device classes.\n";
#    $sql="
#        select
#            d.id d,
#            d.name name,
#            d.ipaddress,
#            d.os_id o,
#            d.monaccess_id ma,
#            m2.name monitor,
#            os.name os
#        from
#            device d
#            left outer join monitor m2 on m2.id=d.monitor_id
#            left outer join os on os.id=d.os_id
#        where
#            d.deviceclass_id=?
#        group by
#            d.name,
#            d.ipaddress,
#            m2.name
#    ";
##            and (d.monaccess_id<>6 or d.monaccess_id is null)
#    $sth=$self->{req}->{db}->{dbh}->prepare($sql)
#    or warn(__PACKAGE__."->monitoreddevices: dbh->prepare failed. (".$!.")\nSQL-Query: ".$sql."\n");
#    
#    while(my($key,$rec)=each(%$deviceclass_list)) {
#        unless($sth->execute($rec->{dc})) {
#            warn(__PACKAGE__."->monitoreddevices: sth->execute failed: ".$!.". (dc=".$rec->{dc}.")\n");
#            next;
#        }
#        while(my$device=$sth->fetchrow_hashref) {
#            ## vererbung
#            foreach my$attrib ("o","ma","monitor") {
#                unless(defined($device->{$attrib}) and $device->{$attrib}=~/\w/) {
#                    $device->{$attrib}=$rec->{$attrib}
#                }
#            }
#            
#            $result->{$device->{name}}=$device unless defined $result->{$device->{name}};
#            $result->{$device->{name}}->{deviceclasses}.=$rec->{deviceclass}.", ";
#            $result->{$device->{name}}->{requirements}.=$rec->{requirements}.", ";
#        }
#    }
#    
#    ## 5. und gib sie zurück
#    $result
#}
#
#sub monitoreddeviceclasses { my$self=shift;
#    # expects: requirement_list req
#    my%arg=@_;
#    
#    my$sql="
#        select
#            dc.id dc,
#            dc.name,
#            dc.name deviceclass,
#            dc.os_id o,
#            dc.monaccess_id ma,
#            m2.name monitor,
#            os.name os
#        from
#            deviceclass dc
#            left outer join monitor m2 on m2.id=dc.monitor_id
#            left outer join os on os.id=dc.os_id,
#            deviceclass2deviceatribute dcda,
#            requirement2deviceclasses rdc
#        where
#            rdc.requirement_id=?
#            and rdc.deviceclass2deviceatribute_id=dcda.id
#            and dcda.deviceclass_id=dc.id
#        group by
#            dc.id,
#            dc.name,
#            dc.os_id,
#            dc.monaccess_id,
#            m2.name
#    ";
#    my$sth=$self->{req}->{db}->{dbh}->prepare($sql)
#    or warn(__PACKAGE__."->monitoreddevices: dbh->prepare failed. (".$!.")\nSQL-Query: ".$sql."\n");
#    
#    my$result={};
#    while(my($key,$rec)=each(%{$arg{requirement_list}})) {
#        unless($sth->execute($rec->{r})) {
#            warn(__PACKAGE__."->monitoreddeviceclasses: sth->execute failed: ".$!.". (r=".$rec->{r}.")\n");
#            next;
#        }
#        while(my$deviceclass_rec=$sth->fetchrow_hashref) {
#            $result->{$deviceclass_rec->{name}}=$deviceclass_rec unless defined $result->{$deviceclass_rec->{name}};
#            $result->{$deviceclass_rec->{name}}->{requirements}.=$rec->{requirement}.", ";
#        }
#    }
#    
#    $result
#}
#
#
#sub monitoredinterfaces { my$self=shift;
#    my(%arg)=@_;
#    
#    my($sql)="
#        select
#            i.id i, 
#            i.name,
#            i.address
#        from
#            interface i,
#            way w,
#            requirement2ways rw,
#            functionality2requirements fr,
#            service2functionalities sf
#        where
#            sf.functionality_id=fr.functionality_id
#            and fr.requirement_id=rw.requirement_id
#            and rw.way_id=way.id
#            and w.interface1_id=i.id
#    ";
#    my($data1)=$self->{req}->{db}->hashref($sql);
#    
#    $sql="
#        select
#            i.id i, 
#            i.name,
#            i.address
#        from
#            interface i,
#            way w,
#            requirement2ways rw,
#            functionality2requirements fr,
#            service2functionalities sf
#        where
#            sf.functionality_id=fr.functionality_id
#            and fr.requirement_id=rw.requirement_id
#            and rw.way_id=way.id
#            and w.interface2_id=i.id
#    ";
#    my($data2)=$self->{req}->{db}->hashref($sql);
#    
##    push(%$data1,%$data2);
#    my($key,$rec,$result);
#    while(($key,$rec)=each(%$data1)) {
#        $result->{$rec->{name}.$rec->{i}}=$rec;
#    }
#    while(($key,$rec)=each(%$data2)) {
#        $result->{$rec->{name}.$rec->{i}}=$rec;
#    }
#    
#    $result;
#}
#
#sub infrastructuremonitors { my$self=shift;
#    my(%arg)=@_;
#
#    $self->faultt(msg=>__PACKAGE__."->infrastructuremonitors needs a req.")
#        unless defined($self->{req});
#
#    my($sql)="
#        select
#            m.name,
#            m.command_line
#        from
#            monitor m,
#            device2deviceatribute dd,
#            requirement2devices rd,
#            functionality2requirements fr,
#            service2functionalities sf
#        where
#            m.deviceatribut_id=dd.deviceatribut_id
#            and dd.id=rd.device2deviceatribute_id
#            and rd.requirement_id=fr.requirement_id
#            and fr.functionality_id=sf.functionality_id
#        group by
#            m.name,
#            m.command_line
#        order by
#            m.name,
#            m.command_line
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'name') or die($!);
#}
#
#sub hostmonitors { my$self=shift;
#    # desc: alle verw. host-monitore
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->hostmonitors needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            m.name,
#            m.command_line
#        from
#            monitor m,
#            device d
#        where
#            m.id=d.monitor_id
#        group by
#            m.name,
#            m.command_line
#        order by
#            m.name,
#            m.command_line
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'name') or die($!);
#}
#
#sub spmonitors_hosts { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->spmonitors_hosts needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            s.name service,
#            c.name kunde,
#            spm.ipaddress
#        from
#            service s,
#            kunde c,
#            servicepoint sp,
#            servicepoint2monitors spm
#        where
#            s.id=sp.service_id
#            and c.id=sp.kunde_id
#            and sp.id=spm.servicepoint_id
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'service') or die($!);
#}
#
#sub spmonitors_services { my$self=shift;
#    # returns: arrayref of hashrefs
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->spmonitors_services needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            da.prefix prefix,
#            s.name service,
#            c.name kunde,
#            ml.name monlevel,
#            m.name monitor
#        from
#            deviceatribut da,
#            monitor m,
#            loesung2monitore lm,
#            feature2kunden l,
#            service s,
#            kunde c,
#            monlevel ml
#        where
#            da.id=m.deviceatribut_id
#            and m.id=lm.monitor_id
#            and lm.loesung_id=l.id
#            and l.feature_id=fe.id
#            and l.kunde_id=c.id
#            and ml.id=l.monlevel_id
#            and ml.name!='none'
#    ";
#    my($row,$result);
#    while($row=$self->{req}->{db}->{dbh}->selectrow_hashref) {
#        push(@{$result},$row);
#    }
#    return $result;
#}
#
#sub spmonitors { my$self=shift;
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->spmonitors needs a req.") unless defined($self->{req});
#    my($sql)="
#        select
#            m.name
#            m.command_line
#        from
#            monitor m,
#            service2monitors sm,
#            service s
#        where
#            m.id=sm.monitor_id
#            and sm.service_id=s.id
#    ";
#    return $self->{req}->{db}->{dbh}->selectall_hashref($sql, 'name') or die($!);
#}
#
#sub terminalserverport { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    my($nwtype)=$self->networktype(%arg,name=>"Serial");
#    $arg{id}=$arg{pt} unless($arg{id});
#    $self->interface(
#        %arg,
#        nt=>$nwtype->{id}
#    );
#}
#
#sub terminalserverport_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    my($nwtype)=$self->networktype(%arg,name=>"Serial") or return undef;
#    $self->interface_list(
#        %arg,
#        nt=>$nwtype->{id}
#    );
#}
#
#sub vlan { my$self=shift;
#    # expects: req
#    my($what)="vlan";
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->".$what." needs a req.") unless defined($self->{req});
#    
#    my($obj)=defined($arg{obj})?$arg{obj}:new PerlForms::Dict::Object(req=>$self->{req},what=>$what);
#    
#    $arg{id}=$arg{$obj->idattrib} if( !defined($arg{id}) and defined($arg{$obj->idattrib}) );
#    my($sql)="
#        select
#            id,
#            id ".$obj->idattrib.",
#            name,
#            name ".$obj->what."
#        from
#            ".$obj->tablename."
#        where
#            id=".$arg{id}."
#    ";
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->".$what." SQL-Query failed: ".$sql." ".$!);
#    
#    if(defined($data->{id})) {
#        $data->{name}=$data->{id} unless(defined($data->{name}) and $data->{name}=~/\w/);
#        return $data;
#    } else {
#        return {};
#    }    
#}
#
#sub vlan_list { my$self=shift;
#    # expects: req
#    my($what)="vlan";
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->".$what."_list needs a req.") unless defined($self->{req});
#    my($obj)=defined($arg{obj})?$arg{obj}:new PerlForms::Dict::Object(req=>$self->{req},what=>$what);
#    my($sql)="
#        select
#            id,
#            id ".$obj->idattrib.",
#            name,
#            name ".$obj->what."
#        from
#            ".$obj->tablename."
#    ";
#    $debug && print(STDERR __PACKAGE__."->vlan_list: SQL-Query: ".$sql."\n");
#    return $arg{"req"}->{"db"}->hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->".$what." SQL-Query failed: ".$sql." ".$!);
#}
#
#sub way { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->way needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"way");
#    $arg{id}=$arg{$obj->idattrib} unless defined($arg{id}) or !defined($arg{$obj->idattrib});
#    $arg{interface1_id}=$arg{i1} unless(defined($arg{interface1_id}));
#    $arg{interface2_id}=$arg{i2} unless(defined($arg{interface1_id}));
#    
#    my($sql)="
#        select
#            w.id ".$obj->idattrib.",
#            w.id id,
#            w.interface1_id interface1_id,
#            w.interface2_id interface2_id,
#            w.interface1_id i1,
#            w.interface2_id i2,
#            concat(d1.name,': ',i1.name) interface1,
#            concat(d2.name,': ',i2.name) interface2,
#            w.network_id,
#            nw.name network
#        from
#            way w
#            left outer join network nw on nw.id=w.network_id,
#            interface i1 left outer join device d1 on d1.id=i1.device_id,
#            interface i2 left outer join device d2 on d2.id=i2.device_id
#        where
#            w.interface1_id=i1.id
#            and w.interface2_id=i2.id
#    ";
#    if(defined($arg{id})) {
#        $sql.="
#            and w.id=".$arg{id}."
#        ";
#    }
#    if(defined($arg{interface1_id})) {
#        $sql.="
#            and w.interface1_id=".$arg{interface1_id}."
#        ";
#    }
#    if(defined($arg{interface2_id})) {
#        $sql.="
#            and w.interface2_id=".$arg{interface2_id}."
#        ";
#    }
#    $sql=~s/\s+/ /g;
##    print(STDERR __PACKAGE__."->way SQL-Query: ".$sql."\n\n");
#    my($data)=$self->{req}->{db}->{dbh}->selectrow_hashref($sql)
#        or $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->way SQL-Query failed: ".$sql."\n".$!);
#    $data;
#}
#
#sub way_list { my$self=shift;
#    # expects: req 
#    my(%arg)=@_;
#    $self->faultt(msg=>__PACKAGE__."->way_list needs a req.") unless defined($self->{req});
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"way");
#
##            concat(d1.name,': ',i1.name) interface1,
##            concat(d2.name,': ',i2.name) interface2,
##            concat(d1.name,':',i1.name,' - ',d2.name,':',i2.name) name,
#    my($sql)="
#        select
#            w.id,
#            w.id ".$obj->idattrib.",
#            d1.id d1,
#            d2.id d2,
#            d1.name device1,
#            d2.name device2,
#            w.interface1_id i1,
#            w.interface2_id i2,
#            i1.name inter1,
#            i2.name inter2,
#            i1.address address1,
#            i2.address address2,
#            i1.networktype_id nt,
#            w.network_id,
#            nw.name network,
#    ";
#    if(defined($arg{d1})) {
#        $sql.="
#            d2.id d,
#            d2.name device,
#            i2.id i,
#            i2.address address,
#        ";
#    }
#    if(defined($arg{d2})) {
#        $sql.="
#            d1.id d,
#            d1.name device,
#            i1.id i,
#            i1.address address,
#        ";
#    }
#    $sql.="
#        from
#            way w
#            left outer join network nw on nw.id=w.network_id,
#            interface i1 left outer join device d1 on d1.id=i1.device_id,
#            interface i2 left outer join device d2 on d2.id=i2.device_id
#        where
#            w.interface1_id=i1.id
#            and w.interface2_id=i2.id
#    ";
#    if(defined($arg{i}) and $arg{i}=~/\d/) {
#        $sql.="
#            and (
#                w.interface1_id=".$arg{i}."
#                or w.interface2_id=".$arg{i}."
#            )
#        ";
#    }
#    if(defined($arg{d}) and $arg{d}=~/\d/) {
#        $sql.="
#            and (
#                d1.id=".$arg{d}."
#                or d2.id=".$arg{d}."
#            )
#        ";
#    }
#    if(defined($arg{d1}) and $arg{d1}=~/\d/) {
#        $sql.="
#            and d1.id=".$arg{d1}."
#        ";
#    }
#    if(defined($arg{d2}) and $arg{d2}=~/\d/) {
#        $sql.="
#            and d2.id=".$arg{d2}."
#        ";
#    }
#    if(defined($arg{nt}) and $arg{nt}=~/\d/) {
#        $sql.="
#            and i1.networktype_id=".$arg{nt}."
#        ";
#    }
#    $sql=~s/,\s*from/\n        from/g;
#    $sql=~s/\n\s*\n/\n/g;
##    print STDERR __PACKAGE__."->way_list SQL-Query:\n".$sql."\n";
#    my($data);
#    unless($data=$self->{req}->{db}->{dbh}->selectall_hashref($sql,$obj->idattrib)) {
#        warn(__PACKAGE__."->way_list SQL-Query failed: ".$sql."\n".$!);
#        $self->faultt(req=>$self->{req},msg=>__PACKAGE__."->way_list SQL-Query failed.");
#    }
#    
#       my($key);
#    if(defined($arg{d}) and $arg{d}=~/\d/) {
#        foreach $key (keys(%{$data})) {
#            if($data->{$key}->{d1}==$arg{d}) {
#                $data->{$key}->{d}=$data->{$key}->{d2};
#                   $data->{$key}->{i}=$data->{$key}->{i2};
#                $data->{$key}->{address}=$data->{$key}->{address2};
#            } elsif($data->{$key}->{d2}==$arg{d}) {
#                $data->{$key}->{d}=$data->{$key}->{d1};
#                $data->{$key}->{i}=$data->{$key}->{i1};
#                $data->{$key}->{address}=$data->{$key}->{address1};
#            }
#        }
#    }
#    foreach $key (keys(%{$data})) {
#        $data->{$key}->{device1}="[unknown device]" unless defined($data->{$key}->{device1});
#        $data->{$key}->{device2}="[unknown device]" unless defined($data->{$key}->{device2});
#        $data->{$key}->{interface1}=$data->{$key}->{device1}.":".$data->{$key}->{inter1};
#        $data->{$key}->{interface2}=$data->{$key}->{device2}.":".$data->{$key}->{inter2};
#        $data->{$key}->{name}=$data->{$key}->{interface1}." - ".$data->{$key}->{interface2};
#    }
#    
#    $data;
#}
#
#sub customer { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $debug && print(STDERR __PACKAGE__."->customer got called by ".caller()." with ".join(",",%arg)."\n");
#    my($obj)=defined($arg{obj})?$arg{obj}:new PerlForms::Dict::Object(%arg,what=>"customer");
#    
#    unless(defined $self->{req}) {
#        warn(__PACKAGE__."->customer needs a req.\n");
#        return undef;
#    }
##    
##    print STDERR __PACKAGE__."->customer: id: ".$arg{"id"}."\n"
##    if defined $arg{"id"};
#    
#    unless(defined $arg{dn}) {
#        if(defined $arg{$obj->idattrib}) {
#            $arg{dn}=$arg{$obj->idattrib};
#        } elsif(defined $arg{id}) {
#            $arg{dn}=$arg{id};
#        } elsif(
#            defined $arg{division_id} 
#            and $arg{division_id}=~/(ou=[^,]+,o=customer)/
#        ) {
#            $arg{dn}=$1;
#        }
#    }
#    
#    my($entry);
#    if(defined $arg{dn} and $arg{dn}=~/\w/) {
#        require PerlForms::LDAP;
#        my($ldapn)=new PerlForms::LDAP(%arg);
#        $entry=$ldapn->fetchdn(%arg);
#    } else {
#        ### ldap filter bauen
#        my$filter=ldapfilter(%arg,obj=>$obj,"objectClass"=>"OrganizationalUnit");
#        $debug && print STDERR __PACKAGE__."->customer: LDAP-Search-Filter: ".$filter."\n";
#        my$base="o=customer";
#        
#        my$search=$self->{req}->{ldap}->search(base=>$base,filter=>$filter);
#        if($search->is_error) {
#            warn(__PACKAGE__."->customer ldap-search failed: ".$search->error."\nBase: ".$base."\nFilter: ".$filter);
#            return undef;
#        }
#        
#        $debug && print(STDERR 
#            __PACKAGE__."->customer found ".$search->count." records.\n"
#        );
#        
#        if($search->count>1) {
#            warn(__PACKAGE__."->customer found more than one record. returning undef.\n");
#            return undef;
#        }
#        
#        $entry=$search->shift_entry();
#    }
#    return undef unless defined $entry;
#
#    my(%dbfields)=$obj->dbfields()
#        or warn(__PACKAGE__."->customer: obj->dbfields failed.\n");
#        
#    $debug>=3 && print(STDERR __PACKAGE__."->customer: dbfields: ".join(",",%dbfields)."\n");
#    
#    my$attribs=$obj->attribs;
#    my($data);
#    while(my($attrib,$dbattrib)=each(%dbfields)) {
#        next unless defined $dbattrib and $dbattrib ne "none";
#        if($dbattrib eq "dn") {
#            $data->{$attrib}=$entry->dn;
#        } else {
#            if($attribs->{$attrib}->{multivalue}) {
#                @{$data->{$attrib}}=$entry->get_value($dbattrib)
#                or warn(__PACKAGE__."->customer couldnt get multivalue attrib '".$dbattrib."' from entry. ".$!."\n");
#                print STDERR __PACKAGE__."->customer got multivalue field ".$attrib.": ".ref($data->{$attrib})."\n";
#            } else {
#                $data->{$attrib}=$entry->get_value($dbattrib)
#                or warn(__PACKAGE__."->customer couldnt get attrib '".$dbattrib."' from entry. ".$!."\n");
#            }
#        }
#    }
#    
#    $debug>=3 && print(STDERR __PACKAGE__."->customer: record: ",join(",",%$data)."\n");
#    
#    $debug && print(STDERR __PACKAGE__."->customer returning.\n");
#    $data;
#}
#
#sub customer_list { my$self=shift;
#    # expects: ldap req
#    my(%arg)=@_;
#    $self->faultt(%arg,msg=>__PACKAGE__."->customer_list needs a req.")
#    unless defined($self->{req});
#    my($obj)=defined($arg{obj})?$arg{obj}:new PerlForms::Dict::Object(%arg,what=>"customer");
#    $debug && print(STDERR
#        __PACKAGE__."->customer_list got called by ".caller()."\n"
#    );
##    my($cust,$data);
##    my($filter)="(&";
##    $filter.="(objectClass=organizationalUnit)";
##    if(
##        defined($self->{req}->{cgi}->param("TSICustomer"))
##        and $self->{req}->{cgi}->param("TSICustomer")=~/\w/
##    ) {
##        $filter.="(ou=".$self->{req}->{cgi}->param("TSICustomer").")";
##    }
##    $filter.=")";
#    my$filter=ldapfilter(%arg,obj=>$obj,"objectClass"=>"organizationalUnit");
#    my($base)="o=customer";
#    
#    unless(defined($arg{ldap})) {
#        require PerlForms::LDAP;
#        $arg{nldap}=new PerlForms::LDAP(%arg);
#        $arg{ldap}=$arg{nldap}->{ldap};
#    }
#
#    $debug && print(STDERR 
#        __PACKAGE__."->customer_list ldap->search with base: ".$base.
#        ", filter: ".$filter."\n"
#    );
#    my($search)=$arg{ldap}->search(base=>$base,scope=>"one",filter=>$filter)
#    or $self->faultt(%arg,msg=>__PACKAGE__."->customer_list: ldap->search failed. ".$!);
#
#    $debug && print(STDERR __PACKAGE__."->customer_list getting dbfields...\n");
#    my(%dbfields)=$obj->dbfields()
#    or $self->faultt(%arg,msg=>__PACKAGE__."->customer_list: got no dbfields.");
#    
#    $arg{"sortkey"}="TSICustomer" unless defined $arg{"sortkey"};
#
#    $debug && print(STDERR __PACKAGE__."->customer_list refining entries...\n");
#    my($result);
##    foreach my$entry ($search->entries) {
#    foreach my$entry ($search->sorted($arg{"sortkey"})) { 
#        my$rec;
#        while(my($attrib,$dbattrib)=each(%dbfields)) {
#            next unless(defined($dbattrib));
#            if($dbattrib eq "dn") {
#                $rec->{$attrib}=$entry->dn;
#            } else {
#                my@content=$entry->get_value($dbattrib);
#                $rec->{$attrib}=join(" ",@content);
#                $rec->{$attrib}=~s/^\s*//g;
#                $rec->{$attrib}=~s/\s*$//g;
#            }
#        }
#        
#        $result->{$rec->{name}}=$rec;
#        undef $rec;
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->customer_list returns.\n");
#    return $result;
#}
#
#sub realm { my$self=shift;
#    # expects: req realm|ou|dn
#    my(%arg)=@_;
#    $debug && print(STDERR
#        __PACKAGE__."->realm got called by ".caller()." with ".join(",",%arg)."\n"
#    );
#    unless(defined $self->{req}) {
#        warn(__PACKAGE__."->realm needs a req.\n");
#        return undef;
#    }
#    
#    my($obj)=defined($arg{obj})?$arg{obj}:$self->{req}->newobj(%arg,what=>"realm");
#    
#    require PerlForms::LDAP;
#    my($ldapn)=PerlForms::LDAP->new(%arg);
#    
#    my(%dbfields)=$obj->dbfields;
#    my($dict)=$obj->dict;
#    
#    my($entry);
#    if(defined($arg{$obj->idattrib})) {
#        $entry=$ldapn->fetchdn(%arg,dn=>$arg{$obj->idattrib})
#    } elsif(defined($arg{"id"})) {
#        $entry=$ldapn->fetchdn(%arg,dn=>$arg{"id"})
#    } elsif(defined($arg{ou}) and $arg{ou}=~/\w/) {
#        $entry=$ldapn->fetchou(
#            req=>$self->{req},
#            ou=>$arg{ou},
#            base=>"ou=realms,ou=radius,o=services"
#        );
#    } elsif(defined($arg{dn}) and $arg{dn}=~/\w/) {
#        $entry=$ldapn->fetchdn(req=>$self->{req},dn=>$arg{dn});
#    } else {
#        my$base="ou=realms,ou=radius,o=services";
#        my$filter=ldapfilter(%arg,obj=>$obj);
#        $debug && print(STDERR __PACKAGE__."->realm searching ldap base ".$base." with filter ".$filter."\n");
#        my($search)=$self->{req}->{ldap}->search(
#            base=>$base,
#            filter=>$filter
#        );
#        if($search->is_error) {
#            warn(__PACKAGE__."->realm ldap search failed: ".$search->error."\n");
#            return undef;
#        }
#        $entry=$search->shift_entry;
#    }
#    unless(defined($entry)) {
#        print(STDERR __PACKAGE__."->realm did not find this record.\n");
#        return undef;
#    }
#    $debug && print(STDERR __PACKAGE__."->realm found an entry: ".$entry->dn."\n");
#
#    my($result);
#    while(my($field,$dbfield)=each(%dbfields)) {
#        next unless(defined($dbfield));
#        if($dbfield eq "dn") {
#            $result->{$field}=$entry->dn;
#        } else {
#            my@content=$entry->get_value($dbfield);
#            if(
#                defined($dict->{attribs}) 
#                and defined($dict->{attribs}->{$field}->{multivalue}) 
#                and $dict->{attribs}->{$field}->{multivalue}
#            ) {
#                if(@content) {
#                    $result->{$field}=\@content
#                } else {
#                    $result->{$field}=[]
#                }
#            } else {
#                $result->{$field}=join(", ",@content);
#                $result->{$field}=~s/^\s*//g;
#                $result->{$field}=~s/\s*$//g;
#            }
#        }
#    }
#
#    ## todo d form, list soll selber erkennen, ob  ein attrib eine liste oder ein einz. wert ist. query holt dann alle attrib mit mehreren werten als array.
#    
#    ## customer    
#    $debug && print(STDERR __PACKAGE__."->realm finding a customer...\n");
#    if(
#        defined($result->{"customer"})
#        and $result->{"customer"}=~/\w/
#        and (
#            !defined($result->{"customer_id"})
#            or $result->{"customer_id"}!~/\w/
#        )
#    ) {
#        my($customer)=$self->customer(req=>$self->{req},"customer"=>$result->{"customer"})
#        or warn(__PACKAGE__."->realm: couldnt find customer '".$result->{"customer"}."'\n");
#        
#        if(defined($customer)) {
#            $result->{"customer_id"}=$customer->{"customer_id"} if defined $customer;
#            $debug && print(STDERR __PACKAGE__."->realm found a customer: ".$customer->{id}."\n");
#        } else {
#            warn(
#                __PACKAGE__."->realm: Query::customer did not return a customer"
#                ." (was looking for '".$result->{"customer"}."').\n"
#            );
#        }
#    } else {
#        $self->{req}->ui->warning("Bitte einen Kunden auswählen.");
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->realm returns.\n");
#    return $result;
#}
#
#sub realm_list { my$self=shift;
#    # expects: req ldap
#    # returns: hashref of hashrefs
#    my(%arg)=@_;
#    print STDERR __PACKAGE__."->realm_list got called by ".caller()." with ".join(", ",%arg)."\n";
#    $self->faultt(%arg,msg=>__PACKAGE__."->realm_list needs a req.") unless(ref($self->{req})=~/REQ/);
#    
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"realm");
#    
#    ## todo ldap scheme creator anhand von dbfields
#
#    ### ldap filter aufbauen
#    my$filter=ldapfilter(%arg,obj=>$obj,"objectClass"=>"TSIrealmitems");
#    $debug && print STDERR __PACKAGE__."->realm_list LDAP-Search-Filter: ".$filter."\n";
#
#    ### ldap search
#    my($base)="ou=realms,ou=radius,o=services";
#    my($mesg)=$self->{req}->{ldap}->search(
#        base=>$base,
#        filter=>$filter
#    ) or $self->faultt(%arg,msg=>__PACKAGE__.":realm_list: ldap->search failed. ".$!."\nBase: ".$base."\nFilter: ".$filter."\n");
#
#    my($entry);
#
#    my(%dbfields)=$obj->dbfields; 
#    my(@content,$rec,$field,$result);
#    foreach $entry ($mesg->entries) {
#        while(my($field,$dbfield)=each(%dbfields)) {
#            next unless(defined($dbfield));
#            if($dbfield eq "dn") {
#                $rec->{$field}=$entry->dn;
#            } else {
#                @content=$entry->get_value($dbfield);
#                $rec->{$field}=join(", ",@content);
#            }
#        }
#        
#        if(
#            $rec->{ou} eq "realms"
#            or $rec->{ou} eq "client encryption"
#            or $rec->{ou} eq "remote dial in"
#        ) {
#            undef $rec;
#            next;
#        }
#
#        $result->{$rec->{"id"}}=$rec;
#        undef $rec;
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->realm_list returning.\n");
#    return $result?$result:{};
#}

sub defaultldap_list {
    # expects: req ldap
    # returns: hashref of hashrefs
    my$self=shift;
    my(%arg)=@_;
    my$debug_bitval=16;
    my$debug_sub;
    my$subname="defaultldap_list";
    eval DEBUGGING;
    $self->faultt(%arg,msg=>__PACKAGE__."->defaultldap_list needs a req.") unless(ref($self->{req})=~/REQ/);
    
    my($obj)=$arg{obj};
    my($thing)=defined($arg{thing})?$arg{thing}:$self->{req}->things($obj->what);
    unless(defined($obj)) {
        die(__PACKAGE__."->".$debug_sub." needs an obj!\n")
    }
    
    ## todo ldap scheme creator anhand von dbfields

    ### ldap filter bauen
    my%dbfields=$obj->dbfields;
    my$filter=$thing->storage->{ldapn}->ldapfilter(%arg,obj=>$obj,"objectClass"=>$obj->dict->{ldap_objectclass});
    $debug_sub && print STDERR __PACKAGE__."->defaultldap_list LDAP-Search-Filter: ".$filter."\n";

    ### ldap search
    my($base)=$obj->dict->{ldap_base};
    my($search)=$self->{req}->{ldap}->search(
        base=>$base,
        filter=>$filter
    ) or $self->faultt(
        %arg,
        msg=>
            __PACKAGE__.":defaultldap_list: ldap->search failed. ".$!."\nBase: "
            .$base."\nFilter: ".$filter."\n"
    );

    
    my($result);
    foreach my$entry ($search->entries) {
        my$rec={};
        while(my($field,$dbfield)=each(%dbfields)) {
            next unless(defined($dbfield));
            if($dbfield eq "dn") {
                $rec->{$field}=$entry->dn;
            } else {
                my@content=$entry->get_value($dbfield);
                $rec->{$field}=join(" ",@content);
            }
        }
        
        if(
            defined($rec->{ou})
            and (
                $rec->{ou} eq "realms"
                or $rec->{ou} eq "client encryption"
                or $rec->{ou} eq "remote dial in"
                or $rec->{ou} eq "Users"
            )
        ) {
            undef $rec;
            next;
        }

        $result->{$rec->{"id"}}=$rec;
        undef $rec;
    }
    
    $debug_sub && print(STDERR __PACKAGE__."->defaultldap_list returning.\n");
    return $result?$result:{};
}
#
#sub TSIccallowedrealms_list { my$self=shift;
#    # expects: req ldap exclusive?
#    # returns: hashref of hashrefs
#    # descr: exclusive: nur dem kunden zugeordnete realms anzeigen (default alle)
#    my(%arg)=@_;
##    print STDERR __PACKAGE__."->realm_list got called by ".caller()." with ".join(", ",%arg)."\n";
#    $debug && print(STDERR __PACKAGE__."->TSIccallowedrealms_list got called by ".caller()." with ".join(",",%arg)."\n");
#    $self->faultt(%arg,msg=>__PACKAGE__."->tsiccallowedrealms_list needs a req.") unless(ref($self->{req})=~/REQ/);
#    
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"TSIccallowedrealms");
#    
#    ## todo ldap scheme creator anhand von dbfields
#    
#    if(!defined($arg{customer}) and defined($arg{customer_id})) {
#        my$customer_rec=$self->customer(
#            req=>$self->{req},
#            customer_id=>$arg{customer_id}
#        );
#        $arg{customer}=$customer_rec->{customer};
#    }
#
#    my$filter=ldapfilter(%arg,obj=>$obj,"objectClass"=>"TSIrealmitems");
#    print STDERR __PACKAGE__."->tsiccallowedrealms_list LDAP-Search-Filter: ".$filter."\n";
#
#    ### ldap search
#    my($base)="ou=realms,ou=radius,o=services";
#    my($search)=$self->{req}->{ldap}->search(
#        base=>$base,
#        filter=>$filter
#    ) or $self->faultt(
#        %arg,
#        msg=>__PACKAGE__.":tsiccallowedrealms_list: ldap->search failed. ".$!
#        ."\nBase: ".$base."\nFilter: ".$filter."\n"
#    );
#
#    my($entry);
#
#    my(%dbfields)=$obj->dbfields; 
#    my(@content,$rec,$field,$result);
#    foreach $entry ($search->entries) {
#        while(my($field,$dbfield)=each(%dbfields)) {
#            next unless(defined($dbfield));
#            if($dbfield eq "dn") {
#                $rec->{$field}=$entry->dn;
#            } else {
#                @content=$entry->get_value($dbfield);
#                $rec->{$field}=join(" ",@content);
#            }
#        }
##        $rec->{realm}=$rec->{ou}; ## wird alles in dbfields geregelt
##        $rec->{name}=$rec->{ou};
##        $rec->{customer}=$rec->{TSICustomer};
##        $rec->{"dn"}=$entry->dn;
##        $rec->{$obj->idattrib}=$entry->dn;
#        
#        if(
#            $rec->{ou} eq "realms"
#            or $rec->{ou} eq "client encryption"
#            or $rec->{ou} eq "remote dial in"
#        ) {
#            undef $rec;
#            next;
#        }
#
#        $result->{$rec->{"id"}}=$rec;
#        undef $rec;
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->tsiccallowedrealms_list returning.\n");
#    return $result?$result:{};
#}

sub defaultldap {
    my$self=shift;
    my(%arg)=@_;
    my$debug_bitval=8;
    my$debug_sub;
    my$subname="defaultldap";
    eval DEBUGGING;
#    $debug_sub && print(STDERR __PACKAGE__."->defaultldap got callled by ".caller()." with ".join(",",%arg)."\n");
    
    my%dbfields=$self->obj->dbfields()
        or warn(__PACKAGE__."->division: obj->dbfields failed.\n");
    
    my$attribs=$self->obj->attribs;
    
    ## dn
    unless(defined $arg{dn}) {
        if(defined $arg{$self->obj->idattrib} and $attribs->{$self->obj->idattrib}->{dbfield} eq "dn") {
            $arg{dn}=$arg{$self->obj->idattrib};
        } elsif (defined $arg{"id"} and $attribs->{"id"}->{dbfield} eq "dn") {
            $arg{dn}=$arg{"id"};
        } else {
            warn(__PACKAGE__."->defaultldap did not get a valid DN.\n");
            return undef;
        }
    }
    
    ## entry
    my($entry)=$self->thing->storage->{ldapn}->fetchdn(%arg,dn=>$arg{"dn"});

    my($data);
    while(my($attrib,$dbattrib)=each(%dbfields)) {
        next unless defined $dbattrib;
        if(
            defined $attribs->{$attrib}
            and $self->obj->attribmultivalue($attrib)
        ) {
            @{$data->{$attrib}}=$entry->get_value($dbattrib)
            or warn(__PACKAGE__."->defaultldap couldnt get attrib '".$dbattrib."' from entry. ".$!."\n");
        } elsif($dbattrib eq "dn") {
            $data->{$attrib}=$entry->dn
            or warn(__PACKAGE__."->defaultldap couldnt get attrib '".$dbattrib."' from entry. ".$!."\n");
        } else {
            $data->{$attrib}=$entry->get_value($dbattrib)
            or warn(__PACKAGE__."->defaultldap couldnt get attrib '".$dbattrib."' from entry. ".$!."\n");
        }
    }
    
    $debug_sub && print STDERR __PACKAGE__."->".$subname.": returning ".$data->{id}."\n";
    $data;
}
#
#sub division { my$self=shift;
#    my%arg=@_;
#    $debug && print(STDERR __PACKAGE__."->division got called by ".caller()." with ".join(",",%arg)."\n");
#    
#    my$data=defaultldap(%arg);
#    
#    $data->{dn}=~/(ou=[^,]+,o=customer)/ and $data->{customer_id}=$1;
#    
#    $data;
#}
#
#sub division_list { my$self=shift;
#    # expects: req ldap
#    # returns: hashref of hashrefs
#    my(%arg)=@_;
#    $debug && print(STDERR __PACKAGE__."->division_list got called with: ".join(" ",@_)." by ".caller()."\n");
#    $self->faultt(%arg,msg=>__PACKAGE__."->division_list needs a req.") unless(ref($self->{req})=~/REQ/);
#    
#    my($obj)=new PerlForms::Dict::Object(req=>$self->{req},what=>"division");
#    
#    # customer
#    my$customer=$self->customer(
#        %arg,
#        what=>"customer",
#        id=>undef,
#        obj=>undef
#    ) if(defined $arg{customer} or defined $arg{customer_id});
#
#    ### ldap filter aufbauen
#    my($filter)="(&";
##    $filter.="(!(objectClass=TSIorganisation))"; ## scheint openldap nicht zu verstehen
##    $filter.="(!(ou=".$arg{customer}."))" if(defined($arg{customer}));
#    $filter.="(!(TSICustPref=*))";
#    $filter.="(!(cn=*))";
#    $filter.="(!(ou=Users))(!(ou=Groups))";
#    $filter.=")";
#    $debug && print STDERR __PACKAGE__."->division_list LDAP-Search-Filter: ".$filter."\n";
#    
#    my($base);
##    if(defined($arg{customer}) && $arg{customer}=~/\w/) {
##        $arg{customer}=~s/\(/\\\(/;
##        $arg{customer}=~s/\)/\\\)/;
##        $base.="ou=".$arg{customer}.",";
##    }
#    if(defined($customer) and defined($customer->{dn})) {
#        $base.=$customer->{dn};
#    } else {
#        $base.="o=customer";
#    }
#
#    $debug && print STDERR __PACKAGE__."->division_list LDAP-Search-Base: ".$base."\n";
#        
#    ### ldap search
#    my($search)=$self->{req}->{ldap}->search(
#        base=>$base,
#        filter=>$filter,
#        scope=>"one"
#    ) or $self->faultt(%arg,msg=>__PACKAGE__."->division_list: ldap->search failed. ".$!);
#    
#    $debug && print(STDERR __PACKAGE__."->division_list found ".$search->count." ldap objects.\n");
#
#    my(@content);
#    my($result)={};
#    my(%dbfields)=$obj->dbfields;
#    $debug>=2 && print(STDERR 
#        __PACKAGE__."->division_list got dbfields: "
#        .join(",",values(%dbfields))."\n"
#    );
#    foreach my$entry ($search->entries) {
#        my$rec;
#        while(my($attrib,$dbattrib)=each(%dbfields)) {
#            next unless(defined($dbattrib));
#            if($dbattrib eq "dn") {
#                $rec->{$attrib}=$entry->dn;
#            } else {
#                @content=$entry->get_value($dbattrib);
#                $rec->{$attrib}=join(", ",@content);
#            }
#        }
##        $rec->{ou}=$entry->get_value("ou");
##
##        if(
##            !defined($rec->{ou})
###            $rec->{ou} eq "Users"
###            or $rec->{ou} eq "Groups"
##        ) {
##            undef $rec;
##            next;
##        }
#
#        $rec->{id}=$entry->dn;        
#        $rec->{$obj->what}=$rec->{name};
#        $result->{$rec->{id}}=$rec;
#    }
#    
#    $debug && print(STDERR __PACKAGE__."->division returns ".$result."\n");
#    return $result;
#}
#
#sub user { my$self=shift;
#    # expects: req uid|cn|dn
#    my(%arg)=@_;
#    my($obj)=defined($arg{obj})?$arg{obj}:$self->{req}->dict->obj(req=>$self->{req},what=>"user");
#    
#    $arg{cn}=$arg{id} unless(defined($arg{cn}));
#    $arg{cn}=$arg{uid} unless(defined($arg{cn}));
#    
#    my($entry);
#    require PerlForms::LDAP;
#    my($ldapn)=PerlForms::LDAP->new(req=>$self->{req},ui=>$arg{ui});
##    if(defined($arg{cn}) and $arg{cn}=~/\w/) {
##        $entry=$ldapn->fetchcn(cn=>$arg{cn},base=>"o=customer");
##    } elsif(defined($arg{dn}) and $arg{dn}=~/\w/) {
##        $entry=$ldapn->fetchdn(dn=>$arg{dn});
##    }
#    if(defined($arg{$obj->idattrib})) {
#        unless($entry=$ldapn->fetchdn(dn=>$arg{$obj->idattrib})) {
#            warn(__PACKAGE__."->user \$ldapn->fetchdn failed. ".$!);
#        }
#        unless(defined($entry)) {
#            warn(__PACKAGE__."->user Could not find an entry ".$arg{$obj->idattrib});
#            return undef;
#        }
#    } elsif(defined($arg{dn})) {
#        unless($entry=$ldapn->fetchdn(dn=>$arg{dn})) {
#            warn(__PACKAGE__."->user \$ldapn->fetchdn failed. ".$!);
#        }
#        unless(defined($entry)) {
#            warn(__PACKAGE__."->user Could not find an entry ".$arg{dn});
#            return undef;
#        }
#    } elsif(defined($arg{uid})) {
#        unless($entry=$ldapn->fetchcn(base=>$obj->ldap_base,cn=>$arg{uid})) {
#            warn(__PACKAGE__."->user \$ldapn->fetchcn failed. ".$!);
#        }
#        unless(defined($entry)) {
#            warn(__PACKAGE__."->user Could not find an entry '".$arg{uid}."'");
#            return undef;
#        }
#    } else {
#        warn(__PACKAGE__."->user: No ".$obj->idattrib.", DN or UID defined. I need one of those.");
#    }
#    
#
#    my($field,$dbfield,@content,$result);
#    my(%dbfields)=$obj->dbfields;
#    while(($field,$dbfield)=each(%dbfields)) {
#        @content=$entry->get_value($dbfield);
#        if(defined($content[1])) {
#            $result->{$field}=$entry->get_value($dbfield,asref=>1);
##            $debug && print STDERR __PACKAGE__."->user got attrib ".$field."=".$result->{$field}."\n";
#        } elsif(defined($content[0])) {
#            $result->{$field}=$content[0];
##            $debug && print STDERR __PACKAGE__."->user got attrib ".$field."=".$result->{$field}."\n";
#        }
#    }
#    
#    $result->{dn}=$entry->dn;
#
#    $result->{dn}=~/(ou=[^,]+,)(ou=[^,]+,o=customer)/
#        or warn(__PACKAGE__."->user couldnt figure out what customer/division this user belongs to.");
#    $result->{division_id}=$1.$2;
#    $result->{customer_id}=$2;
#
#    
#    return $result;
#}
#
#sub user_list { my$self=shift;
#    # expects: req
#    my(%arg)=@_;
#    $debug && print STDERR __PACKAGE__."->user_list got called with ".join(", ",keys(%arg))."\n";
#    $self->faultt(msg=>__PACKAGE__."->user_list needs a req.")
#    unless defined($self->{req} and ref($self->{req}));
#    
#    my($obj)=
#        defined($arg{obj})
#        ?$arg{obj}
#        :$self->{req}->dict->obj(req=>$self->{req},what=>"user")
#    ;
#
#    if(!defined($arg{TSIccallowedrealms}) and defined($arg{realm})) {
#        $arg{TSIccallowedrealms}=$arg{realm};
#    }
#
#    ### ldap base bauen
#    my($base);
#    if(defined($arg{customer_id}) and $arg{customer_id}=~/\w/) {
#        $base=$arg{customer_id};
#        $base=~s/o=customer\s*$//g;
#        $base.="o=customer";
#    } elsif(defined($arg{customer}) and $arg{customer}=~/\w/) {
#        print STDERR __PACKAGE__."->user_list: customer: ".$arg{customer}."\n";
#        my$customer=$self->guess(req=>$self->{req},what=>"customer",customer=>$arg{customer});
#        unless(defined($customer) and defined($customer->{dn})) {
#        	warn(__PACKAGE__."->user_list: did not get a customer->dn from guess (customer: ".$arg{customer}."). returning undef.\n");
#        	return undef;
#        }
#        $base=$customer->{dn}; ## an dieser Stelle ist die Verw. von DN anstelle
#                               ## von ID korrekt, da tatsächlich der DN benötigt 
#                               ## wird, und ID nicht unbedingt den DN enthalten 
#                               ## muss. Sonst, als ID, immer ID verwenden.
#        $base=~s/\&/\\\&/g;
#    } elsif(defined($arg{division_id}) and $arg{division_id}=~/\w/) {
#        $base=$arg{division_id};
#        $base=~s/o=customer\s*$//g;
#        $base.="o=customer";
#    } else {
#        $base="o=customer";
#    }
#    $debug && print STDERR __PACKAGE__."->user_list: LDAP-Search-Base: ".$base."\n";
#
#
#    ### ldap filter bauen
#    my$filter=ldapfilter(%arg,obj=>$obj,"objectClass"=>"Person");
#    $debug && print STDERR __PACKAGE__."->user_list: LDAP-Search-Filter: ".$filter."\n";
#
#    ### ldap search
#    my($search)=$self->{req}->{ldap}->search(base=>$base,filter=>$filter)
#        or $self->faultt(%arg,msg=>__PACKAGE__."->user_list: ldap->search failed. ".$!);
#    $search->is_error
#        and $self->faultt(%arg,msg=>__PACKAGE__."->user_list: ldap->search failed: ".$search->error."\nBase: ".$base."\nFilter: ".$filter);
#
#    $debug && print STDERR __PACKAGE__."->user_list: LDAP search successfully completed. Found ".$search->count()." LDAP objects.\n";
#
#    my($result);
#    my(%dbfields)=$obj->dbfields;
#    foreach my$entry ($search->entries) { 
#        if(
#            $entry->get_value("ou")
#            and (
#                $entry->get_value("ou") eq "realms"
#                or $entry->get_value("ou") eq "client encryption"
#                or $entry->get_value("ou") eq "remote dial in"
#                or $entry->get_value("ou") eq "Users"
#            )
#        ) {
#            undef $entry;
#            next;
#        }
#        
#        my$rec;
#        while(my($field,$dbfield)=each(%dbfields)) {
#            next unless(defined($dbfield));
#            if($dbfield eq "dn") {
#                $rec->{$field}=$entry->dn;
#                $rec->{$field}=~/(ou=[^,]+,ou=[^,]+,o=customer)/;
#                $rec->{division_id}=$1;
#                $rec->{$field}=~/ou=([^,]+),(ou=[^,]+,o=customer)/;
#                $rec->{division}=$1;
#                $rec->{customer_id}=$2;
#            } else {
#                my@content=$entry->get_value($dbfield);
#                $rec->{$field}=join(" ",@content);
#            }
#        }
#
#        $result->{$rec->{"id"}}=$rec;
#        undef $rec;
#    }
#    
#    $debug && print STDERR __PACKAGE__."->user_list returns.\n";
#    return $result?$result:{};
#}
#
#sub usermitgr { my$self=shift;
#    my(%arg)=@_;
#    
#    my($realms)=$self->realm_list(
#        %arg,
#        TSIccdialinallowgr=>"TRUE"
#    );
#    
#    my($key,$rec,$data);
#    while(($key,$rec)=each(%{$realms})) {
#        my($users)=$self->user_list(
#            %arg,
#            realm=>$rec->{realm}
#        );
#        my($k,$r);
#        while(($k,$r)=each(%{$rec})) {
#            $data->{$r->{name}}=$r;
#        }
#    }
#    
#    return $data;
#}
#
#sub connectedthroughdevice_list { my$self=shift;
#    my(%arg)=@_;
#    $self->guess(%arg,obj=>undef,what=>"device","d"=>$arg{"ct"});
#}
#
#sub report_list { my$self=shift;
#    return {
#        0=>{
#            rep=>"l2tpusers_mit_falschem_routing",
#            report=>"Aktive L2TP-User mit ungültigen IP-Routen"
#        },
#        1=>{
#            rep=>"usermitgr",
#            report=>"Users die iPass nutzen dürfen"
#        },
#        2=>{
#            rep=>"statistics",
#            report=>"Directory Statistiken"
#        }
#    };
#}



package Main;

return 1;