view release on metacpan or  search on metacpan

Ace.pm  view on Meta::CPAN

  my $class = shift;
  my ($host,$port,$user,$pass,$path,$program,
      $objclass,$timeout,$query_timeout,$database,
      $server_type,$url,$u,$p,$cache,$other);

  # one-argument single "URL" form
  if (@_ == 1) {
    return $class->connect(-url=>shift);
  }

  # multi-argument (traditional) form
  ($host,$port,$user,$pass,
   $path,$objclass,$timeout,$query_timeout,$url,$cache,$other) = 
     rearrange(['HOST','PORT','USER','PASS',
		'PATH',['CLASS','CLASSMAPPER'],'TIMEOUT',
		'QUERY_TIMEOUT','URL','CACHE'],@_);

  ($host,$port,$u,$pass,$p,$server_type) = $class->process_url($url) 
    or croak "Usage:  Ace->connect(-host=>\$host,-port=>\$port [,-path=>\$path]\n"
      if defined $url;

  if ($path) { # local database
    $server_type = 'Ace::Local';
  } else { # either RPC or socket server
    $host      ||= 'localhost';
    $user      ||= $u || '';
    $path      ||= $p || '';
    $port        ||= $server_type eq 'Ace::SocketServer' ? DEFAULT_SOCKET : DEFAULT_PORT;
    $query_timeout = 120 unless defined $query_timeout;
    $server_type ||= 'Ace::SocketServer' if $port <  100000;
    $server_type ||= 'Ace::RPC'          if $port >= 100000;
  }

  # we've normalized parameters, so do the actual connect
  eval "require $server_type" || croak "Module $server_type not loaded: $@";
  if ($path) {
    $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;
}