With this functions I see error first 
sub search
{
  my $category = $cgi->param('category');
  my $req   =  $cgi->param('req');
  my $title   = "Search";

  my $template = HTML::Template::Pro->new(filename => '2search.tpl',
                                          global_vars => 0,
                                          debug    => 1);

 if ($category && $req) {
    my $result=do_search($category,$req);

my $result=undef;
    if (defined $result) {
    die $result;
        my $rs=$result->make_list(id  => undef,
                                  departament => sub {shift->departame
+nt->mailbox()},
                                  status  => undef,
                                  subject => sub{ htesc(shift->subject
+()) });

       $template->param(TITLE  => "Search result:",
                        USER => $login,
                        RESULTS => $rs,);
      }
   }

  print $cgi->header(-charset=>"cp1251").$template->output();

}

sub do_search
{
 my $category=shift;
 my $query=shift;
 my $result;
 my $row;

 if    (lc($category)  eq 'id')          {$row="id"}
 elsif (lc($category)  eq 'subject')     {$row="subject"}
 elsif (lc($category)  eq 'text')        {$row="description"}
 elsif (lc($category)  eq 'email')       {$row="email"}
 elsif (lc($category)  eq 'user')       {$row="userid"}
 else {return undef}

 $result=MultiDesk::Ticket->search($row => $query,);

 return $result;
}

[download]
it's functions from MultiDesk::DB package 
#!/usr/bin/perl
use strict;
use warnings;

use Cache::FastMmap;

package MultiDesk::DB;
use base 'Class::DBI::Sweet';
MultiDesk::DB->iterator_class('MultiDesk::Iterator');


sub new()
{
 my $class=shift;
 my %params=@_;
 my $self={};
 

 bless $self,$class;
 die ("MultiDesk: Bad parameters") unless ($params{db} && $params{host
+} && $params{user} && $params{password});
 $self=MultiDesk::DB->connection("dbi:mysql:".$params{db}, $params{use
+r}, $params{password});
 
 MultiDesk::DB->cache(
                      Cache::FastMmap->new(
                      share_file => '/tmp/cdbi',
                      expire_time => 3600)
                     );
 return $self;
}

sub set_userid
{
 my $class=shift;
 my $userid=shift;
 
 my $ticket_list="
 SELECT __ESSENTIAL(me)__
 FROM %s 
 WHERE %s AND (`reseller`,`departament`) IN 
 (SELECT `reseller`, `departament` FROM `acl` WHERE `userid`=?) 
 %s %s";

 my $ticket_count="
 SELECT COUNT(*)
 FROM %s 
 WHERE %s AND (`reseller`,`departament`) IN 
 (SELECT `reseller`, `departament` FROM `acl` WHERE `userid`=?)";

 $ticket_list=~s/\?/"'".$userid."'"/eg;
 $ticket_count=~s/\?/"'".$userid."'"/eg;

 MultiDesk::Ticket->set_sql(ticket_list => $ticket_list);
 MultiDesk::Ticket->set_sql(ticket_list_Count => $ticket_count);

 $ticket_list="
 SELECT __ESSENTIAL(me)__
 FROM %s 
 WHERE %s AND `reseller` IN 
 (SELECT `reseller` FROM `acl` WHERE `userid`=?) 
 %s %s";
 
 $ticket_count="
 SELECT COUNT(*)
 FROM %s 
 WHERE %s AND `reseller` IN 
 (SELECT `reseller`  FROM `acl` WHERE `userid`=?)";

 $ticket_list=~s/\?/"'".$userid."'"/eg;
 $ticket_count=~s/\?/"'".$userid."'"/eg;

 MultiDesk::Ticket->set_sql(ticket_list_by_reseller => $ticket_list);
 MultiDesk::Ticket->set_sql(ticket_list_by_reseller_Count => $ticket_c
+ount);
}

sub get_handle
{
 my @db_names = MultiDesk::DB->db_names;
 my $db_meth = 'db_'.$db_names[0];
 return MultiDesk::DB->$db_meth;
}

sub get_fields
{
 my $class=shift;
 return map { $class->$_(); } @_;
}

sub associate
{
 my $class=shift;
 my %assoc=@_;
 my %res;
 
 foreach my $key (keys %assoc)
   {
    my $method=$assoc{$key};
    $res{$key}=$class->$method();
   }
 
 return \%res;
}

package MultiDesk::Iterator;
use base 'Class::DBI::Iterator';
sub make_list
{
 my $iterator=shift;
 my %map=@_;
 my @resultset;
 
 while(my $ent=$iterator->next())
   {
    my %row;
    
    foreach my $key (keys %map)
       {
        unless (defined $map{$key})
          {
           $row{$key}=$ent->$key();
           next;
          }
        
        if (ref($map{$key}) ne 'CODE')
          {
           die __PACKAGE__.": Bad param to make list.";
          }  
          
        $row{$key}=&{ $map{$key} }($ent);          
       }

    push @resultset,\%row;    
   }
 
 return \@resultset;
}

[download]
It's auth function - without her error going out. 
sub auth
{
  my ($class,$session,$staff_only,$login_func)=@_;
  
  &$login_func() unless ($session->get_session_from_user());
  
  my ($userid,$password)=$session->get_value('userid','password');
  
  my $ip=$session->remote_addr();
  
  my $user=MultiDesk::UserID->retrieve($userid);
  
  if (!defined $user) {
     $session->del_session();
     $session->flush();
     &$login_func() ;
    }
  
  my $username=$user->username();    
  my ($rc,$staff)=$class->check($username,$password);

  unless ($rc && ($staff_only && $staff))    
    {
      $session->del_session();
      $session->flush();
      &$login_func();
    }

  &$login_func() unless ($ip eq $ENV{REMOTE_ADDR});
  
  return ($username, $userid, $staff); 
}

[download]
sub get_session_from_user
{
 my $class=shift;
 my ($sid, $s);
 
 $sid = CGI->cookie( 'session' );
 return undef unless ($sid);
 
 $sid=~s/[\W]//g;
  
 $s=CGI::Session->load("driver:sweet" , $sid , { Handle=>$class->{ddb}
+ })
     or return undef;

 if ($s->is_expired)
   {
    $s->delete();
    return undef;
   }
 
  if ( $s->is_empty )
    {
#      $s->delete;
#      return undef; 
      $s = $s->new("driver:sweet" , undef , { Handle=>$class->{ddb} } 
+) or die $s->errstr;
    }
  
 $class->{session}=$s;     
 return 1;
}

[download]
package CGI::Session::Driver::sweet;

use warnings;
use strict;

use Carp;
use MultiDesk::DB;
use CGI::Session::Driver;


@CGI::Session::Driver::sweet::ISA = ( "CGI::Session::Driver" );
$CGI::Session::Driver::sweet::VERSION = '1.0';

sub init {
    my $self = shift;
    return 1;
}

# A setter/accessor method for the table name, defaulting to 'sessions
+'

sub table_name {
    my $self = shift;
    my $class = ref( $self ) || $self;

    if ( (@_ == 0) && ref($self) && ($self->{TableName}) ) {
        return $self->{TableName};
    }

    no strict 'refs';
    if ( @_ ) {
        my $new_name = shift;
        $self->{TableName}           = $new_name;
        ${ $class . "::TABLE_NAME" } = $new_name;
    }

    unless (defined $self->{TableName}) {
        $self->{TableName} = "sessions";
    }

    return $self->{TableName};
}


sub retrieve {
    my $self = shift;
    my ($sid) = @_;
    croak "retrieve(): usage error" unless $sid;
    
    my $id_col=$self->{IdColName};
    my $row=$self->{Handle}->retrieve($id_col => $sid);
    
    return 0 unless $row;
    return $row->a_session();
}


sub store {
    my $self = shift;
    my ($sid, $datastr) = @_;
    croak "store(): usage error" unless $sid && $datastr;

    my $id_col=$self->{IdColName};
    my $data_col=$self->{DataColName};

    my $rc=$self->{Handle}->retrieve($id_col => $sid);
    $self->{Handle}->autoupdate(1);
            
    if ( $rc ) {
        $rc->$data_col($datastr);   
      }
    else
      {
        $self->{Handle}->insert({id   => $sid,
                                 a_session => $datastr,
                                });  
      }

    return 1;
}


sub remove
{
    my $self = shift;
    my ($sid) = @_;
    croak "remove(): usage error" unless $sid;

    my $id_col=$self->{IdColName};
    my $sess=$self->{Handle}->retrieve($id_col => $sid);
    
    $sess->delete() if($sess);
    
    return 1;
}


sub traverse {
    my $self = shift;
    my ($coderef) = @_;

    unless ( $coderef && ref( $coderef ) && (ref $coderef eq 'CODE') )
+ {
        croak "traverse(): usage error";
    }

    my $id_col=$self->{IdColName};
    my $iterator=$self->{Handle}->retrieve_all();

    while ( my ($i) = $iterator->next ) {
        $coderef->($i->$id_col());
    }

    return 1;
}

[download]
Yes, it's very big code :)

In reply to Re^3: problems with class::dbi::sweet by xido
in thread problems with class::dbi::sweet by xido

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.