Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

problems with class::dbi::sweet

by xido (Initiate)
on Sep 08, 2008 at 20:39 UTC ( [id://709868]=perlquestion: print w/replies, xml ) Need Help??

xido has asked for the wisdom of the Perl Monks concerning the following question:

Class::DBI::Sweet - very good module, but now I got this message: 
Can't call method "fc_hash" on an undefined value at
/usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi/Cache/FastMmap.
+pm
line 632 during global destruction.

[download]
(I use it with Cache::FastMMap); And this depending from count of url parameters only (script.pl?arg=1&arg=2&arg=3). If amount of arguments greater then 3, I got this message.. Also I use CGI::Session module with Class::DBI::Sweet as driver, when invoke of them is commented error is going out, Can you help me? Execuse me for my english :(

Replies are listed 'Best First'.
Re: problems with class::dbi::sweet
by stonecolddevin (Parson) on Sep 08, 2008 at 21:29 UTC

    Can we see your code? An error message is helpful, but we need to see code to see what you may be missing.

    If the error is contingent upon the number of arguments you provide, it probably has something to do with you not having the correct number of arguments that you need to pass into your C::D::S code.

    UPDATE wait, your title says you're having issues with Class::DBI::Sweet but your error refers to Cache::FastMMap. Which one is it??? If it's the latter, show us your caching code. If it's Class::DBI::Sweet, show us that code.

    meh.
[reply]
      FastMMap used by class::DBI::Sweet, I dont touch It, but I think that error is in C::D:S or CGI::Session code. because when I commented calling of CGI Session, error got lost.
[reply]
      Maybe it very large piece of code.. URL parametrs passed by CGI module and dont going to C::D::S. And CGI::Session dont need it, I use cookies. Code.. 5 seconds please :)
[reply]
        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 :)
[reply]
[d/l]
[select]
Re: problems with class::dbi::sweet
by rhesa (Vicar) on Sep 09, 2008 at 10:47 UTC
    Hi xido,

    I also use Class::DBI::Sweet, CGI::Session, and a cache (Cache::Memcached in my case). I can assure you that your problem isn't with those modules. The most likely culprit is your session driver, which looks "non-standard".

    I have two suggestions for you:

    1. try using CGI::Session with the default CGI::Session::Driver::DBI. Pass in MultiDesk::DB->get_handle as the handle
    2. or try turning off the cache on the class you use in the session driver, with $class->cache(undef). (you didn't show us which class that is, but it's accessed with $class->{ddb} in your get_session_from_user function)

    If that doesn't help, try obtaining a full stack trace for that error, and see if that narrows it down. It'd be useful to know where the error gets triggered, and the parameters and objects involved.

    Caching sessions isn't useful, in my experience, because it gets flushed to the database on every request anyway. So you don't really reduce load on the database.

[reply]
[d/l]
[select]
      I find the bug!! C:D:S don't have an constructror! But I blessed value than was "returned" by them with MultiDesk::DB. Destructor called twice, the second call was on non existent object.. But link with amount of get or post variables - mystery for me..
[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://709868]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others learning in the Monastery: (3)
As of 2024-04-20 01:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found