AcePerl
view release on metacpan or search on metacpan
$database = $server_type->connect(-path=>$path,%$other);
} else {
$database = $server_type->connect($host,$port,$query_timeout,$user,$pass,%$other);
}
unless ($database) {
$Ace::Error ||= "Couldn't open database";
return;
}
my $contents = {
'database'=> $database,
'host' => $host,
'port' => $port,
'path' => $path,
'class' => $objclass || 'Ace::Object',
'timeout' => $query_timeout,
'user' => $user,
'pass' => $pass,
'other' => $other,
'date_style' => 'java',
'auto_save' => 0,
};
my $self = bless $contents,ref($class)||$class;
$self->_create_cache($cache) if $cache;
$self->name2db("$self",$self);
return $self;
}
sub reopen {
my $self = shift;
return 1 if $self->ping;
my $class = ref($self->{database});
my $database;
if ($self->{path}) {
$database = $class->connect(-path=>$self->{path},%{$self->other});
} else {
$database = $class->connect($self->{host},$self->{port}, $self->{timeout},
$self->{user},$self->{pass},%{$self->{other}});
}
unless ($database) {
$Ace::Error = "Couldn't open database";
return;
}
$self->{database} = $database;
1;
}
sub class {
my $self = shift;
my $d = $self->{class};
$self->{class} = shift if @_;
$d;
}
sub class_for {
my $self = shift;
my ($class,$id) = @_;
my $selected_class;
if (my $selector = $self->class) {
if (ref $selector eq 'HASH') {
$selected_class = $selector->{$class} || $selector->{'_DEFAULT_'};
}
elsif ($selector->can('class_for')) {
$selected_class = $selector->class_for($class,$id,$self);
}
elsif (!ref $selector) {
$selected_class = $selector;
}
else {
croak "$selector is neither a scalar, nor a HASH, nor an object that supports the class_for() method";
}
}
$selected_class ||= 'Ace::Object';
eval "require $selected_class; 1;" || croak $@
unless $selected_class->can('new');
$selected_class;
}
sub process_url {
my $class = shift;
my $url = shift;
my ($host,$port,$user,$pass,$path,$server_type) = ('','','','','','');
if ($url) { # look for host:port
local $_ = $url;
if (m!^rpcace://([^:]+):(\d+)$!) { # rpcace://localhost:200005
($host,$port) = ($1,$2);
$server_type = 'Ace::RPC';
} elsif (m!^sace://([\w:]+)\@([^:]+):(\d+)$!) { # sace://user@localhost:2005
($user,$host,$port) = ($1,$2,$3);
$server_type = 'Ace::SocketServer';
} elsif (m!^sace://([^:]+):(\d+)$!) { # sace://localhost:2005
($host,$port) = ($1,$2);
$server_type = 'Ace::SocketServer';
} elsif (m!^tace:(/.+)$!) { # tace:/path/to/database
$path = $1;
$server_type = 'Ace::Local';
} elsif (m!^(/.+)$!) { # /path/to/database
$path = $1;
$server_type = 'Ace::Local';
} else {
return;
}
}
if ($user =~ /:/) {
($user,$pass) = split /:/,$user;
}
return ($host,$port,$user,$pass,$path,$server_type);
}
# Return the low-level Ace::AceDB object
sub db {
return $_[0]->{'database'};
}
# Fetch a model from the database.
# Since there are limited numbers of models, we cache
# the results internally.
sub model {
my $self = shift;
require Ace::Model;
my $model = shift;
my $break_cycle = shift; # for breaking cycles when following #includes
my $key = join(':',$self,'MODEL',$model);
$self->{'models'}{$model} ||= eval{$self->cache->get($key)};
unless ($self->{models}{$model}) {
$self->{models}{$model} =
Ace::Model->new($self->raw_query("model \"$model\""),$self,$break_cycle);
eval {$self->cache->set($key=>$self->{models}{$model})};
}
return $self->{'models'}{$model};
}
( run in 1.087 second using v1.01-cache-2.11-cpan-39bf76dae61 )