view release on metacpan or  search on metacpan

lib/Apache/Session/Browseable/DBI.pm  view on Meta::CPAN

            return $sth->fetchall_hashref('id');
        }
    }
    my $sth = $dbh->prepare_cached("SELECT id,a_session from $table_name");
    $sth->execute;
    my %res;
    my $next = (
        $args->{DataSource} =~ /^sybase/i
        ? sub {
            require Storable;
            return Storable::thaw( pack( 'H*', $_[0] ) );
          }
        : $args->{DataSource} =~ /^mysql/i ? sub {
            require MIME::Base64;
            require Storable;
            return Storable::thaw( MIME::Base64::decode_base64( $_[0] ) );
          }
        : undef
    );
    while ( my @row = $sth->fetchrow_array ) {
        no strict 'refs';
        my $self = eval "&${class}::populate();";
        eval {
            my $sub = $self->{unserialize};
            my $tmp = &$sub( { serialized => $row[1] }, $next );
            if ( ref($data) eq 'CODE' ) {
                $tmp = &$data( $tmp, $row[0] );
                $res{ $row[0] } = $tmp if ( defined($tmp) );
            }
            elsif ($data) {
                $data = [$data] unless ( ref($data) );
                $res{ $row[0] }->{$_} = $tmp->{$_} foreach (@$data);
            }
            else {
                $res{ $row[0] } = $tmp;
            }
        };
        if ($@) {
            print STDERR "Error in session $row[0]: $@\n";
            delete $res{ $row[0] };
        }
    }
    return \%res;
}

sub _classDbh {
    my $class = shift;
    my $args  = shift;

    my $datasource = $args->{DataSource} or die "No datasource given !";
    my $username   = $args->{UserName};
    my $password   = $args->{Password};
    my $dbh =
      DBI->connect_cached( $datasource, $username, $password,
        { RaiseError => 1, AutoCommit => 1 } )
      || die $DBI::errstr;
    if ( $datasource =~ /^dbi:sqlite/i ) {
        $dbh->{sqlite_unicode} = 1;
    }
    elsif ( $datasource =~ /^dbi:mysql/i ) {
        $dbh->{mysql_enable_utf8} = 1;
    }
    elsif ( $datasource =~ /^dbi:pg/i ) {
        $dbh->{pg_enable_utf8} = 1;
    }
    return $dbh;
}

1;